refactor common parts into ZTE role
authorDobrica Pavlinusic <dpavlin@rot13.org>
Wed, 25 May 2011 17:47:07 +0000 (19:47 +0200)
committerDobrica Pavlinusic <dpavlin@rot13.org>
Wed, 25 May 2011 17:47:07 +0000 (19:47 +0200)
lib/H1/ZTE.pm [new file with mode: 0755]
lib/H1/ZTEDSLAM.pm

diff --git a/lib/H1/ZTE.pm b/lib/H1/ZTE.pm
new file mode 100755 (executable)
index 0000000..ee05b70
--- /dev/null
@@ -0,0 +1,124 @@
+package H1::ZTE;
+use warnings;
+use strict;
+
+use Moose::Role;
+
+requires 'login';
+requires 'parse';
+
+use Net::Telnet;
+use Data::Dump qw(dump);
+
+use Moose::Util::TypeConstraints;
+use Regexp::Common qw(net);
+
+subtype IPAddr
+=> as Str
+=> where {/^$RE{net}{IPv4}$/}
+=> message { 'invalid IP address'};
+
+has 'ip'   => ( is => 'rw', isa => 'IPAddr' );
+
+our $telnet;
+
+sub telnet {
+       my $self = shift;
+
+       my $ip = $self->ip;
+
+       return $telnet->{$ip} if exists $telnet->{$ip};
+
+       my $t = Net::Telnet->new( Timeout => 10, Prompt => '/#/' );
+
+       $t->dump_log('/tmp/log') if $ENV{DEBUG};
+
+       warn "open $ip";
+       $t->open( $ip );
+
+       $self->login( $t );
+
+       return $telnet->{$ip} = $t;
+}
+
+sub command {
+       my ($self,$command) = @_;
+
+       my $port = $self->{port} || die "no port";
+       $command =~ s/##/$port/gs || die "no port in $command";
+
+       my $t = $self->telnet;
+
+       warn "# $command\n";
+       $t->print($command);
+
+       my $out;
+       while (1) {
+               my($prematch, $match) = $t->waitfor('/(Press any key to continue \(Q to quit\)|#)/');
+               $out .= $prematch;
+               last if $match eq '#';
+               $t->print('');
+       }
+
+       warn "## out = [$out]" if $ENV{DEBUG};
+
+       my $hash = $self->parse( $out );
+
+       warn "## ", $self->ip, " $command ",dump $hash;
+
+       return $hash;
+}
+
+sub hash {
+       my ($self,$port) = @_;
+
+       my $ip   = $self->ip;
+       $self->{port} = $port;
+
+       warn "# hash $ip $port";
+
+our ( $row, $hash );
+
+sub copy {
+       foreach my $name (@_) {
+#              warn "# copy $name ", dump( $row ),$/;
+               $row->{$name} = $hash->{$name};
+       }
+}
+
+my $commands = $self->commands;
+foreach my $command ( keys %$commands ) {
+       $hash = $self->command($command);
+       copy @{$commands->{$command}} if ref $commands->{$command} eq 'ARRAY';
+}
+
+warn "# row = ",dump $row if $ENV{DEBUG};
+
+return $row;
+
+} # sub
+
+
+sub logout {
+       my $self = shift;
+       my $ip = $self->ip;
+       my $t = delete $telnet->{$ip};
+       die "no $ip telnet in ",dump($telnet) unless $t;
+
+       warn "logout $ip";
+       $t->print('logout');
+       # FIXME removed but needed?
+       #$t->waitfor('/:/');
+       #$t->print('y');
+       $t->close;
+
+}
+
+sub DESTROY {
+       my $self = shift;
+       warn "# DESTROY telnet = ",dump( keys %$telnet );
+       $self->logout($_) foreach keys %$telnet;
+}
+
+1;
+
index 4407983..1caef2d 100755 (executable)
@@ -4,34 +4,13 @@ use strict;
 
 use Moose;
 
