lib/H1/ZTEDSLAM.pm

   1 package H1::ZTEDSLAM;
   2 use Moose;
   3
   4 with 'H1::ZTE';
   5
   6 sub connect {
   7         my ( $self, $ip ) = @_;
   8
   9         my $t = Net::Telnet->new( Timeout => 10, Prompt => '/#/' );
  10
  11         $t->dump_log('/tmp/log') if $ENV{DEBUG};
  12
  13         $t->open( $ip );
  14
  15         $t->print("");
  16         $t->waitfor('/Login:/');
  17         $t->print('admin');
  18         $t->waitfor('/Password:/');
  19         $t->print('admin');
  20         $t->waitfor('/>/');
  21         $t->print('en');
  22         $t->waitfor('/Please input password:/');
  23         $t->print('admin');
  24         $t->waitfor('/#/');
  25
  26         warn "login OK";
  27
  28         return $t;
  29 }
  30
  31
  32 sub parse {
  33         my ( $self, $out ) = @_;
  34
  35         my $hash;
  36         foreach my $line ( split(/[\n\r]+/, $out) ) {
  37                 warn "# $line\n" if $ENV{DEBUG};
  38                 if ( $line =~ m/^(\S+.*?)\s*:\s+(\S+.*)$/ ) {
  39                         my ($n,$v) = ($1,$2);
  40                         $n =~ s/\(.+\)//;
  41                         $hash->{$n} = $v;
  42                         warn "## $n = $v\n" if $ENV{DEBUG};
  43                 }
  44
  45         }
  46
  47         return $hash;
  48 }
  49
  50 sub commands {{
  51         'show interface %s' => [ qw(
  52 AdminStatus
  53 LinkStatus
  54 LastLinkUpTime
  55         )],
  56         'show adsl status %s' => [ qw(
  57 LineConfProfile
  58         )],
  59         'show adsl physical %s' => [ qw(
  60 AtucCurrSnrMgn
  61 AtucCurrAtn
  62 AtucCurrStatus
  63 AtucOutputPwr
  64 AtucAttainableRate
  65 AtucDMTState
  66 AtucPrevSnrMgn
  67 AturCurrAtn
  68 AturCurrStatus
  69 AturCurrOutputPwr
  70 AturAttainableRate
  71 AturDMTState
  72         )],
  73 }}
  74
  75 sub custom {
  76         my ($self,$port) = @_;
  77
  78         my $out = $self->command_out("show interface $port adsl-status");
  79         my @lines = split(/\s*[\n\r]+/,$out);
  80
  81         shift @lines if $lines[0] =~ m/adsl-status/; # skip command
  82         if ( $lines[2] !~ m/^-+$/ ) {
  83                 warn "Can't parse into table - missing header separator at index 2: $lines[2]";
  84                 return;
  85         }
  86         my @h1 = split(/\s+/, $lines[0]);
  87         my @h2 = split(/\s+/, $lines[1]);
  88         my @v  = split(/\s+/, $lines[3]);
  89
  90         my $hash;
  91         foreach my $i ( 0 .. $#v ) {
  92                 my $k = $h1[$i];
  93
  94                 $h2[$i] =~ s/\(\w\)\s*$//; # remove unit
  95
  96                 if ( $h2[$i] =~ m/\// && $v[$i] =~ m/\// ) {
  97                         my ($ln,$rn) = split(/\//, $h2[$i]);
  98                         my ($lv,$rv) = split(/\//, $v[$i]);
  99                         $hash->{ join('_',$k,$ln) } = $lv;
 100                         $hash->{ join('_',$k,$rn) } = $rv;
 101                 } else {
 102                         $hash->{ $h2[$i] ? $h1[$i] .'_'. $h2[$i] : $h1[$i] } = $v[$i];
 103                 }
 104         }
 105
 106         my $out = $self->command_out("show adsl perf $port");
 107         my @lines = split(/\s*[\n\r]+/,$out);
 108
 109         my $table;
 110         foreach my $line ( @lines ) {
 111                 next if ! $line;
 112                 if ( $line =~ m/ADSL\s+(\w+)\s+Table/i ) {
 113                         $table = $1;
 114                         next;
 115                 } elsif ( $line =~ m/^(\S+)\s+:\s+(\S)*$/ ) {
 116                         $hash->{ $table . '_' . $1 } = $2 if defined $2;
 117                 } else {
 118                         warn "# IGNORED: $line\n";
 119                 }
 120         }
 121
 122         return $hash;
 123 }
 124
 125 1;
 126