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