[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.44 and 1.51

version 1.44, 2007/06/05 20:54:05 version 1.51, 2008/02/18 16:37:35
Line 1 
Line 1 
 package Net::Telnet::Trango;  package Net::Telnet::Trango;
   
 # $RedRiver: Trango.pm,v 1.43 2007/05/21 20:45:48 andrew Exp $  # $RedRiver: Trango.pm,v 1.50 2008/02/08 19:32:15 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 492 
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 506 
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 920 
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 928 
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 1065 
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.44  
changed lines
  Added in v.1.51
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>