lib/H1/ZTEDSLAM.pm

   1 package H1::ZTEDSLAM;
   2 use warnings;
   3 use strict;
   4
   5 use Moose;
   6
   7 use Net::Telnet;
   8 use Data::Dump qw(dump);
   9
  10 use Moose::Util::TypeConstraints;
  11 use Regexp::Common qw(net);
  12
  13 subtype IPAddr
  14 => as Str
  15 => where {/^$RE{net}{IPv4}$/}
  16 => message { 'invalid IP address'};
  17
  18 has 'ip'   => ( is => 'rw', isa => 'IPAddr' );
  19
  20 our $telnet;
  21
  22 sub telnet {
  23         my $self = shift;
  24
  25         my $ip = $self->ip;
  26
  27         return $telnet->{$ip} if exists $telnet->{$ip};
  28
  29         my $t = Net::Telnet->new( Timeout => 10, Prompt => '/#/' );
  30
  31         $t->dump_log('/tmp/log') if $ENV{DEBUG};
  32
  33         warn "open $ip";
  34         $t->open( $ip );
  35
  36         $t->print("");
  37         $t->waitfor('/Login:/');
  38         $t->print('admin');
  39         $t->waitfor('/Password:/');
  40         $t->print('admin');
  41         $t->waitfor('/>/');
  42         $t->print('en');
  43         $t->waitfor('/Please input password:/');
  44         $t->print('admin');
  45         $t->waitfor('/#/');
  46
  47         warn "login OK";
  48
  49         return $telnet->{$ip} = $t;
  50 }
  51
  52 sub command {
  53         my ($self,$command) = @_;
  54
  55         $command .= ' ' . $self->{port};
  56
  57         my $t = $self->telnet;
  58
  59         warn "# $command\n";
  60         $t->print($command);
  61
  62         my $out;
  63         while (1) {
  64                 my($prematch, $match) = $t->waitfor('/(Press any key to continue \(Q to quit\)|#)/');
  65                 $out .= $prematch;
  66                 last if $match eq '#';
  67                 $t->print('');
  68         }
  69
  70         warn "## out = [$out]" if $ENV{DEBUG};
  71
  72         my $hash;
  73         foreach my $line ( split(/[\n\r]+/, $out) ) {
  74                 warn "# $line\n" if $ENV{DEBUG};
  75                 if ( $line =~ m/^(\S+.*?)\s+:\s+(\S+.*)$/ ) {
  76                         my ($n,$v) = ($1,$2);
  77                         $n =~ s/\(.+\)//;
  78                         $hash->{$n} = $v;
  79                         warn "## $n = $v\n" if $ENV{DEBUG};
  80                 }
  81
  82         }
  83
  84         warn "## ", $self->ip, " $command ",dump $hash;
  85
  86         return $hash;
  87 }
  88
  89 sub hash {
  90         my ($self,$port) = @_;
  91
  92         my $ip   = $self->ip;
  93         $self->{port} = $port;
  94
  95         warn "# hash $ip $port";
  96
  97 our ( $row, $hash );
  98
  99 sub copy {
 100         foreach my $name (@_) {
 101 #               warn "# copy $name ", dump( $row ),$/;
 102                 $row->{$name} = $hash->{$name};
 103         }
 104 }
 105
 106 $hash = $self->command('show interface');
 107 copy qw(
 108 AdminStatus
 109 LinkStatus
 110 LastLinkUpTime
 111 );
 112
 113 $hash = $self->command('show adsl status');
 114 copy qw(
 115 LineConfProfile
 116 );
 117
 118 $hash = $self->command('show adsl physical');
 119 copy qw(
 120 AtucCurrSnrMgn
 121 AtucCurrAtn
 122 AtucCurrStatus
 123 AtucOutputPwr
 124 AtucAttainableRate
 125 AtucDMTState
 126 AtucPrevSnrMgn
 127 AturCurrAtn
 128 AturCurrStatus
 129 AturCurrOutputPwr
 130 AturAttainableRate
 131 AturDMTState
 132 );
 133
 134 warn "# row = ",dump $row if $ENV{DEBUG};
 135
 136 return $row;
 137
 138 } # sub
 139
 140
 141 sub logout {
 142         my $self = shift;
 143         my $ip = $self->ip;
 144         my $t = delete $telnet->{$ip};
 145         die "no $ip telnet in ",dump($telnet) unless $t;
 146
 147         warn "logout $ip";
 148         $t->print('logout');
 149         $t->waitfor('/:/');
 150         $t->print('y');
 151
 152 }
 153
 154 sub DESTROY {
 155         my $self = shift;
 156         warn "# DESTROY telnet = ",dump( keys %$telnet );
 157         $self->logout($_) foreach keys %$telnet;
 158 }
 159
 160 1;
 161