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