[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.49 and 1.60

version 1.49, 2008/02/08 19:29:05 version 1.60, 2009/07/31 22:46:07
Line 1 
Line 1 
 package Net::Telnet::Trango;  package Net::Telnet::Trango;
   
 # $RedRiver: Trango.pm,v 1.48 2008/02/08 18:49:41 andrew Exp $  # $RedRiver: Trango.pm,v 1.59 2009/07/31 21:44:33 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.05';
   
 my $EMPTY = q{};  my $EMPTY = q{};
 my $SPACE = q{ };  my $SPACE = q{ };
   
 my %PRIVATE = (  
     is_connected => 0,  
     logged_in    => 0,  
 );  
   
 =pod  =pod
   
 =head2 B<new> - Creates a new Net::Telnet::Trango object.  =head2 B<new> - Creates a new Net::Telnet::Trango object.
Line 61 
Line 56 
         [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 73 
Line 68 
 sub new {  sub new {
     my $class = shift;      my $class = shift;
   
     my %args;      my %args = ();
     if ( @_ == 1 ) {      if ( @_ == 1 ) {
         $args{'Host'} = shift;          $args{'Host'} = shift;
     }      }
Line 81 
Line 76 
         %args = @_;          %args = @_;
     }      }
   
     $args{'Prompt'} ||= '/#> *$/';      $args{'Prompt'} ||= '/[\$#]>\s*\r?\n?$/';
   
     foreach my $key ( keys %args ) {      my $decode = $args{'Decode'};
         $PRIVATE{$key} = $args{$key};  
     }  
     $PRIVATE{'Decode'} = 1 unless defined $PRIVATE{'Decode'};  
     delete $args{'Decode'};      delete $args{'Decode'};
   
     my $self = $class->SUPER::new(%args);      my $self = $class->SUPER::new(%args);
     bless $self if ref $self;      bless $self if ref $self;
   
       $args{Decode}       = defined $decode ? $decode : 1;
       $args{is_connected} = 0;
       $args{logged_in}    = 0;
   
       *$self->{net_telnet_trango} = \%args;
   
     return $self;      return $self;
 }  }
   
Line 259 
Line 257 
   
 reboots the Trango and closes the connection  reboots the Trango and closes the connection
   
   =head2 B<reset> <all|0..2> - Sends a reset command
   
   resets settings to default
   
 =head2 B<remarks> - Set or retrieve the remarks.  =head2 B<remarks> - Set or retrieve the remarks.
   
 Takes an optional argument, which sets the remarks.  Takes an optional argument, which sets the remarks.
