[BACK]Return to Trango.pm CVS log [TXT][DIR] Up to [local] / trango / Net-Telnet-Trango / lib / Net / Telnet

Diff for /trango/Net-Telnet-Trango/lib/Net/Telnet/Trango.pm between version 1.41 and 1.56

version 1.41, 2007/02/07 20:08:32 version 1.56, 2009/07/08 18:16:41
Line 1 
Line 1 
 package Net::Telnet::Trango;  package Net::Telnet::Trango;
   
 # $RedRiver: Trango.pm,v 1.40 2007/02/06 21:15:28 andrew Exp $  # $RedRiver: Trango.pm,v 1.55 2009/07/08 17:00:55 andrew Exp $
 use strict;  use strict;
 use warnings;  use warnings;
 use base 'Net::Telnet';  use base 'Net::Telnet';
Line 43 
Line 43 
   
 =cut  =cut
   
 our $VERSION = '0.01';  our $VERSION = '0.02';
   
 my $EMPTY = q{};  my $EMPTY = q{};
 my $SPACE = q{ };  my $SPACE = q{ };
Line 61 
Line 61 
         [Decode => 0,]);          [Decode => 0,]);
   
 Same as new from L<Net::Telnet> but sets the default Trango Prompt:  Same as new from L<Net::Telnet> but sets the default Trango Prompt:
 '/#> *$/'  '/[\$#]>\s*\Z/'
   
 It also takes an optional parameter 'Decode'.  If not defined it  It also takes an optional parameter 'Decode'.  If not defined it
 defaults to 1, if it is set to 0, it will not decode the output and  defaults to 1, if it is set to 0, it will not decode the output and
