[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.45 and 1.52

version 1.45, 2008/02/08 16:49:09 version 1.52, 2008/02/18 19:13:32
Line 1 
Line 1 
 package Net::Telnet::Trango;  package Net::Telnet::Trango;
   
 # $RedRiver: Trango.pm,v 1.44 2007/06/05 19:54:05 mike Exp $  # $RedRiver: Trango.pm,v 1.51 2008/02/18 16:37:35 andrew Exp $
 use strict;  use strict;
 use warnings;  use warnings;
 use base 'Net::Telnet';  use base 'Net::Telnet';
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 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 906 
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 920 
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 971 
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 1074 
Line 1164 
     my %decoded;      my %decoded;
     foreach my $line (@lines) {      foreach my $line (@lines) {
   
         if ($line =~ s/^(\d+) \s*//xms) {          if ($line =~ s/^(\d+) \s+ //xms) {
             my $line_id = $1;              my $line_id = $1;
             my $d = _decode_lines($line . "\n");                          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] = $d;
               $decoded{tests}[$line_id]{'time'} = $tm;
               $decoded{tests}[$line_id]{rate}   = $rt;
         }          }
   
         else {          else {
Legend:
Removed from v.1.45  
changed lines
  Added in v.1.52
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>