-use Net::Telnet;
-use Data::Dump qw(dump);
-
-use Moose::Util::TypeConstraints;
-use Regexp::Common qw(net);
-
-subtype IPAddr
-=> as Str
-=> where {/^$RE{net}{IPv4}$/}
-=> message { 'invalid IP address'};
-
-has 'ip'   => ( is => 'rw', isa => 'IPAddr' );
-
-our $telnet;
+with 'H1::ZTE';
 
-sub telnet {
-       my $self = shift;
-
-       my $ip = $self->ip;
-
-       return $telnet->{$ip} if exists $telnet->{$ip};
-
-       my $t = Net::Telnet->new( Timeout => 10, Prompt => '/#/' );
+use Data::Dump qw(dump);
 
-       $t->dump_log('/tmp/log') if $ENV{DEBUG};
 
-       warn "open $ip";
-       $t->open( $ip );
+sub login {
+       my ( $self, $t ) = @_;
 
        $t->print("");
        $t->waitfor('/Login:/');
@@ -45,29 +24,11 @@ sub telnet {
        $t->waitfor('/#/');
 
        warn "login OK";
-
-       return $telnet->{$ip} = $t;
 }
 
-sub command {
-       my ($self,$command) = @_;
-
-       $command .= ' ' . $self->{port};
-
-       my $t = $self->telnet;
 
-       warn "# $command\n";
-       $t->print($command);
-
-       my $out;
-       while (1) {
-               my($prematch, $match) = $t->waitfor('/(Press any key to continue \(Q to quit\)|#)/');
-               $out .= $prematch;
-               last if $match eq '#';
-               $t->print('');
-       }
-
-       warn "## out = [$out]" if $ENV{DEBUG};
+sub parse {
+       my ( $self, $out ) = @_;
 
        my $hash;
        foreach my $line ( split(/[\n\r]+/, $out) ) {
@@ -81,42 +42,19 @@ sub command {
 
        }
 
-       warn "## ", $self->ip, " $command ",dump $hash;
-
        return $hash;
 }
 
-sub hash {
-       my ($self,$port) = @_;
-
-       my $ip   = $self->ip;
-       $self->{port} = $port;
-
-       warn "# hash $ip $port";
-
-our ( $row, $hash );
-
-sub copy {
-       foreach my $name (@_) {
-#              warn "# copy $name ", dump( $row ),$/;
-               $row->{$name} = $hash->{$name};
-       }
-}
-
-$hash = $self->command('show interface');
-copy qw(
+sub commands {{
+       'show interface ##' => [ qw(
 AdminStatus
 LinkStatus
 LastLinkUpTime
-);
-
-$hash = $self->command('show adsl status');
-copy qw(
+       )],
+       'show adsl status ##' => [ qw(
 LineConfProfile
-);
-
-$hash = $self->command('show adsl physical');
-copy qw(
+       )],
+       'show adsl physical ##' => [ qw(
 AtucCurrSnrMgn
 AtucCurrAtn
 AtucCurrStatus
@@ -129,33 +67,8 @@ AturCurrStatus
 AturCurrOutputPwr
 AturAttainableRate
 AturDMTState
-);
-
-warn "# row = ",dump $row if $ENV{DEBUG};
-
-return $row;
-
-} # sub
-
-
-sub logout {
-       my $self = shift;
-       my $ip = $self->ip;
-       my $t = delete $telnet->{$ip};
-       die "no $ip telnet in ",dump($telnet) unless $t;
-
-       warn "logout $ip";
-       $t->print('logout');
-       $t->waitfor('/:/');
-       $t->print('y');
-
-}
-
-sub DESTROY {
-       my $self = shift;
-       warn "# DESTROY telnet = ",dump( keys %$telnet );
-       $self->logout($_) foreach keys %$telnet;
-}
+       )],
+}}
 
 1;