Line 315 
Line 317 
   
 Returns 1 on success, undef on failure.  Returns 1 on success, undef on failure.
   
 =head2 B<opmode> - sets opmode ap y or returns the opmode  =head2 B<set_baseid> - sets baseid
   
     $t->opmode([ap y]);      $t->set_baseid($baseid);
   
   =head2 B<set_suid> - sets baseid
   
       $t->set_suid($baseid);
   
   =head2 B<set_defaultopmode> - sets default opmode
   
       $t->set_defaultopmode(ap|su);
   
   =head2 B<opmode> - sets or returns the opmode
   
       $t->opmode([ap y|su y]);
   
   =head2 B<freq> - sets or returns the freq
   
       $channel = '11 v';
       $t->freq([$channel]);
   
   =head2 B<freq_writescan> - sets the freq writescan
   
       $channels = '11 v 11 h 12 v 12 h';
       $t->freq_writescan($channels);
   
   =head2 B<freq_scantable> - returns the freq scantable
   
       $channels = $t->freq_scantable();
       # now $channels eq '11 v 11 h 12 v 12 h';
   
   
 =cut  =cut
   
 my $success  = 'Success\\.';  my $success  = 'Success\\.';
 my %COMMANDS = (  my %COMMANDS = (
     _clear      => { String => "\n" },      _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 },
     updateflash => { decode    => 'all',       expect          => $success },      updateflash => { decode    => 'all', expect => $success },
     sulog       => { decode    => 'sulog',     expect          => $success },      sulog       => { decode    => 'sulog', expect => $success },
     'exit'      => { no_prompt => 1,           cmd_disconnects => 1 },      'exit'      => { no_prompt => 1, cmd_disconnects => 1 },
     reboot      => { no_prompt => 1,           cmd_disconnects => 1 },      reboot      => { no_prompt => 1, cmd_disconnects => 1 },
     remarks     => { decode    => 'all',       expect          => $success },      'reset'   => {},
     save_sudb   => { String    => 'save sudb', expect          => $success },      remarks   => { decode => 'all', expect => $success },
     syslog      => { expect    => $success },      save_sudb => { String => 'save sudb', expect => $success },
     'pipe'      => {},                        # XXX needs a special decode      syslog  => { expect => $success },
     maclist     => { decode => 'maclist' },      'pipe'  => {},      # XXX needs a special decode
     maclist_reset => { String => 'maclist reset', expect       => 'done' },      maclist => { decode => 'maclist' },
     eth_link    => { String => 'eth link',     expect          => $success },      maclist_reset => { String => 'maclist reset', expect => 'done' },
     su_info     =>      eth_link      => { String => 'eth link',      expect => $success },
       { String => 'su info',  decode => 'all', expect          => $success },      su_info => { String => 'su info', decode => 'all', expect => $success },
     su_testrflink =>      su_testrflink =>
       { 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 },      set_baseid => {
     arq         => { decode => 'all' },          String => 'set baseid',
           decode => 'all',
           expect => $success
       },
       set_suid => {
           String => 'set suid',
           decode => 'all',
           expect => $success
       },
       set_defaultopmode => {
           String => 'set defaultopmode',
           decode => 'all',
           expect => $success
       },
       opmode => { decode => 'all',  expect => $success },
       freq   => { decode => 'freq', expect => $success },
       freq_writescan =>
           { String => 'freq writescan', decode => 'all', expect => $success },
       freq_scantable =>
           { String => 'freq scantable', decode => 'all', expect => $success },
       arq => { decode => 'all' },
 );  );
   
 my %ALIASES = (  my %ALIASES = (
     bye     => 'exit',      bye               => 'exit',
     restart => 'reboot',      restart           => 'reboot',
     Host    => 'host',      Host              => 'host',
     save_systemseting => 'save_ss',      save_systemseting => 'save_ss',
 );  );
   
 my %ACCESS = map { $_ => 1 } qw(  my %ACCESS = map { $_ => 1 } qw(
   firmware_version      firmware_version
   host_type      host_type
   is_connected      is_connected
   logged_in      logged_in
   login_banner      login_banner
   Timeout      Timeout
   last_lines      last_lines
   last_vals      last_vals
   last_error      last_error
   Decode      Decode
 );  );
   
 sub AUTOLOAD {  sub AUTOLOAD {
     my $self = shift;      my $self = shift;
   
     my ($method) = ( our $AUTOLOAD ) =~ /^.*::(\w+)$/      my ($method) = ( our $AUTOLOAD ) =~ /^.*::(\w+)$/
       or die "Weird: $AUTOLOAD";          or die "Weird: $AUTOLOAD";
   
     if ( exists $ALIASES{$method} ) {      if ( exists $ALIASES{$method} ) {
         $method = $ALIASES{$method};          $method = $ALIASES{$method};
Line 389 
Line 439 
     }      }
   
     if ( exists $ACCESS{$method} ) {      if ( exists $ACCESS{$method} ) {
         my $prev = $PRIVATE{$method};          my $s    = *$self->{net_telnet_trango};
         ( $PRIVATE{$method} ) = @_ if @_;          my $prev = $s->{$method};
           ( $s->{$method} ) = @_ if @_;
         return $prev;          return $prev;
     }      }
   
Line 422 
Line 473 
             -match   => '/password: ?$/i',              -match   => '/password: ?$/i',
             -errmode => "return",              -errmode => "return",
         )          )
       )          )
     {      {
         $self->last_error( "problem connecting to host ("          $self->last_error( "problem connecting to host ("
               . $self->host . "): "                  . $self->host . "): "
               . $self->lastline );                  . $self->lastline );
         return;          return;
     }      }
   
