lib/H1/ZTEDSLAM.pm

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