[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.43 and 1.50

version 1.43, 2007/05/21 21:45:48 version 1.50, 2008/02/08 19:32:15
Line 1 
Line 1 
 package Net::Telnet::Trango;  package Net::Telnet::Trango;
   
 # $RedRiver: Trango.pm,v 1.42 2007/05/21 20:24:13 andrew Exp $  # $RedRiver: Trango.pm,v 1.49 2008/02/08 19:29:05 andrew Exp $
 use strict;  use strict;
 use warnings;  use warnings;
 use base 'Net::Telnet';  use base 'Net::Telnet';
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      => { decode    => 'all', String => '', args => '' },      _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 343 
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 505 
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 893 
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 918 
Line 956 
                 $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);
         }          }
Line 926 
Line 970 
     $self->last_vals($vals);      $self->last_vals($vals);
   
     my $last = $self->lastline;      my $last = $self->lastline;
       $self->last_error($EMPTY);
   
     if ( ( not $cfg{'expect'} ) || $last =~ /$cfg{'expect'}$/ ) {      if ( ( not $cfg{'expect'} ) || $last =~ /$cfg{'expect'}$/ ) {
         if ( $cfg{'cmd_disconnects'} ) {          if ( $cfg{'cmd_disconnects'} ) {
Line 951 
Line 996 
             $self->last_error($err->{ERR} );              $self->last_error($err->{ERR} );
         } else {          } else {
             $self->last_error("Error with command ($cmd{'String'}): $last");              $self->last_error("Error with command ($cmd{'String'}): $last");
             $self->_clear();  
         }          }
         return;          return;
     }      }
Line 1064 
Line 1108 
         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.43  
changed lines
  Added in v.1.50
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>