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

version 1.57, 2009/07/09 22:50:03 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.56 2009/07/08 17:16: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.03';  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\\.';
Line 331 
Line 361 
     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 },
       'pipe'  => {},      # XXX needs a special decode
     maclist => { decode => 'maclist' },      maclist => { decode => 'maclist' },
     maclist_reset => { String => 'maclist reset', expect => 'done' },      maclist_reset => { String => 'maclist reset', expect => 'done' },
     eth_link => { String => 'eth link', expect => $success },      eth_link      => { String => 'eth link',      expect => $success },
     su_info  => { 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 = (
Line 388 
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 574 
Line 626 
   
 =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 637 
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} ) {
Line 653 
Line 740 
             \s+              \s+
             (\d+)              (\d+)
             \s+              \s+
               (\d+)
               \s+
             ([[:xdigit:]\s]+)              ([[:xdigit:]\s]+)
         $/ixms          $/ixms
             )              )
Line 911 
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
Line 983 
Line 1073 
     $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 1002 
Line 1092 
                 $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 1015 
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 1120 
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 1161 
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 1187 
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 1304 
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.57  
changed lines
  Added in v.1.60
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>