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