Line 461 
Line 512 
             -match   => $self->prompt,              -match   => $self->prompt,
             -errmode => "return",              -errmode => "return",
         )          )
       )          )
     {      {
         $self->last_error( "login ($self->host) failed: " . $self->lastline );          $self->last_error( "login ($self->host) failed: " . $self->lastline );
         return;          return;
Line 491 
Line 542 
   
     my $banner = $self->login_banner;      my $banner = $self->login_banner;
   
     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 515 
Line 566 
   
 =cut  =cut
   
 sub linktest  sub linktest {
 {      my $self = shift;
     my $self    = shift;      my $suid = shift;
     my $suid    = shift;  
     # These numbers are what I found as defaults when running the command      # These numbers are what I found as defaults when running the command
     my $pkt_len = shift || 1600;      my $pkt_len = shift || 1600;
     my $pkt_cnt = shift || 500;      my $pkt_cnt = shift || 500;
     my $cycles  = shift || 10;      my $cycles  = shift || 10;
   
     my %config  = @_;      my %config = @_;
   
     # * 2, one for the FromAP, one FromSU.  Then / 1000 to get to ms.      # * 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      # 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.      # same as $pkt_len, and that might not be enough at slower speeds.
     $config{Timeout} ||= int(($pkt_len * $pkt_cnt * $cycles * 2 ) / 1000);      $config{Timeout} ||= int( ( $pkt_len * $pkt_cnt * $cycles * 2 ) / 1000 );
   
     my $string = join $SPACE, 'linktest', $suid, $pkt_len, $pkt_cnt, $cycles;      my $string = join $SPACE, 'linktest', $suid, $pkt_len, $pkt_cnt, $cycles;
     return $self->cmd(      return $self->cmd(
Line 563 
Line 614 
     }      }
   
     return $self->cmd(      return $self->cmd(
         String => 'su password ' . $su . $SPACE . $new_pass . $SPACE . $new_pass,          String => 'su password '
               . $su
               . $SPACE
               . $new_pass
               . $SPACE
               . $new_pass,
         expect => $success,          expect => $success,
     );      );
 }  }
   
 =pod  =pod
   
   =head2 B<ipconfig> - Change IP configuration
   
   ipconfig( 'new_ip', 'new_subnet', 'new_gateway' )
   
     $t->ipconfig( '10.0.1.5', '255.255.255.0', '10.0.1.1' );
   
   =cut
   
   sub ipconfig {
       my $self = shift;
   
       my $string = join $SPACE, 'ipconfig', @_;
   
       if ( @_ == 3 ) {
           $self->print($string);
           my @lines = $self->waitfor( Match => '/save\s+and\s+activate/', );
           $self->print('y');
   
           $self->logged_in(0);
           $self->is_connected(0);
   
           foreach my $line (@lines) {
               if ( $line =~ s/New \s configuration:\s+//xms ) {
                   return _decode_lines($line);
               }
           }
   
           return {};
       }
   
       # ipconfig [ <new ip> <new subnet> <new gateway> ]
       return $self->cmd( String => $string, expect => $success );
   }
   
   =pod
   
 =head2 B<su_ipconfig> - Change IP configuration on SUs connected to the AP.  =head2 B<su_ipconfig> - Change IP configuration on SUs connected to the AP.
   
 su_ipconfig( 'suid', 'new_ip', 'new_subnet', 'new_gateway' )  su_ipconfig( 'suid', 'new_ip', 'new_subnet', 'new_gateway' )
Line 605 
Line 697 
   
     # su ipconfig <suid> <new ip> <new subnet> <new gateway>      # su ipconfig <suid> <new ip> <new subnet> <new gateway>
     return $self->cmd(      return $self->cmd(
         String => 'su ipconfig ' . $suid . $SPACE . $new_ip . $SPACE          String => 'su ipconfig '
           . $new_subnet . $SPACE              . $suid
           . $new_gateway,              . $SPACE
               . $new_ip
               . $SPACE
               . $new_subnet
               . $SPACE
               . $new_gateway,
         expect => $success,          expect => $success,
     );      );
 }  }
Line 617 
Line 714 
 =head2 B<sudb_view> - Returns the output from the sudb view command  =head2 B<sudb_view> - Returns the output from the sudb view command
   
 returns a reference to an array of hashes each containing these keys  returns a reference to an array of hashes each containing these keys
 'suid', 'type', 'cir', 'mir' and 'mac'  'suid', 'su2su', 'type', 'cir', 'mir' and 'mac'
   
 =cut  =cut
   
