[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.40 and 1.49

version 1.40, 2007/02/06 21:15:28 version 1.49, 2008/02/08 19:29:05
Line 1 
Line 1 
 package Net::Telnet::Trango;  package Net::Telnet::Trango;
   
 # $RedRiver: Trango.pm,v 1.39 2007/02/06 20:41:42 andrew Exp $  # $RedRiver: Trango.pm,v 1.48 2008/02/08 18:49:41 andrew Exp $
 use strict;  use strict;
 use warnings;  use warnings;
 use base 'Net::Telnet';  use base 'Net::Telnet';
Line 17 
Line 17 
   use Net::Telnet::Trango;    use Net::Telnet::Trango;
   my $t = new Net::Telnet::Trango ( Timeout => 5 );    my $t = new Net::Telnet::Trango ( Timeout => 5 );
   
   $t->open( Host => $fox ) or die "Error connecting: $!";    $t->open( Host => $ap ) or die "Error connecting: $!";
   
   $t->login('password') or die "Couldn't log in: $!";    $t->login('password') or die "Couldn't log in: $!";
   
Line 28 
Line 28 
   
 =head1 DESCRIPTION  =head1 DESCRIPTION
   
 Perl access to the telnet interface on Trango Foxes, SUs and APs.  Perl access to the telnet interface on Trango APs and SUs.
   
 Another handy feature is that it will parse the output from certain  A handy feature is that it will parse the output from certain commands that is
 commands that is in the format "[key1] value1 [key2] value2" and put  in the format "[key1] value1 [key2] value2" and put those in a hashref that is
 those in a hashref that is returned.  This makes using the output from  returned.  This makes using the output from things like sysinfo very easy to
 things like sysinfo very easy to do.  do.
   
 =head2 EXPORT  =head2 EXPORT
   
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 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 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 913 
Line 952 
         }          }
         elsif ( $cfg{'decode'} eq 'maclist' ) {          elsif ( $cfg{'decode'} eq 'maclist' ) {
             $vals = _decode_maclist(@lines);              $vals = _decode_maclist(@lines);
               if (! $vals) {
                   $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 922 
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 941 
Line 990 
         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 1061 
Line 1110 
     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+) $//xms) {
                                   $rt = $1;
                           }
                           if ($line =~ s/\s+ (\d+ \s+ \w+) $//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
   
 sub _decode_sulog {  sub _decode_sulog {
Line 1135 
Line 1220 
         return \@decoded;          return \@decoded;
     }      }
     else {      else {
   
         # XXX we should have a way to set last error, not sure why we don't  
         return;          return;
     }      }
 }  }
Legend:
Removed from v.1.40  
changed lines
  Added in v.1.49
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>