lib/H1/ZTE.pm

   1 package H1::ZTE;
   2 use warnings;
   3 use strict;
   4
   5 use Moose::Role;
   6
   7 requires 'connect';
   8 requires 'parse';
   9
  10 use Net::Telnet;
  11 use Data::Dump qw(dump);
  12
  13 use Moose::Util::TypeConstraints;
  14 use Regexp::Common qw(net);
  15
  16 subtype IPAddr
  17 => as Str
  18 => where {/^$RE{net}{IPv4}$/}
  19 => message { 'invalid IP address'};
  20
  21 has 'ip'   => ( is => 'rw', isa => 'IPAddr' );
  22
  23 our $telnet;
  24
  25 sub telnet {
  26         my $self = shift;
  27
  28         my $ip = $self->ip;
  29
  30         return $telnet->{$ip} if exists $telnet->{$ip};
  31
  32         warn "connect $ip";
  33         my $t = $self->connect( $ip );
  34
  35         return $telnet->{$ip} = $t;
  36 }
  37
  38 sub command_out {
  39         my ($self,$command) = @_;
  40
  41         my $t = $self->telnet;
  42
  43         warn "# $command\n";
  44         $t->print($command);
  45
  46         my $out;
  47         while (1) {
  48                 my($prematch, $match) = $t->waitfor('/(Press any key to continue \(Q to quit\)|#)/');
  49                 $out .= $prematch;
  50                 last if $match eq '#';
  51                 $t->print('');
  52         }
  53
  54         warn "## out = [$out]" if $ENV{DEBUG};
  55
  56         return $out;
  57 }
  58
  59 sub command {
  60         my ($self,$command) = @_;
  61         my $out  = $self->command_out( $command );
  62         my $hash = $self->parse( $out );
  63
  64         warn "## ", $self->ip, " $command ",dump $hash;
  65
  66         return $hash;
  67 }
  68
  69 sub hash {
  70         my ($self,$port) = @_;
  71
  72         my $ip   = $self->ip;
  73         $self->{port} = $port;
  74
  75         warn "# hash $ip $port";
  76
  77         our ( $row, $hash );
  78
  79         sub copy {
  80                 my @what = @_;
  81                 @what = keys %$hash unless @what;
  82                 foreach my $name (@what) {
  83                         $row->{$name} = $hash->{$name};
  84                 }
  85         }
  86
  87         my $commands = $self->commands;
  88         foreach my $command ( keys %$commands ) {
  89                 $hash = $self->command( sprintf($command, $port) );
  90                 copy ref $commands->{$command} eq 'ARRAY' ? @{$commands->{$command}} : undef;
  91         }
  92
  93         if ( $self->can('custom') ) {
  94                 $hash = $self->custom( $port );
  95                 copy keys %$hash;
  96         }
  97
  98         warn "# row = ",dump $row if $ENV{DEBUG};
  99
 100         $row = $self->fixup_row( $row ) if $self->can('fixup_row');
 101
 102         return $row;
 103
 104 } # sub
 105
 106
 107 sub logout {
 108         my $self = shift;
 109         my $ip = $self->ip;
 110         my $t = delete $telnet->{$ip};
 111         return unless $t;
 112 #       die "no $ip telnet in ",dump($telnet) unless $t;
 113
 114         warn "logout $ip";
 115         $t->print('logout');
 116         # FIXME removed but needed?
 117         #$t->waitfor('/:/');
 118         #$t->print('y');
 119         $t->close;
 120
 121 }
 122
 123 sub DESTROY {
 124         my $self = shift;
 125 #       warn "# DESTROY telnet = ",dump( keys %$telnet );
 126         $self->logout($_) foreach keys %$telnet;
 127 }
 128
 129 1;
 130