Line 628 
Line 725 
   
     return unless @{$lines};      return unless @{$lines};
   
     unless ( $PRIVATE{'Decode'} ) {      my $s = *$self->{net_telnet_trango};
         return $lines;      return $lines if !$s->{'Decode'};
     }  
   
     my @sus;      my @sus;
     foreach ( @{$lines} ) {      foreach ( @{$lines} ) {
         next unless $_;          next unless $_;
         if (/^\[(\d+)\]\s+(\d+)\s+(\d+)\s+(\d+)\s+([0-9A-Fa-f\s]+)$/) {          if (/^
               \[(\d+)\]
               \s+
               [[:xdigit:]]{2}
               ([[:xdigit:]])
               ([[:xdigit:]])
               \s+
               (\d+)
               \s+
               (\d+)
               \s+
               ([[:xdigit:]\s]+)
           $/ixms
               )
           {
             my %s = (              my %s = (
                 suid => $1,                  suid  => $1,
                 type => $2,                  su2su => $2 ? $2 : undef,
                 cir  => $3,                  type  => $3 == 1 ? 'reg' : $3 == 5 ? 'pri' : $3,
                 mir  => $4,                  cir   => $4,
                 mac  => $5,                  mir   => $5,
                   mac   => $6,
             );              );
   
             $s{'mac'} =~ s/\s//g;              $s{'mac'} =~ s/\s//gxms;
             $s{'mac'} = uc( $s{'mac'} );              $s{'mac'} = uc( $s{'mac'} );
   
             push @sus, \%s;              push @sus, \%s;
Line 704 
Line 815 
     }      }
   
     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;
     }      }
     $new_mac = join $SPACE, $new_mac =~ /../g;      $new_mac = join $SPACE, $new_mac =~ /../g;
   
     my $string =      my $string
       'sudb add ' . $suid . $SPACE . $type . $SPACE . $cir . $SPACE . $mir . $SPACE          = 'sudb add '
       . $new_mac;          . $suid
           . $SPACE
           . $type
           . $SPACE
           . $cir
           . $SPACE
           . $mir
           . $SPACE
           . $new_mac;
   
     return $self->cmd( String => $string, expect => $success );      return $self->cmd( String => $string, expect => $success );
 }  }
Line 881 
Line 1000 
   
 sub cmd {  sub cmd {
     my $self = shift;      my $self = shift;
       my $s    = *$self->{net_telnet_trango};
   
     my @valid_net_telnet_opts = qw(      my @valid_net_telnet_opts = qw(
       String          String
       Output          Output
       Cmd_remove_mode          Cmd_remove_mode
       Errmode          Errmode
       Input_record_separator          Input_record_separator
       Ors          Ors
       Output_record_separator          Output_record_separator
       Prompt          Prompt
       Rs          Rs
       Timeout          Timeout
     );      );
   
     my %cfg;      my %cfg;
Line 942 
Line 1062 
   
     $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 ( $s->{'Decode'} && $cfg{'decode'} ) {
         if ( $cfg{'decode'} eq 'each' ) {          if ( $cfg{'decode'} eq 'each' ) {
             $vals = _decode_each_line(@lines);              $vals = _decode_each_line(@lines);
         }          }
Line 952 
Line 1082 
         }          }
         elsif ( $cfg{'decode'} eq 'maclist' ) {          elsif ( $cfg{'decode'} eq 'maclist' ) {
             $vals = _decode_maclist(@lines);              $vals = _decode_maclist(@lines);
             if (! $vals) {              if ( !$vals ) {
                 $self->last_error("Error decoding maclist");                  $self->last_error("Error decoding maclist");
             }              }
         }          }
         elsif ( $cfg{'decode'} eq 'linktest' ) {          elsif ( $cfg{'decode'} eq 'linktest' ) {
             $vals = _decode_linktest(@lines);              $vals = _decode_linktest(@lines);
             if (! $vals) {              if ( !$vals ) {
                 $self->last_error("Error decoding linktest");                  $self->last_error("Error decoding linktest");
             }              }
         }          }
           elsif ( $cfg{'decode'} eq 'freq' ) {
               $vals = _decode_freq(@lines);
           }
         else {          else {
             $vals = _decode_lines(@lines);              $vals = _decode_lines(@lines);
         }          }
     }      }
       if ( ref $vals eq 'HASH' ) {
           $vals->{_raw} = join q{}, @lines;
       }
     $self->last_vals($vals);      $self->last_vals($vals);
   
     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'} ) {
             $self->logged_in(0);              $self->logged_in(0);
