fix more quirks in right column parsing

[APKPM.git] / lib / H1 / ZTEMSAN.pm

diff --git a/lib/H1/ZTEMSAN.pm b/lib/H1/ZTEMSAN.pm
old mode 100755 (executable)
new mode 100644 (file)
index 40a72fb..85c81bb
--- a/lib/H1/ZTEMSAN.pm
+++ b/lib/H1/ZTEMSAN.pm
@@ -1,114 +1,80 @@
 package H1::ZTEMSAN;
-use warnings;
-use strict;
+use Moose;
 
-use Net::Telnet;
+with 'H1::ZTE';
 use Data::Dump qw(dump);
 
-sub hash {
-       my ( $self,$ip,$port ) = @_;
+sub connect {
+       my ( $self,$ip ) = @_;
 
-       warn "# hash $ip $port";
+       my $t = Net::Telnet->new( Timeout => 20, Port => 1123, Prompt => '/#/' );
 
-my $t = Net::Telnet->new( Timeout => 20, Port => 1123, Prompt => '/#/' );
+       $t->dump_log('/tmp/log') if $ENV{DEBUG};
 
-$t->dump_log('/tmp/log') if $ENV{DEBUG};
+       warn "open";
+       $t->open( $ip );
 
-warn "open";
-$t->open( $ip );
+       $t->waitfor('/Login:/');
+       $t->print('root');
+       $t->waitfor('/Password:/');
+       $t->print('root');
+       $t->waitfor('/#/');
 
-$t->waitfor('/Login:/');
-$t->print('root');
-$t->waitfor('/Password:/');
-$t->print('root');
-#$t->waitfor('/>/');
-#$t->print('en');
-#$t->waitfor('/Please input password:/');
-#$t->print('admin');
-$t->waitfor('/#/');
+       warn "login OK";
 
-warn "login OK";
-
-sub command {
-       my $command = shift;
-
-       warn "# command $command\n";
-       $t->print($command);
-
-       my $out;
-       while (1) {
-               warn "waitfor";
-               my($prematch, $match) = $t->waitfor('/(Press any key to continue \(Q to quit\)|#)/');
-               $out .= $prematch;
-               last if $match eq '#';
-#              $t->put(" ");
-               $t->print('');
-       }
+       return $t;
+}
 
-       warn "## out = [$out]";
+sub parse {
+       my ( $self, $out ) = @_;
 
        my $hash;
        my $section = '';
        my $last_line;
        foreach my $line ( split(/[\n\r]+/, $out) ) {
                warn "# $line\n";
-               if ( $line =~ m/^(\S+.*?)\s+:+\s+(\S+.*?)\s*$/ ) {
+               if ( $line =~ m/^(\S+.*?)\s*:+\s+(\S+.*?)\s*$/ ) {
                        my ($n,$v) = ($1,$2);
                        $n =~ s/\(.+\)//;
                        if ( $v =~ s/\s+(\S+)\s*:\s+(\S+.+)// ) {
                                # strip second column
                                my ($n2,$v2) = ($1,$2);
                                $n2 =~ s/\(.+\)//;
-                               $hash->{ $section . $n2 } = $2;
+                               $hash->{ $section . $n2 } = $v2;
+                               warn "## $n2 = $v2\n";
                        }
                        $hash->{ $section . $n } = $v;
                        warn "## $n = $v\n";
                } elsif ( $line =~ m/^-+$/ ) {
-                       $section = $last_line . '.'
+                       $section = $last_line . '_';
                }
                $last_line = $line;
        }
 
        warn "## hash = ",dump $hash;
 
-       if ( $ENV{DEBUG} ) {
-               my $path = $command;
-               $path =~ s{\W+}{_}g;
-               $path = "/tmp/dump.$path";
-               open( my $fh, '>', $path ) || die "$path: $!";
-               print $fh $out;
-               close $fh;
-               warn "DEBUG ",$path, " ", -s $path, " bytes\n";
-       }
-
        return $hash;
 }
 
-our ( $row, $hash );
 
-sub copy {
-       my @what = @_ ? @_ : keys %$hash;
-       foreach my $name (@what) {
-               warn "# copy $name ", dump( $hash->{$name} ),$/;
-               $row->{$name} = $hash->{$name};
+sub commands {{
+       'show adsl port %s' => [],
+       'show adsl port %s line-config' => [],
+       'show adsl port %s physical-table' => [],
+}}
+
+sub fixup_row {
+       my ( $self, $row ) = @_;
+       # cleanup column names
+       foreach my $n ( grep { m/[:\s]/ } keys %$row ) {
+               my $v = delete $row->{$n};
+               $n =~ s/\s+/_/g;
+               $n =~ s/:$// && $v =~ s/\skbps$//; # special case
+               $row->{$n} = $v;
        }
-}
-
-$hash = command "show adsl port $port";
-copy;
-
-$hash = command "show adsl port $port line-config";
-copy;
 
-# FIXME very slow to query
-#$hash = command "show adsl port $port physical-table";
-#copy;
-
-warn "# row = ",dump $row;
-
-warn "logout";
-$t->print('logout');
+       return $row;
+}
 
-} # sub
 1;