Line 81 
Line 81 
         %args = @_;          %args = @_;
     }      }
   
     $args{'Prompt'} ||= '/#> *$/';      $args{'Prompt'} ||= '/[\$#]>\s*\r?\n?$/';
   
     foreach my $key ( keys %args ) {      foreach my $key ( keys %args ) {
         $PRIVATE{$key} = $args{$key};          $PRIVATE{$key} = $args{$key};
Line 112 
Line 112 
 #  help [command]  #  help [command]
 #  heater [<on temp> <off temp>]  #  heater [<on temp> <off temp>]
 #  ipconfig [<new ip> <new subnet mask> <new gateway>]  #  ipconfig [<new ip> <new subnet mask> <new gateway>]
   #  linktest <suid> [<pkt len, bytes> [<# of pkts> [<# of cycle>]]]
 #  log [<# of entries, 1..179>]  #  log [<# of entries, 1..179>]
 #  log <sum> <# of entries, 1..179>  #  log <sum> <# of entries, 1..179>
 #  logout  #  logout
Line 322 
Line 323 
   
 my $success  = 'Success\\.';  my $success  = 'Success\\.';
 my %COMMANDS = (  my %COMMANDS = (
       _clear      => { String => "\n" },
     tftpd       => { decode    => 'all',       expect          => $success },      tftpd       => { decode    => 'all',       expect          => $success },
     ver         => { decode    => 'all' },      ver         => { decode    => 'all' },
     sysinfo     => { decode    => 'all',       expect          => $success },      sysinfo     => { decode    => 'all',       expect          => $success },
Line 342 
Line 344 
       { String => 'su testrflink', decode => 'each', expect    => $success },        { String => 'su testrflink', decode => 'each', expect    => $success },
     save_ss     => { String => 'save ss',      expect          => $success },      save_ss     => { String => 'save ss',      expect          => $success },
     opmode      => { decode => 'all',          expect          => $success },      opmode      => { decode => 'all',          expect          => $success },
       arq         => { decode => 'all' },
 );  );
   
 my %ALIASES = (  my %ALIASES = (
Line 490 
Line 493 
   
     my ( $type, $sep1, $subtype, $sep2, $ver ) =      my ( $type, $sep1, $subtype, $sep2, $ver ) =
       $banner =~        $banner =~
       /Welcome to Trango Broadband Wireless (\S+)([\s-]+)(\S+)([\s-]+)(.+)$/i;        /Welcome to Trango Broadband Wireless,? (\S+)([\s-]+)(\S+)([\s-]+)(.+)$/i;
   
     $type .= $sep1 . $subtype;      $type .= $sep1 . $subtype;
     $ver = $subtype . $sep2 . $ver;      $ver = $subtype . $sep2 . $ver;
Line 504 
Line 507 
   
 =pod  =pod
   
   =head2 B<linktest> - Link test to SU
   
   linktest('suid'[, 'pkt len, bytes'[, '# of pkts'[, '# of cycles']]]);
   
   Returns a hash reference to the results of the test
   
   =cut
   
   sub linktest
   {
       my $self    = shift;
       my $suid    = shift;
       # These numbers are what I found as defaults when running the command
       my $pkt_len = shift || 1600;
       my $pkt_cnt = shift || 500;
       my $cycles  = shift || 10;
   
       my %config  = @_;
   
       # * 2, one for the FromAP, one FromSU.  Then / 1000 to get to ms.
       # XXX This might need to be changed, this makes the default timeout the
       # same as $pkt_len, and that might not be enough at slower speeds.
       $config{Timeout} ||= int(($pkt_len * $pkt_cnt * $cycles * 2 ) / 1000);
   
       my $string = join $SPACE, 'linktest', $suid, $pkt_len, $pkt_cnt, $cycles;
       return $self->cmd(
           %config,
           String => $string,
           decode => 'linktest',
       );
   
   }
   
   =pod
   
 =head2 B<su_password> - Set the password on SUs connected to the AP.  =head2 B<su_password> - Set the password on SUs connected to the AP.
   
 su_password('new_password'[, 'suid']) If no suid is specified,  su_password('new_password'[, 'suid']) If no suid is specified,
Line 666 
Line 704 
     }      }
   
     my $new_mac = $mac;      my $new_mac = $mac;
     $new_mac =~ s/[^0-9A-Fa-f]//;      $new_mac =~ s/[^0-9A-Fa-f]//g;
     unless ( length $new_mac == 12 ) {      unless ( length $new_mac == 12 ) {
         $self->last_error("Invalid MAC '$mac'");          $self->last_error("Invalid MAC '$mac'");
         return;          return;
Line 892 
Line 930 
         $cmd{'String'} .= $SPACE . $cfg{'args'};          $cmd{'String'} .= $SPACE . $cfg{'args'};
     }      }
   
       #print "Running cmd $cmd{String}\n";
     my @lines;      my @lines;
     if ( $cfg{'no_prompt'} ) {      if ( $cfg{'no_prompt'} ) {
         $self->print( $cmd{'String'} );          $self->print( $cmd{'String'} );
Line 903 
Line 942 
   
     $self->last_lines( \@lines );      $self->last_lines( \@lines );
   
       my $last = $self->lastline;
       my $prompt = $self->prompt;
       $prompt =~ s{^/}{}xms;
       $prompt =~ s{/[gixms]*$}{}xms;
       while (@lines && $last =~ qr($prompt)) {
           pop @lines;
           $last = $lines[-1];
       }
       $self->last_error($EMPTY);
   
     my $vals = 1;      my $vals = 1;
     if ( $PRIVATE{'Decode'} && $cfg{'decode'} ) {      if ( $PRIVATE{'Decode'} && $cfg{'decode'} ) {
         if ( $cfg{'decode'} eq 'each' ) {          if ( $cfg{'decode'} eq 'each' ) {
Line 917 
Line 966 
                 $self->last_error("Error decoding maclist");                  $self->last_error("Error decoding maclist");
             }              }
         }          }
           elsif ( $cfg{'decode'} eq 'linktest' ) {
               $vals = _decode_linktest(@lines);
               if (! $vals) {
                   $self->last_error("Error decoding linktest");
               }
           }
         else {          else {
             $vals = _decode_lines(@lines);              $vals = _decode_lines(@lines);
         }          }
     }      }
   
     $self->last_vals($vals);      $self->last_vals($vals);
   
     my $last = $self->lastline;  
   
     if ( ( not $cfg{'expect'} ) || $last =~ /$cfg{'expect'}$/ ) {      if ( ( not $cfg{'expect'} ) || $last =~ /$cfg{'expect'}$/ ) {
         if ( $cfg{'cmd_disconnects'} ) {          if ( $cfg{'cmd_disconnects'} ) {
             $self->logged_in(0);              $self->logged_in(0);
Line 944 
Line 996 
         my $err;          my $err;
         if (grep { /\[ERR\]/ } @lines) {          if (grep { /\[ERR\]/ } @lines) {
             $err = _decode_lines(@lines);              $err = _decode_lines(@lines);
         }          }
   
         if (ref $err eq 'HASH' && $err ->{ERR}) {          if (ref $err eq 'HASH' && $err->{ERR}) {
             $self->last_error($err->{ERR} );              $self->last_error($err->{ERR} );
         } else {          } else {
             $self->last_error("Error with command ($cfg{'String'}): $last");              $self->last_error("Error with command ($cmd{'String'}): $last");
         }          }
         return;          return;
     }      }
Line 968 
Line 1020 
     my $in_key = 0;      my $in_key = 0;
     my $in_val = 1;      my $in_val = 1;
   
     foreach my $line (@lines) {      LINE: while (my $line = shift @lines) {
         next if $line =~ /$success$/;          next LINE if $line =~ /$success\Z/;
           next LINE if $line =~ /^ \*+ \s+ \d+ \s+ \*+ \Z/xms;
   
           # Special decode for sysinfo on a TrangoLink 45
           if ($line =~ /^(.* Channel \s+ Table):\s*(.*)\Z/xms) {
               my $key  = $1;
               my $note = $2;
   
               my %vals;
               while ($line = shift @lines) {
                   if ($line =~ /^\Z/) {
                       $conf{$key} = \%vals;
                       $conf{$key}{note} = $note;
                       next LINE;
                   }
   
                   my $decoded = _decode_lines($line);
                   if ($decoded) {
                       %vals = (%vals, %{ $decoded });
                   }
               }
           }
           # Another special decode for the TrangoLink
           elsif ($line =~ /^
               RF \s Band \s \#
               (\d+) \s+
               \( ([^\)]+) \) \s*
               (.*)$
           /xms) {
               my $num   = $1;
               my $band  = $2;
               my $extra = $3;
   
               if ($extra =~ /\[/) {
                   my $decoded = _decode_lines($extra);
                   $conf{'RF Band'}{$num} = $decoded;
               }
               else {
                   $conf{'RF Band'}{$num}{$extra} = 1;
               }
               next LINE;
           }
   
         my @chars = split //, $line;          my @chars = split //, $line;
   
         my $last_key = $EMPTY;          my $last_key = $EMPTY;
Line 1062 
Line 1155 
         push @decoded, $decoded if defined $decoded;          push @decoded, $decoded if defined $decoded;
     }      }
     return \@decoded;      return \@decoded;
   }
   
   #=item _decode_linktest
   
   sub _decode_linktest {
       my @lines = @_;
       my %decoded;
       foreach my $line (@lines) {
   
           if ($line =~ s/^(\d+) \s+ //xms) {
               my $line_id = $1;
                           my ($tm, $rt);
                           if ($line =~ s/\s+ (\d+ \s+ \w+) \s* $//xms) {
                                   $rt = $1;
                           }
                           if ($line =~ s/\s+ (\d+ \s+ \w+) \s* $//xms) {
                                   $tm = $1;
                           }
   
               my $d = _decode_lines($line. "\n");
               $decoded{tests}[$line_id] = $d;
               $decoded{tests}[$line_id]{'time'} = $tm;
               $decoded{tests}[$line_id]{rate}   = $rt;
           }
   
           else {
               my $d = _decode_lines($line . "\n");
               if ($d) {
                   while (my ($k, $v) = each %{ $d }) {
                       $decoded{$k} = $v;
                   }
              }
           }
   
       }
       return \%decoded;
 }  }
   
 #=item _decode_sulog  #=item _decode_sulog
Legend:
Removed from v.1.41  
changed lines
  Added in v.1.56
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>