Line 979 
Line 1111 
             $self->is_connected(0);              $self->is_connected(0);
         }          }
   
         if ( $PRIVATE{'Decode'} && $cfg{'decode'} ) {          if ( $s->{'Decode'} && $cfg{'decode'} ) {
             return $vals;              return $vals;
         }          }
         else {          else {
Line 988 
Line 1120 
     }      }
     else {      else {
         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 ($cmd{'String'}): $last");              $self->last_error("Error with command ($cmd{'String'}): $last");
         }          }
         return;          return;
Line 1014 
Line 1147 
     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 1038 
Line 1216 
   
                     if ($val) {                      if ($val) {
                         $val =~ s/^\s+//;                          $val =~ s/^\s+//;
                         $val =~ s/\s+$//;                          $val =~ s/\s+\.*$//;
                     }                      }
   
                     if ( $key eq 'Checksum' && $last_key ) {                      if ( $key eq 'Checksum' && $last_key ) {
Line 1079 
Line 1257 
         push @vals, $val;          push @vals, $val;
     }      }
   
       foreach my $val (@vals) {
           if ( defined $val && length $val ) {
               $val =~ s/^\s+//;
               $val =~ s/\s+\.*$//;
           }
       }
   
     if ( @vals == 1 ) {      if ( @vals == 1 ) {
         $val = $vals[0];          $val = $vals[0];
     }      }
Line 1105 
Line 1290 
     my @decoded;      my @decoded;
     foreach my $line (@lines) {      foreach my $line (@lines) {
         my $decoded = _decode_lines($line);          my $decoded = _decode_lines($line);
         push @decoded, $decoded if defined $decoded;          push @decoded, $decoded if defined $decoded && length $decoded;
     }      }
     return \@decoded;      return \@decoded;
 }  }
Line 1117 
Line 1302 
     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 ($tm, $rt);              my ( $tm, $rt );
                         if ($line =~ s/\s+ (\d+ \s+ \w+) $//xms) {              if ( $line =~ s/\s+ (\d+ \s+ \w+) \s* $//xms ) {
                                 $rt = $1;                  $rt = $1;
                         }              }
                         if ($line =~ s/\s+ (\d+ \s+ \w+) $//xms) {              if ( $line =~ s/\s+ (\d+ \s+ \w+) \s* $//xms ) {
                                 $tm = $1;                  $tm = $1;
                         }              }
   
             my $d = _decode_lines($line. "\n");              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]{'time'} = $tm;
             $decoded{tests}[$line_id]{rate}   = $rt;              $decoded{tests}[$line_id]{rate}   = $rt;
         }          }
   
         else {          else {
             my $d = _decode_lines($line . "\n");              my $d = _decode_lines( $line . "\n" );
             if ($d) {              if ($d) {
                 while (my ($k, $v) = each %{ $d }) {                  while ( my ( $k, $v ) = each %{$d} ) {
                     $decoded{$k} = $v;                      $decoded{$k} = $v;
                 }                  }
            }              }
         }          }
   
     }      }
Line 1199 
Line 1384 
             }              }
   
             push @decoded,              push @decoded,
               {                  {
                 mac  => $mac,                  mac  => $mac,
                 loc  => $loc,                  loc  => $loc,
                 tm   => $tm,                  tm   => $tm,
                 suid => $suid,                  suid => $suid,
               };                  };
         }          }
         elsif ( $line =~ /(\d+)\s+entries/ ) {          elsif ( $line =~ /(\d+)\s+entries/ ) {
             $total_entries = $1;              $total_entries = $1;
Line 1222 
Line 1407 
     else {      else {
         return;          return;
     }      }
   }
   
   #=item _decode_freq
   
   sub _decode_freq {
       my @lines   = @_;
       my $decoded = _decode_lines(@lines);
   
       if ( $decoded && $decoded->{ERR} ) {
           return $decoded;
       }
   
   LINE: foreach my $line (@lines) {
           if (my ( $channel, $polarity, $freq )
               = $line =~ /
               Ch \s+ \#(\d+)
               \s+
               (\w+)
               \s+
               \[ (\d+) \s+ MHz\]
           /ixms
               )
           {
               $decoded = {
                   channel   => $channel,
                   polarity  => $polarity,
                   frequency => $freq,
               };
               last LINE;
           }
       }
       return $decoded;
 }  }
   
 1;    # End of Net::Telnet::Trango  1;    # End of Net::Telnet::Trango
Legend:
Removed from v.1.49  
changed lines
  Added in v.1.60
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>