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 {
  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         my $hash = $self->parse( $out );
  57
  58         warn "## ", $self->ip, " $command ",dump $hash;
  59
  60         return $hash;
  61 }
  62
  63 sub hash {
  64         my ($self,$port) = @_;
  65
  66         my $ip   = $self->ip;
  67         $self->{port} = $port;
  68
  69         warn "# hash $ip $port";
  70
  71         our ( $row, $hash );
  72
  73         sub copy {
  74                 my @what = @_;
  75                 @what = keys %$hash unless @what;
  76                 foreach my $name (@what) {
  77                         $row->{$name} = $hash->{$name};
  78                 }
  79         }
  80
  81         my $commands = $self->commands;
  82         foreach my $command ( keys %$commands ) {
  83                 $hash = $self->command( sprintf($command, $port) );
  84                 copy ref $commands->{$command} eq 'ARRAY' ? @{$commands->{$command}} : undef;
  85         }
  86
  87         warn "# row = ",dump $row if $ENV{DEBUG};
  88
  89         $row = $self->fixup_row( $row ) if $self->can('fixup_row');
  90
  91         return $row;
  92
  93 } # sub
  94
  95
  96 sub logout {
  97         my $self = shift;
  98         my $ip = $self->ip;
  99         my $t = delete $telnet->{$ip} || return;
 100 #       die "no $ip telnet in ",dump($telnet) unless $t;
 101
 102         warn "logout $ip";
 103         $t->print('logout');
 104         # FIXME removed but needed?
 105         #$t->waitfor('/:/');
 106         #$t->print('y');
 107         $t->close;
 108
 109 }
 110
 111 sub DESTROY {
 112         my $self = shift;
 113         warn "# DESTROY telnet = ",dump( keys %$telnet );
 114         $self->logout($_) foreach keys %$telnet;
 115 }
 116
 117 1;
 118