[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.55 and 1.59

version 1.55, 2009/07/08 18:00:55 version 1.59, 2009/07/31 22:44:33
Line 1 
Line 1 
 package Net::Telnet::Trango;  package Net::Telnet::Trango;
   
 # $RedRiver: Trango.pm,v 1.54 2008/10/29 17:34:06 andrew Exp $  # $RedRiver: Trango.pm,v 1.58 2009/07/13 16:33:45 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 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 83 
Line 78 
   
     $args{'Prompt'} ||= '/[\$#]>\s*\r?\n?$/';      $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 711 
Line 822 
     }      }
     $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 $last   = $self->lastline;
     my $prompt = $self->prompt;      my $prompt = $self->prompt;
     $prompt =~ s{^/}{}xms;      $prompt =~ s{^/}{}xms;
     $prompt =~ s{/[gixms]*$}{}xms;      $prompt =~ s{/[gixms]*$}{}xms;
     while (@lines && $last =~ qr($prompt)) {      while ( @lines && $last =~ qr($prompt) ) {
         pop @lines;          pop @lines;
         $last = $lines[-1];          $last = $lines[-1];
     }      }
     $self->last_error($EMPTY);      $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 962 
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);
   
     if ( ( not $cfg{'expect'} ) || $last =~ /$cfg{'expect'}$/ ) {      if ( ( not $cfg{'expect'} ) || $last =~ /$cfg{'expect'}$/ ) {
Line 985 
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 994 
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 1020 
Line 1147 
     my $in_key = 0;      my $in_key = 0;
     my $in_val = 1;      my $in_val = 1;
   
     LINE: while (my $line = shift @lines) {  LINE: while ( my $line = shift @lines ) {
         next LINE if $line =~ /$success\Z/;          next LINE if $line =~ /$success\Z/;
         next LINE if $line =~ /^ \*+ \s+ \d+ \s+ \*+ \Z/xms;          next LINE if $line =~ /^ \*+ \s+ \d+ \s+ \*+ \Z/xms;
   
         # Special decode for sysinfo on a TrangoLink 45          # Special decode for sysinfo on a TrangoLink 45
         if ($line =~ /^(.* Channel \s+ Table):\s*(.*)\Z/xms) {          if ( $line =~ /^(.* Channel \s+ Table):\s*(.*)\Z/xms ) {
             my $key  = $1;              my $key  = $1;
             my $note = $2;              my $note = $2;
   
             my %vals;              my %vals;
             while ($line = shift @lines) {              while ( $line = shift @lines ) {
                 if ($line =~ /^\Z/) {                  if ( $line =~ /^\Z/ ) {
                     $conf{$key} = \%vals;                      $conf{$key} = \%vals;
                     $conf{$key}{note} = $note;                      $conf{$key}{note} = $note;
                     next LINE;                      next LINE;
Line 1039 
Line 1166 
   
                 my $decoded = _decode_lines($line);                  my $decoded = _decode_lines($line);
                 if ($decoded) {                  if ($decoded) {
                     %vals = (%vals, %{ $decoded });                      %vals = ( %vals, %{$decoded} );
                 }                  }
             }              }
         }          }
   
         # Another special decode for the TrangoLink          # Another special decode for the TrangoLink
         elsif ($line =~ /^          elsif (
               $line =~ /^
             RF \s Band \s \#              RF \s Band \s \#
             (\d+) \s+              (\d+) \s+
             \( ([^\)]+) \) \s*              \( ([^\)]+) \) \s*
             (.*)$              (.*)$
         /xms) {          /xms
               )
           {
             my $num   = $1;              my $num   = $1;
             my $band  = $2;              my $band  = $2;
             my $extra = $3;              my $extra = $3;
   
             if ($extra =~ /\[/) {              if ( $extra =~ /\[/ ) {
                 my $decoded = _decode_lines($extra);                  my $decoded = _decode_lines($extra);
                 $conf{'RF Band'}{$num} = $decoded;                  $conf{'RF Band'}{$num} = $decoded;
             }              }
Line 1085 
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 1126 
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 1152 
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 1164 
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+) \s* $//xms) {              if ( $line =~ s/\s+ (\d+ \s+ \w+) \s* $//xms ) {
                                 $rt = $1;                  $rt = $1;
                         }              }
                         if ($line =~ s/\s+ (\d+ \s+ \w+) \s* $//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 1246 
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 1269 
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.55  
changed lines
  Added in v.1.59
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>