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

version 1.39, 2007/02/06 20:41:42 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.38 2007/02/06 16:22:46 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';
   
 =pod  =pod
   
 =head1 NAME  =head1 NAME
   
 Net::Telnet::Trango  Net::Telnet::Trango
 - Perl extension for accessing the Trango telnet interface  - Perl extension for accessing the Trango telnet interface
   
 =head1 SYNOPSIS  =head1 SYNOPSIS
   
   use Net::Telnet::Trango;    use Net::Telnet::Trango;
   my $t = new Net::Telnet::Trango ( Timeout => 5 );    my $t = new Net::Telnet::Trango ( Timeout => 5 );
   
   $t->open( Host => $fox ) or die "Error connecting: $!";    $t->open( Host => $ap ) or die "Error connecting: $!";
   
   $t->login('password') or die "Couldn't log in: $!";    $t->login('password') or die "Couldn't log in: $!";
   
   # Do whatever    # Do whatever
   
   $t->exit;    $t->exit;
   $t->close;    $t->close;
   
 =head1 DESCRIPTION  =head1 DESCRIPTION
   
 Perl access to the telnet interface on Trango Foxes, SUs and APs.  Perl access to the telnet interface on Trango APs and SUs.
   
 Another handy feature is that it will parse the output from certain  A handy feature is that it will parse the output from certain commands that is
 commands that is in the format "[key1] value1 [key2] value2" and put  in the format "[key1] value1 [key2] value2" and put those in a hashref that is
 those in a hashref that is returned.  This makes using the output from  returned.  This makes using the output from things like sysinfo very easy to
 things like sysinfo very easy to do.  do.
   
 =head2 EXPORT  =head2 EXPORT
   
 None  None
   
 =head1 METHODS  =head1 METHODS
   
 =cut  =cut
   
 our $VERSION = '0.01';  our $VERSION = '0.05';
   
 my $EMPTY = q{};  my $EMPTY = q{};
 my $SPACE = q{ };  my $SPACE = q{ };
   
 my %PRIVATE = (  =pod
     is_connected => 0,  
     logged_in    => 0,  =head2 B<new> - Creates a new Net::Telnet::Trango object.
 );  
       new([Options from Net::Telnet,]
 =pod          [Decode => 0,]);
   
 =head2 B<new> - Creates a new Net::Telnet::Trango object.  Same as new from L<Net::Telnet> but sets the default Trango Prompt:
   '/[\$#]>\s*\Z/'
     new([Options from Net::Telnet,]  
         [Decode => 0,]);  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
 Same as new from L<Net::Telnet> but sets the default Trango Prompt:  instead return a reference to an array of the lines that were returned
 '/#> *$/'  from the command.
   
 It also takes an optional parameter 'Decode'.  If not defined it  =cut
 defaults to 1, if it is set to 0, it will not decode the output and  
 instead return a reference to an array of the lines that were returned  sub new {
 from the command.      my $class = shift;
   
 =cut      my %args = ();
       if ( @_ == 1 ) {
 sub new {          $args{'Host'} = shift;
     my $class = shift;      }
       else {
     my %args;          %args = @_;
     if ( @_ == 1 ) {      }
         $args{'Host'} = shift;  
     }      $args{'Prompt'} ||= '/[\$#]>\s*\r?\n?$/';
     else {  
         %args = @_;      my $decode = $args{'Decode'};
     }      delete $args{'Decode'};
   
     $args{'Prompt'} ||= '/#> *$/';      my $self = $class->SUPER::new(%args);
       bless $self if ref $self;
     foreach my $key ( keys %args ) {  
         $PRIVATE{$key} = $args{$key};      $args{Decode}       = defined $decode ? $decode : 1;
     }      $args{is_connected} = 0;
     $PRIVATE{'Decode'} = 1 unless defined $PRIVATE{'Decode'};      $args{logged_in}    = 0;
     delete $args{'Decode'};  
       *$self->{net_telnet_trango} = \%args;
     my $self = $class->SUPER::new(%args);  
     bless $self if ref $self;      return $self;
   }
     return $self;  
 }  #  _password <new password> <new password>
   #  ? [command]
 #  _password <new password> <new password>  #  apsearch <secs> <ch#> <h|v> [<ch#> <h|v>]...
 #  ? [command]  #  arp -bcast <on|off>
 #  apsearch <secs> <ch#> <h|v> [<ch#> <h|v>]...  #  bcastscant <all|suid> <ch#> <h|v> [<ch#> <h|v> ...
 #  arp -bcast <on|off>  #  bye
 #  bcastscant <all|suid> <ch#> <h|v> [<ch#> <h|v> ...  #  cf2cf ap [default|<size>]
 #  bye  #  date
 #  cf2cf ap [default|<size>]  #  date <month> <day> <year>
 #  date  #  freq scantable
 #  date <month> <day> <year>  #  freq channeltable
 #  freq scantable  #  freq writescan [<ch#> <h|v>]
 #  freq channeltable  #  freq writechannel [<ch#> <freq>] ...
 #  freq writescan [<ch#> <h|v>]  #  freq <ch #> <h|v>
 #  freq writechannel [<ch#> <freq>] ...  #  help [command]
 #  freq <ch #> <h|v>  #  heater [<on temp> <off temp>]
 #  help [command]  #  ipconfig [<new ip> <new subnet mask> <new gateway>]
 #  heater [<on temp> <off temp>]  #  linktest <suid> [<pkt len, bytes> [<# of pkts> [<# of cycle>]]]
 #  ipconfig [<new ip> <new subnet mask> <new gateway>]  #  log [<# of entries, 1..179>]
 #  log [<# of entries, 1..179>]  #  log <sum> <# of entries, 1..179>
 #  log <sum> <# of entries, 1..179>  #  logout
 #  logout  #  opmode [ap [y]]
 #  opmode [ap [y]]  #  password
 #  password  #  ping <ip addr>
 #  ping <ip addr>  #  polar <h|v>
 #  polar <h|v>  #  power <setism|setunii> <max|min|<dBm>>
 #  power <setism|setunii> <max|min|<dBm>>  #  reboot
 #  reboot  #  restart
 #  restart  #  remarks [<str>]
 #  remarks [<str>]  #  rfrxthreshold [<ism|unii> <-90|-85|-80|-75|-70|-65>]
 #  rfrxthreshold [<ism|unii> <-90|-85|-80|-75|-70|-65>]  #  rfrxth [<ism|unii> <-90|-85|-80|-75|-70|-65>]
 #  rfrxth [<ism|unii> <-90|-85|-80|-75|-70|-65>]  #  sysinfo
 #  sysinfo  #  set suid <id>
 #  set suid <id>  #  set apid <id>
 #  set apid <id>  #  set baseid <id>
 #  set baseid <id>  #  set defaultopmode [<ap|su> <min,0..10>]
 #  set defaultopmode [<ap|su> <min,0..10>]  #  set defaultopmode off
 #  set defaultopmode off  #  set snmpcomm [<read | write | trap (id or setall)> <str>]
 #  set snmpcomm [<read | write | trap (id or setall)> <str>]  #  set mir [on|off]
 #  set mir [on|off]  #  set mir threshold <kbps>
 #  set mir threshold <kbps>  #  set rssitarget [<ism|unii> <dBm>]
 #  set rssitarget [<ism|unii> <dBm>]  #  set serviceradius [<ism | unii> <miles>]
 #  set serviceradius [<ism | unii> <miles>]  #  ssrssi <ch #> <h|v>
 #  ssrssi <ch #> <h|v>  #  su [<suid>|all]
 #  su [<suid>|all]  #  su changechannel <all|suid> <ch#> <h|v>
 #  su changechannel <all|suid> <ch#> <h|v>  #  su ipconfig <suid> <new ip> <new subnet> <new gateway>
 #  su ipconfig <suid> <new ip> <new subnet> <new gateway>  #  su [live|poweroff|priority]
 #  su [live|poweroff|priority]  #  su <ping|info|status> <suid>
 #  su <ping|info|status> <suid>  #  su powerleveling <all|suid>
 #  su powerleveling <all|suid>  #  su reboot <all|suid>
 #  su reboot <all|suid>  #  su restart <all|suid>
 #  su restart <all|suid>  #  su testrflink <all|suid> [r]
 #  su testrflink <all|suid> [r]  #  su testrflink <setlen> [64..1600]
 #  su testrflink <setlen> [64..1600]  #  su testrflink <aptx> [20..100]
 #  su testrflink <aptx> [20..100]  #  su sw <suid|all> <sw #> <on|off>
 #  su sw <suid|all> <sw #> <on|off>  #  sudb [dload | view]
 #  sudb [dload | view]  #  sudb add <suid> pr <cir,kbps> <mir,kbps> <device id,hex>
 #  sudb add <suid> pr <cir,kbps> <mir,kbps> <device id,hex>  #  sudb add <suid> reg <cir,kbps> <mir,kbps> <device id,hex>
 #  sudb add <suid> reg <cir,kbps> <mir,kbps> <device id,hex>  #  sudb delete <all|<suid>>
 #  sudb delete <all|<suid>>  #  sudb modify <suid> <cir|mir> <kbps>
 #  sudb modify <suid> <cir|mir> <kbps>  #  sudb modify <suid> <su2su> <group id,hex>
 #  sudb modify <suid> <su2su> <group id,hex>  #  sudb view
 #  sudb view  #  sulog [lastmins | sampleperiod <1..60>]
 #  sulog [lastmins | sampleperiod <1..60>]  #  sulog [<# of entry,1..18>]
 #  sulog [<# of entry,1..18>]  #  survey <ism|unii> <time, sec> <h|v>
 #  survey <ism|unii> <time, sec> <h|v>  #  sw [<sw #> <on|off>]
 #  sw [<sw #> <on|off>]  #  temp
 #  temp  #  tftpd [on|off]
 #  tftpd [on|off]  #  time
 #  time  #  time <hour> <min> <sec>
 #  time <hour> <min> <sec>  #  save <mainimage|fpgaimage> <current chksum> <new chksum>
 #  save <mainimage|fpgaimage> <current chksum> <new chksum>  #  save <systemsetting|sudb>
 #  save <systemsetting|sudb>  #  updateflash <mainimage|fpgaimage> <current chksum> <new chksum>
 #  updateflash <mainimage|fpgaimage> <current chksum> <new chksum>  #  updateflash <systemsetting|sudb>
 #  updateflash <systemsetting|sudb>  
   =pod
 =pod  
   =head1 ACCESSORS
 =head1 ACCESSORS  
   These are usually only set internally.
 These are usually only set internally.  
   =head2 B<firmware_version> - returns the firmware version
 =head2 B<firmware_version> - returns the firmware version  
   Returns the firmware version if available, otherwise undef.
 Returns the firmware version if available, otherwise undef.  
   It should be available after a successful open().
 It should be available after a successful open().  
   =head2 B<host_type> - return the type of host you are connected to.
 =head2 B<host_type> - return the type of host you are connected to.  
   returns the type of host from the login banner for example M5830S or M5300S.
 returns the type of host from the login banner for example M5830S or M5300S.    
   Should be available after a successful open().
 Should be available after a successful open().  
   =head2 B<is_connected> - Status of the connection to host.
 =head2 B<is_connected> - Status of the connection to host.  
   returns 1 when connected, undef otherwise.
 returns 1 when connected, undef otherwise.  
   =head2 B<logged_in> - Status of being logged in to the host.
 =head2 B<logged_in> - Status of being logged in to the host.  
   returns 1 after a successful login(), 0 if it failed and undef if
 returns 1 after a successful login(), 0 if it failed and undef if  login() was never called.
 login() was never called.  
   =head2 B<login_banner> - The banner when first connecting to the host.
 =head2 B<login_banner> - The banner when first connecting to the host.  
   returns the banner that is displayed when first connected at login.
 returns the banner that is displayed when first connected at login.    Only set after a successful open().
 Only set after a successful open().  
   =head2 B<last_lines> - The last lines of output from the last cmd().
 =head2 B<last_lines> - The last lines of output from the last cmd().  
   returns, as an array ref, the output from the last cmd() that was run.
 returns, as an array ref, the output from the last cmd() that was run.  
   =head2 B<last_error> - A text output of the last error that was encountered.
 =head2 B<last_error> - A text output of the last error that was encountered.  
   returns the last error reported.  Probably contains the last entry in
 returns the last error reported.  Probably contains the last entry in  last_lines.
 last_lines.  
   =head1 ALIASES
 =head1 ALIASES  
   =head2 B<bye> - alias of exit()
 =head2 B<bye> - alias of exit()  
   Does the same as exit()
 Does the same as exit()  
   =head2 B<restart> - alias of reboot()
 =head2 B<restart> - alias of reboot()  
   Does the same as reboot()
 Does the same as reboot()  
   =head2 B<save_systemsetting> - alias of save_ss()
 =head2 B<save_systemsetting> - alias of save_ss()  
   Does the same as save_ss()
 Does the same as save_ss()  
   =head1 COMMANDS
 =head1 COMMANDS  
   Most of these are just shortcuts to C<cmd(String =E<gt> METHOD)>,
 Most of these are just shortcuts to C<cmd(String =E<gt> METHOD)>,  as such they accept the same options as C<cmd()>.
 as such they accept the same options as C<cmd()>.    Specifically they take a named paramater "args", for example:
 Specifically they take a named paramater "args", for example:  C<tftpd(args =E<gt> 'on')> would enable tftpd
 C<tftpd(args =E<gt> 'on')> would enable tftpd  
   =head2 B<tftpd> - The output from the tftpd command
 =head2 B<tftpd> - The output from the tftpd command  
   Returns a hash ref of the decoded output from the
 Returns a hash ref of the decoded output from the  command.
 command.  
   Also see enable_tftpd() and disable_tftpd() as those check that it was
 Also see enable_tftpd() and disable_tftpd() as those check that it was  successfully changed.
 successfully changed.  
   =head2 B<ver> - The output from the ver command
 =head2 B<ver> - The output from the ver command  
   Returns a hash ref of the decoded output from the
 Returns a hash ref of the decoded output from the  command.
 command.  
   =head2 B<sysinfo> - The output from the sysinfo command
 =head2 B<sysinfo> - The output from the sysinfo command  
   Returns a hash ref of the decoded output from the
 Returns a hash ref of the decoded output from the  command.
 command.  
   =head2 B<exit> - Exits the connection
 =head2 B<exit> - Exits the connection  
   exits the command session with the Trango and closes
 exits the command session with the Trango and closes  the connection
 the connection  
   =head2 B<reboot> - Sends a reboot command
 =head2 B<reboot> - Sends a reboot command  
   reboots the Trango and closes the connection
 reboots the Trango and closes the connection  
   =head2 B<reset> <all|0..2> - Sends a reset command
 =head2 B<remarks> - Set or retrieve the remarks.  
   resets settings to default
 Takes an optional argument, which sets the remarks.    
 If there is no argument, returns the current remarks.  =head2 B<remarks> - Set or retrieve the remarks.
   
   my $old_remarks = $t->remarks();  Takes an optional argument, which sets the remarks.
   $t->remarks($new_remarks);  If there is no argument, returns the current remarks.
   
 =head2 B<sulog> - The output from the sulog command    my $old_remarks = $t->remarks();
     $t->remarks($new_remarks);
 Returns an array ref of hashes containing each log  
 line.  =head2 B<sulog> - The output from the sulog command
   
 =head2 B<save_sudb> - saves the sudb  Returns an array ref of hashes containing each log
   line.
 Returns true on success, undef on failure  
   =head2 B<save_sudb> - saves the sudb
 =head2 B<syslog> - The output from the sulog command  
   Returns true on success, undef on failure
 Returns a hashref of the output from the syslog command  
   =head2 B<syslog> - The output from the sulog command
 =head2 B<pipe> - the pipe command  
   Returns a hashref of the output from the syslog command
 Returns the output from the pipe command  
   =head2 B<pipe> - the pipe command
 =head2 B<maclist> - retrieves the maclist  
   Returns the output from the pipe command
 Returns the output from the maclist command  
   =head2 B<maclist> - retrieves the maclist
 =head2 B<maclist_reset> - resets the maclist.    
   Returns the output from the maclist command
 No useful output.  
   =head2 B<maclist_reset> - resets the maclist.
 =head2 B<eth_link> - eth link command  
   No useful output.
 Returns the output from the eth link command  
   =head2 B<eth_link> - eth link command
 This command seems to cause some weird issues.  It often will cause the  
 command after it to appear to fail.  I am not sure why.  Returns the output from the eth link command
   
 =head2 B<su_info> - gets the su info  This command seems to cause some weird issues.  It often will cause the
   command after it to appear to fail.  I am not sure why.
 Returns information about the SU.  
   =head2 B<su_info> - gets the su info
 You need to pass in the $suid and it will return the info for that suid.  
   Returns information about the SU.
   $t->su_info($suid);  
   You need to pass in the $suid and it will return the info for that suid.
 =head2 B<su_testrflink> - tests the RF Link to an su  
     $t->su_info($suid);
   $t->su_testrflink($suid|'all');  
   =head2 B<su_testrflink> - tests the RF Link to an su
 =head2 B<save_ss> - saves the config.    
     $t->su_testrflink($suid|'all');
 Returns 1 on success, undef on failure.  
   =head2 B<save_ss> - saves the config.
 =head2 B<opmode> - sets opmode ap y or returns the opmode  
   Returns 1 on success, undef on failure.
     $t->opmode([ap y]);  
   =head2 B<set_baseid> - sets baseid
 =cut  
       $t->set_baseid($baseid);
 my $success  = 'Success\\.';  
 my %COMMANDS = (  =head2 B<set_suid> - sets baseid
     tftpd       => { decode    => 'all',       expect          => $success },  
     ver         => { decode    => 'all' },      $t->set_suid($baseid);
     sysinfo     => { decode    => 'all',       expect          => $success },  
     updateflash => { decode    => 'all',       expect          => $success },  =head2 B<set_defaultopmode> - sets default opmode
     sulog       => { decode    => 'sulog',     expect          => $success },  
     'exit'      => { no_prompt => 1,           cmd_disconnects => 1 },      $t->set_defaultopmode(ap|su);
     reboot      => { no_prompt => 1,           cmd_disconnects => 1 },  
     remarks     => { decode    => 'all',       expect          => $success },  =head2 B<opmode> - sets or returns the opmode
     save_sudb   => { String    => 'save sudb', expect          => $success },  
     syslog      => { expect    => $success },      $t->opmode([ap y|su y]);
     'pipe'      => {},                        # XXX needs a special decode  
     maclist     => { decode => 'maclist' },  =head2 B<freq> - sets or returns the freq
     maclist_reset => { String => 'maclist reset', expect       => 'done' },  
     eth_link    => { String => 'eth link',     expect          => $success },      $channel = '11 v';
     su_info     =>      $t->freq([$channel]);
       { String => 'su info',  decode => 'all', expect          => $success },  
     su_testrflink =>  =head2 B<freq_writescan> - sets the freq writescan
       { String => 'su testrflink', decode => 'each', expect    => $success },  
     save_ss     => { String => 'save ss',      expect          => $success },      $channels = '11 v 11 h 12 v 12 h';
     opmode      => { decode => 'all',          expect          => $success },      $t->freq_writescan($channels);
 );  
   =head2 B<freq_scantable> - returns the freq scantable
 my %ALIASES = (  
     bye     => 'exit',      $channels = $t->freq_scantable();
     restart => 'reboot',      # now $channels eq '11 v 11 h 12 v 12 h';
     Host    => 'host',  
     save_systemseting => 'save_ss',  
 );  =cut
   
 my %ACCESS = map { $_ => 1 } qw(  my $success  = 'Success\\.';
   firmware_version  my %COMMANDS = (
   host_type      _clear      => { String    => "\n" },
   is_connected      tftpd       => { decode    => 'all', expect => $success },
   logged_in      ver         => { decode    => 'all' },
   login_banner      sysinfo     => { decode    => 'all', expect => $success },
   Timeout      updateflash => { decode    => 'all', expect => $success },
   last_lines      sulog       => { decode    => 'sulog', expect => $success },
   last_vals      'exit'      => { no_prompt => 1, cmd_disconnects => 1 },
   last_error      reboot      => { no_prompt => 1, cmd_disconnects => 1 },
   Decode      'reset'   => {},
 );      remarks   => { decode => 'all', expect => $success },
       save_sudb => { String => 'save sudb', expect => $success },
 sub AUTOLOAD {      syslog  => { expect => $success },
     my $self = shift;      'pipe'  => {},      # XXX needs a special decode
       maclist => { decode => 'maclist' },
     my ($method) = ( our $AUTOLOAD ) =~ /^.*::(\w+)$/      maclist_reset => { String => 'maclist reset', expect => 'done' },
       or die "Weird: $AUTOLOAD";      eth_link      => { String => 'eth link',      expect => $success },
       su_info => { String => 'su info', decode => 'all', expect => $success },
     if ( exists $ALIASES{$method} ) {      su_testrflink =>
         $method = $ALIASES{$method};          { String => 'su testrflink', decode => 'each', expect => $success },
         return $self->$method(@_);      save_ss    => { String => 'save ss', expect => $success },
     }      set_baseid => {
           String => 'set baseid',
     if ( exists $COMMANDS{$method} ) {          decode => 'all',
         my %cmd;          expect => $success
         foreach my $k ( keys %{ $COMMANDS{$method} } ) {      },
             $cmd{$k} = $COMMANDS{$method}{$k};      set_suid => {
         }          String => 'set suid',
         $cmd{'String'} ||= $method;          decode => 'all',
         $cmd{'args'} .= $SPACE . shift if ( @_ == 1 );          expect => $success
         return $self->cmd( %cmd, @_ );      },
     }      set_defaultopmode => {
           String => 'set defaultopmode',
     if ( exists $ACCESS{$method} ) {          decode => 'all',
         my $prev = $PRIVATE{$method};          expect => $success
         ( $PRIVATE{$method} ) = @_ if @_;      },
         return $prev;      opmode => { decode => 'all',  expect => $success },
     }      freq   => { decode => 'freq', expect => $success },
       freq_writescan =>
     $method = "SUPER::$method";          { String => 'freq writescan', decode => 'all', expect => $success },
     return $self->$method(@_);      freq_scantable =>
 }          { String => 'freq scantable', decode => 'all', expect => $success },
       arq => { decode => 'all' },
 =pod  );
   
 =head2 B<open> - Open a connection to a Trango AP.  my %ALIASES = (
       bye               => 'exit',
 Calls Net::Telnet::open() then makes sure you get a password prompt so      restart           => 'reboot',
 you are ready to login() and parses the login banner so you can get      Host              => 'host',
 host_type() and firmware_version()      save_systemseting => 'save_ss',
   );
 =cut  
   my %ACCESS = map { $_ => 1 } qw(
 sub open {      firmware_version
     my $self = shift;      host_type
       is_connected
     unless ( $self->SUPER::open(@_) ) {      logged_in
         $self->last_error( "Couldn't connect to " . $self->host . ":  $!" );      login_banner
         return;      Timeout
     }      last_lines
       last_vals
     ## Get to login prompt      last_error
     unless (      Decode
         $self->waitfor(  );
             -match   => '/password: ?$/i',  
             -errmode => "return",  sub AUTOLOAD {
         )      my $self = shift;
       )  
     {      my ($method) = ( our $AUTOLOAD ) =~ /^.*::(\w+)$/
         $self->last_error( "problem connecting to host ("          or die "Weird: $AUTOLOAD";
               . $self->host . "): "  
               . $self->lastline );      if ( exists $ALIASES{$method} ) {
         return;          $method = $ALIASES{$method};
     }          return $self->$method(@_);
       }
     $self->parse_login_banner( $self->lastline );  
       if ( exists $COMMANDS{$method} ) {
     $self->is_connected(1);          my %cmd;
           foreach my $k ( keys %{ $COMMANDS{$method} } ) {
     return $self->is_connected;              $cmd{$k} = $COMMANDS{$method}{$k};
 }          }
           $cmd{'String'} ||= $method;
 =pod          $cmd{'args'} .= $SPACE . shift if ( @_ == 1 );
           return $self->cmd( %cmd, @_ );
 =head2 B<login> - Login to the AP.      }
   
 Calls open() if not already connected, then sends the password and sets      if ( exists $ACCESS{$method} ) {
 logged_in() if successful          my $s    = *$self->{net_telnet_trango};
           my $prev = $s->{$method};
 =cut          ( $s->{$method} ) = @_ if @_;
           return $prev;
 sub login {      }
     my $self = shift;  
       $method = "SUPER::$method";
     unless ( $self->is_connected ) {      return $self->$method(@_);
         $self->open or return;  }
     }  
   =pod
     my $password = shift;  
   =head2 B<open> - Open a connection to a Trango AP.
     $self->print($password);  
     unless (  Calls Net::Telnet::open() then makes sure you get a password prompt so
         $self->waitfor(  you are ready to login() and parses the login banner so you can get
             -match   => $self->prompt,  host_type() and firmware_version()
             -errmode => "return",  
         )  =cut
       )  
     {  sub open {
         $self->last_error( "login ($self->host) failed: " . $self->lastline );      my $self = shift;
         return;  
     }      unless ( $self->SUPER::open(@_) ) {
           $self->last_error( "Couldn't connect to " . $self->host . ":  $!" );
     $self->logged_in(1);          return;
       }
     return $self->logged_in;  
 }      ## Get to login prompt
       unless (
 =pod          $self->waitfor(
               -match   => '/password: ?$/i',
 =head2 B<parse_login_banner> - Converts the login_banner to something useful.              -errmode => "return",
           )
 Takes a login banner (what you get when you first connect to the Trango)          )
 or reads what is already in login_banner() then parses it and sets      {
 host_type() and firmware_version() as well as login_banner()          $self->last_error( "problem connecting to host ("
                   . $self->host . "): "
 =cut                  . $self->lastline );
           return;
 sub parse_login_banner {      }
     my $self = shift;  
       $self->parse_login_banner( $self->lastline );
     if (@_) {  
         $self->login_banner(@_);      $self->is_connected(1);
     }  
       return $self->is_connected;
     my $banner = $self->login_banner;  }
   
     my ( $type, $sep1, $subtype, $sep2, $ver ) =  =pod
       $banner =~  
       /Welcome to Trango Broadband Wireless (\S+)([\s-]+)(\S+)([\s-]+)(.+)$/i;  =head2 B<login> - Login to the AP.
   
     $type .= $sep1 . $subtype;  Calls open() if not already connected, then sends the password and sets
     $ver = $subtype . $sep2 . $ver;  logged_in() if successful
   
     $self->login_banner($banner);  =cut
     $self->host_type($type);  
     $self->firmware_version($ver);  sub login {
       my $self = shift;
     return 1;  
 }      unless ( $self->is_connected ) {
           $self->open or return;
 =pod      }
   
 =head2 B<su_password> - Set the password on SUs connected to the AP.      my $password = shift;
   
 su_password('new_password'[, 'suid']) If no suid is specified,      $self->print($password);
 the default is "all".      unless (
           $self->waitfor(
   $t->su_password('good_pass', 5);              -match   => $self->prompt,
               -errmode => "return",
 =cut          )
           )
 sub su_password {      {
     my $self     = shift;          $self->last_error( "login ($self->host) failed: " . $self->lastline );
     my $new_pass = shift || $EMPTY;          return;
     my $su       = shift || 'all';      }
   
     unless ( defined $new_pass ) {      $self->logged_in(1);
         $self->last_error("No new password");  
       return $self->logged_in;
         #return;  }
     }  
   =pod
     return $self->cmd(  
         String => 'su password ' . $su . $SPACE . $new_pass . $SPACE . $new_pass,  =head2 B<parse_login_banner> - Converts the login_banner to something useful.
         expect => $success,  
     );  Takes a login banner (what you get when you first connect to the Trango)
 }  or reads what is already in login_banner() then parses it and sets
   host_type() and firmware_version() as well as login_banner()
 =pod  
   =cut
 =head2 B<su_ipconfig> - Change IP configuration on SUs connected to the AP.  
   sub parse_login_banner {
 su_ipconfig( 'suid', 'new_ip', 'new_subnet', 'new_gateway' )      my $self = shift;
   
   $t->su_ipconfig( 5, '10.0.1.5', '255.255.255.0', '10.0.1.1' );      if (@_) {
           $self->login_banner(@_);
 =cut      }
   
 sub su_ipconfig {      my $banner = $self->login_banner;
     my $self = shift;  
       my ( $type, $sep1, $subtype, $sep2, $ver )
     my $suid        = shift;          = $banner
     my $new_ip      = shift;          =~ /Welcome to Trango Broadband Wireless,? (\S+)([\s-]+)(\S+)([\s-]+)(.+)$/i;
     my $new_subnet  = shift;  
     my $new_gateway = shift;      $type .= $sep1 . $subtype;
       $ver = $subtype . $sep2 . $ver;
     if ( $suid =~ /\D/ ) {  
         $self->last_error("Invalid suid '$suid'");      $self->login_banner($banner);
         return;      $self->host_type($type);
     }      $self->firmware_version($ver);
     unless ($new_ip) {  
         $self->last_error("no new_ip passed");      return 1;
         return;  }
     }  
     unless ($new_subnet) {  =pod
         $self->last_error("no new_subnet passed");  
         return;  =head2 B<linktest> - Link test to SU
     }  
     unless ($new_gateway) {  linktest('suid'[, 'pkt len, bytes'[, '# of pkts'[, '# of cycles']]]);
         $self->last_error("no new_gateway passed");  
         return;  Returns a hash reference to the results of the test
     }  
   =cut
     # su ipconfig <suid> <new ip> <new subnet> <new gateway>  
     return $self->cmd(  sub linktest {
         String => 'su ipconfig ' . $suid . $SPACE . $new_ip . $SPACE      my $self = shift;
           . $new_subnet . $SPACE      my $suid = shift;
           . $new_gateway,  
         expect => $success,      # 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;
 =pod  
       my %config = @_;
 =head2 B<sudb_view> - Returns the output from the sudb view command  
       # * 2, one for the FromAP, one FromSU.  Then / 1000 to get to ms.
 returns a reference to an array of hashes each containing these keys      # XXX This might need to be changed, this makes the default timeout the
 'suid', 'type', 'cir', 'mir' and 'mac'      # same as $pkt_len, and that might not be enough at slower speeds.
       $config{Timeout} ||= int( ( $pkt_len * $pkt_cnt * $cycles * 2 ) / 1000 );
 =cut  
       my $string = join $SPACE, 'linktest', $suid, $pkt_len, $pkt_cnt, $cycles;
 sub sudb_view {      return $self->cmd(
     my $self = shift;          %config,
           String => $string,
     my $lines = $self->cmd( String => 'sudb view', expect => $success ) || [];          decode => 'linktest',
       );
     return unless @{$lines};  
   }
     unless ( $PRIVATE{'Decode'} ) {  
         return $lines;  =pod
     }  
   =head2 B<su_password> - Set the password on SUs connected to the AP.
     my @sus;  
     foreach ( @{$lines} ) {  su_password('new_password'[, 'suid']) If no suid is specified,
         next unless $_;  the default is "all".
         if (/^\[(\d+)\]\s+(\d+)\s+(\d+)\s+(\d+)\s+([0-9A-Fa-f\s]+)$/) {  
             my %s = (    $t->su_password('good_pass', 5);
                 suid => $1,  
                 type => $2,  =cut
                 cir  => $3,  
                 mir  => $4,  sub su_password {
                 mac  => $5,      my $self     = shift;
             );      my $new_pass = shift || $EMPTY;
       my $su       = shift || 'all';
             $s{'mac'} =~ s/\s//g;  
             $s{'mac'} = uc( $s{'mac'} );      unless ( defined $new_pass ) {
           $self->last_error("No new password");
             push @sus, \%s;  
         }          #return;
     }      }
   
     return \@sus;      return $self->cmd(
 }          String => 'su password '
               . $su
 =pod              . $SPACE
               . $new_pass
 =head2 B<sudb_add> - Adds an su to the sudb              . $SPACE
               . $new_pass,
 Takes the following paramaters          expect => $success,
       );
     suid : numeric,  }
     type : (reg|pr)  
     cir  : numeric,  =pod
     mir  : numeric,  
     mac  : Almost any format, it will be reformatted,  =head2 B<ipconfig> - Change IP configuration
   
 and returns true on success or undef otherwise.  ipconfig( 'new_ip', 'new_subnet', 'new_gateway' )
   
   $t->sudb_add($suid, 'reg', $cir, $mir, $mac);    $t->ipconfig( '10.0.1.5', '255.255.255.0', '10.0.1.1' );
   
 You should save_sudb() after calling this, or your changes  will be lost  =cut
 when the AP is rebooted.  
   sub ipconfig {
 =cut      my $self = shift;
   
 sub sudb_add {      my $string = join $SPACE, 'ipconfig', @_;
     my $self = shift;  
     my $suid = shift;      if ( @_ == 3 ) {
     my $type = shift;          $self->print($string);
     my $cir  = shift;          my @lines = $self->waitfor( Match => '/save\s+and\s+activate/', );
     my $mir  = shift;          $self->print('y');
     my $mac  = shift;  
           $self->logged_in(0);
     if ( $suid =~ /\D/ ) {          $self->is_connected(0);
         $self->last_error("Invalid suid '$suid'");  
         return;          foreach my $line (@lines) {
     }              if ( $line =~ s/New \s configuration:\s+//xms ) {
                   return _decode_lines($line);
     unless ( lc($type) eq 'reg' || lc($type) eq 'pr' ) {              }
         $self->last_error("Invalid type '$type'");          }
         return;  
     }          return {};
       }
     if ( $cir =~ /\D/ ) {  
         $self->last_error("Invalid CIR '$cir'");      # ipconfig [ <new ip> <new subnet> <new gateway> ]
         return;      return $self->cmd( String => $string, expect => $success );
     }  }
   
     if ( $mir =~ /\D/ ) {  =pod
         $self->last_error("Invalid MIR '$mir'");  
         return;  =head2 B<su_ipconfig> - Change IP configuration on SUs connected to the AP.
     }  
   su_ipconfig( 'suid', 'new_ip', 'new_subnet', 'new_gateway' )
     my $new_mac = $mac;  
     $new_mac =~ s/[^0-9A-Fa-f]//;    $t->su_ipconfig( 5, '10.0.1.5', '255.255.255.0', '10.0.1.1' );
     unless ( length $new_mac == 12 ) {  
         $self->last_error("Invalid MAC '$mac'");  =cut
         return;  
     }  sub su_ipconfig {
     $new_mac = join $SPACE, $new_mac =~ /../g;      my $self = shift;
   
     my $string =      my $suid        = shift;
       'sudb add ' . $suid . $SPACE . $type . $SPACE . $cir . $SPACE . $mir . $SPACE      my $new_ip      = shift;
       . $new_mac;      my $new_subnet  = shift;
       my $new_gateway = shift;
     return $self->cmd( String => $string, expect => $success );  
 }      if ( $suid =~ /\D/ ) {
           $self->last_error("Invalid suid '$suid'");
 =pod          return;
       }
 =head2 B<sudb_delete> - removes an su from the sudb      unless ($new_ip) {
           $self->last_error("no new_ip passed");
 Takes either 'all' or the  suid of the su to delete          return;
 and returns true on success or undef otherwise.      }
       unless ($new_subnet) {
   $t->sudb_delete($suid);          $self->last_error("no new_subnet passed");
           return;
 You should save_sudb() after calling this, or your changes  will be lost      }
 when the AP is rebooted.      unless ($new_gateway) {
           $self->last_error("no new_gateway passed");
 =cut          return;
       }
 sub sudb_delete {  
     my $self = shift;      # su ipconfig <suid> <new ip> <new subnet> <new gateway>
     my $suid = shift;      return $self->cmd(
           String => 'su ipconfig '
     #if (lc($suid) ne 'all' || $suid =~ /\D/) {              . $suid
     if ( $suid =~ /\D/ ) {              . $SPACE
         $self->last_error("Invalid suid '$suid'");              . $new_ip
         return;              . $SPACE
     }              . $new_subnet
               . $SPACE
     return $self->cmd( String => 'sudb delete ' . $suid, expect => $success );              . $new_gateway,
 }          expect => $success,
       );
 =pod  }
   
 =head2 B<sudb_modify> - changes the su information in the sudb  =pod
   
 Takes either the  suid of the su to change  =head2 B<sudb_view> - Returns the output from the sudb view command
 as well as what you are changing, either "cir, mir or su2su"  
 and returns true on success or undef otherwise.  returns a reference to an array of hashes each containing these keys
   'suid', 'su2su', 'type', 'cir', 'mir' and 'mac'
 cir and mir also take a value to set the cir/mir to.  
   =cut
 su2su takes a group id parameter that is in hex.  
   sub sudb_view {
   $t->sudb_modify($suid, 'cir', 512);      my $self = shift;
   
 You should save_sudb() after calling this, or your changes  will be lost      my $lines = $self->cmd( String => 'sudb view', expect => $success ) || [];
 when the AP is rebooted.  
       return unless @{$lines};
 =cut  
       my $s = *$self->{net_telnet_trango};
 sub sudb_modify {      return $lines if !$s->{'Decode'};
     my $self  = shift;  
     my $suid  = shift;      my @sus;
     my $opt   = shift;      foreach ( @{$lines} ) {
     my $value = shift;          next unless $_;
           if (/^
     if ( $suid =~ /\D/ ) {              \[(\d+)\]
         $self->last_error("Invalid suid '$suid'");              \s+
         return;              [[:xdigit:]]{2}
     }              ([[:xdigit:]])
               ([[:xdigit:]])
     if ( lc($opt) eq 'cir' or lc($opt) eq 'mir' ) {              \s+
         if ( $value =~ /\D/ ) {              (\d+)
             $self->last_error("Invalid $opt '$value'");              \s+
             return;              (\d+)
         }              \s+
     }              ([[:xdigit:]\s]+)
     elsif ( lc($opt) eq 'su2su' ) {          $/ixms
         if ( $value =~ /[^0-9A-Za-f]/ ) {              )
             $self->last_error("Invalid MAC '$value'");          {
             return;              my %s = (
         }                  suid  => $1,
     }                  su2su => $2 ? $2 : undef,
     else {                  type  => $3 == 1 ? 'reg' : $3 == 5 ? 'pri' : $3,
         $self->last_error("Invalid option '$opt'");                  cir   => $4,
         return;                  mir   => $5,
     }                  mac   => $6,
               );
     my $string = 'sudb modify ' . $suid . $SPACE . $opt . $SPACE . $value;  
               $s{'mac'} =~ s/\s//gxms;
     return $self->cmd( String => $string, expect => $success );              $s{'mac'} = uc( $s{'mac'} );
 }  
               push @sus, \%s;
 =pod          }
       }
 =head2 B<enable_tftpd> - enable the TFTP server  
       return \@sus;
 runs C<tftpd(args =E<gt> 'on')> and makes sure that Tftpd is now 'listen'ing  }
   
 =cut  =pod
   
 sub enable_tftpd {  =head2 B<sudb_add> - Adds an su to the sudb
     my $self = shift;  
   Takes the following paramaters
     my $vals = $self->tftpd( args => 'on' );  
       suid : numeric,
     if ( ref $vals eq 'HASH' && $vals->{'Tftpd'} eq 'listen' ) {      type : (reg|pr)
         return $vals;      cir  : numeric,
     }      mir  : numeric,
     else {      mac  : Almost any format, it will be reformatted,
         return;  
     }  and returns true on success or undef otherwise.
 }  
     $t->sudb_add($suid, 'reg', $cir, $mir, $mac);
 =pod  
   You should save_sudb() after calling this, or your changes  will be lost
 =head2 B<disable_tftpd> - disable the TFTP server  when the AP is rebooted.
   
 runs C<tftpd(args =E<gt> 'off')> and makes sure that Tftpd is now 'disabled'  =cut
   
 =cut  sub sudb_add {
       my $self = shift;
 sub disable_tftpd {      my $suid = shift;
     my $self = shift;      my $type = shift;
       my $cir  = shift;
     my $vals = $self->tftpd( args => 'off' );      my $mir  = shift;
       my $mac  = shift;
     if ( ref $vals eq 'HASH' && $vals->{'Tftpd'} eq 'disabled' ) {  
         return $vals;      if ( $suid =~ /\D/ ) {
     }          $self->last_error("Invalid suid '$suid'");
     else {          return;
         return;      }
     }  
 }      unless ( lc($type) eq 'reg' || lc($type) eq 'pr' ) {
           $self->last_error("Invalid type '$type'");
 =pod          return;
       }
 =head2 B<cmd> - runs a command on the AP.  
       if ( $cir =~ /\D/ ) {
 This does most of the work.  At the heart, it calls Net::Telnet::cmd()          $self->last_error("Invalid CIR '$cir'");
 but it also does some special stuff for Trango.          return;
       }
 Normally returns the last lines from from the command  
       if ( $mir =~ /\D/ ) {
 If you are using this, rather than one of the "easy" methods above,          $self->last_error("Invalid MIR '$mir'");
 you probably want to read through the source of this module to see how          return;
 some of the other commands are called.      }
   
 In addition to the Net::Telnet::cmd() options, it also accepts these:      my $new_mac = $mac;
       $new_mac =~ s/[^0-9A-Fa-f]//g;
 I<decode>      unless ( length $new_mac == 12 ) {
 - if this is true, then it will send the output lines to _decode_lines()          $self->last_error("Invalid MAC '$mac'");
 and then returns the decoded output          return;
       }
 I<no_prompt>      $new_mac = join $SPACE, $new_mac =~ /../g;
 - if this is true, it does not wait for a prompt, so you are not stuck  
 waiting for something that will never happen.      my $string
           = 'sudb add '
 I<cmd_disconnects>          . $suid
 - if this is true, it then sets logged_in() to false, then it will          . $SPACE
 close() the connection and set is_connected() to false          . $type
           . $SPACE
 I<expect>          . $cir
 - if this is set (usually to 'Success.') it will check for that in the          . $SPACE
 last line of output and if it does not, will return undef because the          . $mir
 command probably failed          . $SPACE
           . $new_mac;
 I<args>  
 - a string containing the command line options that are passed to the      return $self->cmd( String => $string, expect => $success );
 command  }
   
     $t->cmd( String => 'exit', no_prompt => 1, cmd_disconnects => 1 );  =pod
   
 =cut  =head2 B<sudb_delete> - removes an su from the sudb
   
 sub cmd {  Takes either 'all' or the  suid of the su to delete
     my $self = shift;  and returns true on success or undef otherwise.
   
     my @valid_net_telnet_opts = qw(    $t->sudb_delete($suid);
       String  
       Output  You should save_sudb() after calling this, or your changes  will be lost
       Cmd_remove_mode  when the AP is rebooted.
       Errmode  
       Input_record_separator  =cut
       Ors  
       Output_record_separator  sub sudb_delete {
       Prompt      my $self = shift;
       Rs      my $suid = shift;
       Timeout  
     );      #if (lc($suid) ne 'all' || $suid =~ /\D/) {
       if ( $suid =~ /\D/ ) {
     my %cfg;          $self->last_error("Invalid suid '$suid'");
     if ( @_ == 1 ) {          return;
         $cfg{'String'} = shift;      }
     }  
     elsif ( @_ > 1 ) {      return $self->cmd( String => 'sudb delete ' . $suid, expect => $success );
         %cfg = @_;  }
     }  
   =pod
     $cfg{'Timeout'} ||= $self->Timeout;  
   =head2 B<sudb_modify> - changes the su information in the sudb
     unless ( $cfg{'String'} ) {  
         $self->last_error("No command passed");  Takes either the  suid of the su to change
         return;  as well as what you are changing, either "cir, mir or su2su"
     }  and returns true on success or undef otherwise.
   
     unless ( $self->is_connected ) {  cir and mir also take a value to set the cir/mir to.
         $self->last_error("Not connected");  
         return;  su2su takes a group id parameter that is in hex.
     }  
     $t->sudb_modify($suid, 'cir', 512);
     unless ( $self->logged_in ) {  
         $self->last_error("Not logged in");  You should save_sudb() after calling this, or your changes  will be lost
         return;  when the AP is rebooted.
     }  
   =cut
     my %cmd;  
     foreach (@valid_net_telnet_opts) {  sub sudb_modify {
         if ( exists $cfg{$_} ) {      my $self  = shift;
             $cmd{$_} = $cfg{$_};      my $suid  = shift;
         }      my $opt   = shift;
     }      my $value = shift;
     if ( $cfg{'args'} ) {  
         $cmd{'String'} .= $SPACE . $cfg{'args'};      if ( $suid =~ /\D/ ) {
     }          $self->last_error("Invalid suid '$suid'");
           return;
     my @lines;      }
     if ( $cfg{'no_prompt'} ) {  
         $self->print( $cmd{'String'} );      if ( lc($opt) eq 'cir' or lc($opt) eq 'mir' ) {
         @lines = $self->lastline;          if ( $value =~ /\D/ ) {
     }              $self->last_error("Invalid $opt '$value'");
     else {              return;
         @lines = $self->SUPER::cmd(%cmd);          }
     }      }
       elsif ( lc($opt) eq 'su2su' ) {
     $self->last_lines( \@lines );          if ( $value =~ /[^0-9A-Za-f]/ ) {
               $self->last_error("Invalid MAC '$value'");
     my $vals = 1;              return;
     if ( $PRIVATE{'Decode'} && $cfg{'decode'} ) {          }
         if ( $cfg{'decode'} eq 'each' ) {      }
             $vals = _decode_each_line(@lines);      else {
         }          $self->last_error("Invalid option '$opt'");
         elsif ( $cfg{'decode'} eq 'sulog' ) {          return;
             $vals = _decode_sulog(@lines);      }
         }  
         elsif ( $cfg{'decode'} eq 'maclist' ) {      my $string = 'sudb modify ' . $suid . $SPACE . $opt . $SPACE . $value;
             $vals = _decode_maclist(@lines);  
         }      return $self->cmd( String => $string, expect => $success );
         else {  }
             $vals = _decode_lines(@lines);  
         }  =pod
     }  
   =head2 B<enable_tftpd> - enable the TFTP server
     $self->last_vals($vals);  
   runs C<tftpd(args =E<gt> 'on')> and makes sure that Tftpd is now 'listen'ing
     my $last = $self->lastline;  
   =cut
     if ( ( not $cfg{'expect'} ) || $last =~ /$cfg{'expect'}$/ ) {  
         if ( $cfg{'cmd_disconnects'} ) {  sub enable_tftpd {
             $self->logged_in(0);      my $self = shift;
             $self->close;  
             $self->is_connected(0);      my $vals = $self->tftpd( args => 'on' );
         }  
       if ( ref $vals eq 'HASH' && $vals->{'Tftpd'} eq 'listen' ) {
         if ( $PRIVATE{'Decode'} && $cfg{'decode'} ) {          return $vals;
             return $vals;      }
         }      else {
         else {          return;
             return \@lines;      }
         }  }
     }  
     else {  =pod
         my $err;  
         if (grep { /\[ERR\]/ } @lines) {  =head2 B<disable_tftpd> - disable the TFTP server
             $err = _decode_lines(@lines);  
         }  runs C<tftpd(args =E<gt> 'off')> and makes sure that Tftpd is now 'disabled'
   
         if (ref $err eq 'HASH' && $err ->{ERR}) {  =cut
             $self->last_error($err->{ERR} );  
         } else {  sub disable_tftpd {
             $self->last_error("Error with command ($cfg{'String'}): $last");      my $self = shift;
         }  
         return;      my $vals = $self->tftpd( args => 'off' );
     }  
 }      if ( ref $vals eq 'HASH' && $vals->{'Tftpd'} eq 'disabled' ) {
           return $vals;
 #=item _decode_lines      }
       else {
 sub _decode_lines {          return;
     my @lines = @_;      }
   }
     my %conf;  
   =pod
     my $key = $EMPTY;  
     my $val = undef;  =head2 B<cmd> - runs a command on the AP.
     my @vals;  
     my $in_key = 0;  This does most of the work.  At the heart, it calls Net::Telnet::cmd()
     my $in_val = 1;  but it also does some special stuff for Trango.
   
     foreach my $line (@lines) {  Normally returns the last lines from from the command
         next if $line =~ /$success$/;  
   If you are using this, rather than one of the "easy" methods above,
         my @chars = split //, $line;  you probably want to read through the source of this module to see how
   some of the other commands are called.
         my $last_key = $EMPTY;  
         foreach my $c (@chars) {  In addition to the Net::Telnet::cmd() options, it also accepts these:
   
             if ( $c eq '[' || $c eq "\r" || $c eq "\n" ) {  I<decode>
                 if ( $c eq '[' ) {  - if this is true, then it will send the output lines to _decode_lines()
                     $in_key = 1;  and then returns the decoded output
                     $in_val = 0;  
                 }  I<no_prompt>
                 else {  - if this is true, it does not wait for a prompt, so you are not stuck
                     $in_key = 0;  waiting for something that will never happen.
                     $in_val = 1;  
                 }  I<cmd_disconnects>
   - if this is true, it then sets logged_in() to false, then it will
                 if ($key) {  close() the connection and set is_connected() to false
                     $key =~ s/^\s+//;  
                     $key =~ s/\s+$//;  I<expect>
   - if this is set (usually to 'Success.') it will check for that in the
                     if ($val) {  last line of output and if it does not, will return undef because the
                         $val =~ s/^\s+//;  command probably failed
                         $val =~ s/\s+$//;  
                     }  I<args>
   - a string containing the command line options that are passed to the
                     if ( $key eq 'Checksum' && $last_key ) {  command
   
                         # Special case for these bastids.      $t->cmd( String => 'exit', no_prompt => 1, cmd_disconnects => 1 );
                         my $new = $last_key;  
                         $new =~ s/\s+\S+$//;  =cut
                         $key = $new . $SPACE . $key;  
                     }  sub cmd {
       my $self = shift;
                     $conf{$key} = $val;      my $s    = *$self->{net_telnet_trango};
                     $last_key   = $key;  
                     $key        = $EMPTY;      my @valid_net_telnet_opts = qw(
                 }          String
                 elsif ($val) {          Output
                     push @vals, $val;          Cmd_remove_mode
                 }          Errmode
                 $val = $EMPTY;          Input_record_separator
           Ors
             }          Output_record_separator
             elsif ( $c eq ']' ) {          Prompt
                 $in_val = 1;          Rs
                 $in_key = 0;          Timeout
                 $c      = shift @chars;      );
   
             }      my %cfg;
             elsif ($in_key) {      if ( @_ == 1 ) {
                 $key .= $c;          $cfg{'String'} = shift;
       }
             }      elsif ( @_ > 1 ) {
             elsif ($in_val) {          %cfg = @_;
                 $val .= $c;      }
             }  
         }      $cfg{'Timeout'} ||= $self->Timeout;
     }  
       unless ( $cfg{'String'} ) {
     unless ($key) {          $self->last_error("No command passed");
         push @vals, $val;          return;
     }      }
   
     if ( @vals == 1 ) {      unless ( $self->is_connected ) {
         $val = $vals[0];          $self->last_error("Not connected");
     }          return;
     elsif (@vals) {      }
         $val = \@vals;  
     }      unless ( $self->logged_in ) {
     else {          $self->last_error("Not logged in");
         $val = undef;          return;
     }      }
   
     if (%conf) {      my %cmd;
         $conf{_pre} = $val if $val;      foreach (@valid_net_telnet_opts) {
         return \%conf;          if ( exists $cfg{$_} ) {
     }              $cmd{$_} = $cfg{$_};
     else {          }
         return $val;      }
     }      if ( $cfg{'args'} ) {
 }          $cmd{'String'} .= $SPACE . $cfg{'args'};
       }
 #=item _decode_each_line  
       #print "Running cmd $cmd{String}\n";
 sub _decode_each_line {      my @lines;
     my @lines = @_;      if ( $cfg{'no_prompt'} ) {
     my @decoded;          $self->print( $cmd{'String'} );
     foreach my $line (@lines) {          @lines = $self->lastline;
         my $decoded = _decode_lines($line);      }
         push @decoded, $decoded if defined $decoded;      else {
     }          @lines = $self->SUPER::cmd(%cmd);
     return \@decoded;      }
 }  
       $self->last_lines( \@lines );
 #=item _decode_sulog  
       my $last   = $self->lastline;
 sub _decode_sulog {      my $prompt = $self->prompt;
     my @lines = @_;      $prompt =~ s{^/}{}xms;
     my @decoded;      $prompt =~ s{/[gixms]*$}{}xms;
     my $last_tm;      while ( @lines && $last =~ qr($prompt) ) {
     foreach my $line (@lines) {          pop @lines;
         my $decoded = _decode_lines($line);          $last = $lines[-1];
       }
         if ( defined $decoded ) {      $self->last_error($EMPTY);
             if ( $decoded->{'tm'} ) {  
                 $last_tm = $decoded->{'tm'};      my $vals = 1;
                 next;      if ( $s->{'Decode'} && $cfg{'decode'} ) {
             }          if ( $cfg{'decode'} eq 'each' ) {
             else {              $vals = _decode_each_line(@lines);
                 $decoded->{'tm'} = $last_tm;          }
             }          elsif ( $cfg{'decode'} eq 'sulog' ) {
             next unless $last_tm;              $vals = _decode_sulog(@lines);
           }
             push @decoded, $decoded if defined $decoded;          elsif ( $cfg{'decode'} eq 'maclist' ) {
         }              $vals = _decode_maclist(@lines);
     }              if ( !$vals ) {
     return \@decoded;                  $self->last_error("Error decoding maclist");
 }              }
           }
 #=item _decode_maclist          elsif ( $cfg{'decode'} eq 'linktest' ) {
               $vals = _decode_linktest(@lines);
 sub _decode_maclist {              if ( !$vals ) {
     my @lines = @_;                  $self->last_error("Error decoding linktest");
     my @decoded;              }
     my $total_entries = 0;          }
     my $current_tm    = 0;          elsif ( $cfg{'decode'} eq 'freq' ) {
     foreach my $line (@lines) {              $vals = _decode_freq(@lines);
         $line =~ s/\r?\n$//;          }
         my ( $mac, $loc, $tm ) = $line =~ /          else {
             ([0-9a-fA-F ]{17})\s+              $vals = _decode_lines(@lines);
             (.*)\s+          }
             tm\s+      }
             (\d+)      if ( ref $vals eq 'HASH' ) {
         /x;          $vals->{_raw} = join q{}, @lines;
       }
         if ($mac) {      $self->last_vals($vals);
             $mac =~ s/\s+//g;  
             $loc =~ s/^\s+//;      if ( ( not $cfg{'expect'} ) || $last =~ /$cfg{'expect'}$/ ) {
             $loc =~ s/\s+$//;          if ( $cfg{'cmd_disconnects'} ) {
               $self->logged_in(0);
             my $suid = undef;              $self->close;
             if ( $loc =~ /suid\s+=\s+(\d+)/ ) {              $self->is_connected(0);
                 $suid = $1;          }
                 $loc  = undef;  
             }          if ( $s->{'Decode'} && $cfg{'decode'} ) {
               return $vals;
             push @decoded,          }
               {          else {
                 mac  => $mac,              return \@lines;
                 loc  => $loc,          }
                 tm   => $tm,      }
                 suid => $suid,      else {
               };          my $err;
         }          if ( grep {/\[ERR\]/} @lines ) {
         elsif ( $line =~ /(\d+)\s+entries/ ) {              $err = _decode_lines(@lines);
             $total_entries = $1;          }
         }  
         elsif ( $line =~ /current tm = (\d+)\s+sec/ ) {          if ( ref $err eq 'HASH' && $err->{ERR} ) {
             $current_tm = $1;              $self->last_error( $err->{ERR} );
         }          }
     }          else {
               $self->last_error("Error with command ($cmd{'String'}): $last");
     map { $_->{'cur_tm'} = $current_tm } @decoded;          }
           return;
     if ( scalar @decoded == $total_entries ) {      }
         return \@decoded;  }
     }  
     else {  #=item _decode_lines
   
         # XXX we should have a way to set last error, not sure why we don't  sub _decode_lines {
         return;      my @lines = @_;
     }  
 }      my %conf;
   
 1;    # End of Net::Telnet::Trango      my $key = $EMPTY;
 __END__      my $val = undef;
       my @vals;
 =head1 SEE ALSO      my $in_key = 0;
       my $in_val = 1;
 Trango Documentation -  
 L<http://www.trangobroadband.com/support/product_docs.htm>  LINE: while ( my $line = shift @lines ) {
           next LINE if $line =~ /$success\Z/;
 L<Net::Telnet>          next LINE if $line =~ /^ \*+ \s+ \d+ \s+ \*+ \Z/xms;
   
 =head1 TODO          # Special decode for sysinfo on a TrangoLink 45
           if ( $line =~ /^(.* Channel \s+ Table):\s*(.*)\Z/xms ) {
 There are still a lot of commands that are not accessed directly.  If              my $key  = $1;
 you call them (as cmd("command + args") or whatever) and it works,              my $note = $2;
 please send me examples that work and I will try to get it incorporated  
 into the next version of the script.              my %vals;
               while ( $line = shift @lines ) {
 I also want to be able to parse the different types of output from                  if ( $line =~ /^\Z/ ) {
 commands like su, sudb all and anything else that would be better                      $conf{$key} = \%vals;
 available as a perl datastructure.                      $conf{$key}{note} = $note;
                       next LINE;
 =head1 AUTHOR                  }
   
 Andrew Fresh E<lt>andrew@rraz.netE<gt>                  my $decoded = _decode_lines($line);
                   if ($decoded) {
 =head1 SUPPORT                      %vals = ( %vals, %{$decoded} );
                   }
 You can find documentation for this module with the perldoc command.              }
           }
     perldoc Net::Telnet::Trango  
           # Another special decode for the TrangoLink
 You can also look for information at:          elsif (
               $line =~ /^
 =over 4              RF \s Band \s \#
               (\d+) \s+
 =item * AnnoCPAN: Annotated CPAN documentation              \( ([^\)]+) \) \s*
               (.*)$
 L<http://annocpan.org/dist/Net-Telnet-Trango>          /xms
               )
 =item * CPAN Ratings          {
               my $num   = $1;
 L<http://cpanratings.perl.org/d/Net-Telnet-Trango>              my $band  = $2;
               my $extra = $3;
 =item * RT: CPAN's request tracker  
               if ( $extra =~ /\[/ ) {
 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-Telnet-Trango>                  my $decoded = _decode_lines($extra);
                   $conf{'RF Band'}{$num} = $decoded;
 =item * Search CPAN              }
               else {
 L<http://search.cpan.org/dist/Net-Telnet-Trango>                  $conf{'RF Band'}{$num}{$extra} = 1;
               }
 =back              next LINE;
           }
 =head1 COPYRIGHT AND LICENSE  
           my @chars = split //, $line;
 Copyright (C) 2005,2006,2007 by Andrew Fresh  
           my $last_key = $EMPTY;
 This program is free software; you can redistribute it and/or modify it          foreach my $c (@chars) {
 under the same terms as Perl itself.  
               if ( $c eq '[' || $c eq "\r" || $c eq "\n" ) {
 =cut                  if ( $c eq '[' ) {
                       $in_key = 1;
                       $in_val = 0;
                   }
                   else {
                       $in_key = 0;
                       $in_val = 1;
                   }
   
                   if ($key) {
                       $key =~ s/^\s+//;
                       $key =~ s/\s+$//;
   
                       if ($val) {
                           $val =~ s/^\s+//;
                           $val =~ s/\s+\.*$//;
                       }
   
                       if ( $key eq 'Checksum' && $last_key ) {
   
                           # Special case for these bastids.
                           my $new = $last_key;
                           $new =~ s/\s+\S+$//;
                           $key = $new . $SPACE . $key;
                       }
   
                       $conf{$key} = $val;
                       $last_key   = $key;
                       $key        = $EMPTY;
                   }
                   elsif ($val) {
                       push @vals, $val;
                   }
                   $val = $EMPTY;
   
               }
               elsif ( $c eq ']' ) {
                   $in_val = 1;
                   $in_key = 0;
                   $c      = shift @chars;
   
               }
               elsif ($in_key) {
                   $key .= $c;
   
               }
               elsif ($in_val) {
                   $val .= $c;
               }
           }
       }
   
       unless ($key) {
           push @vals, $val;
       }
   
       foreach my $val (@vals) {
           if ( defined $val && length $val ) {
               $val =~ s/^\s+//;
               $val =~ s/\s+\.*$//;
           }
       }
   
       if ( @vals == 1 ) {
           $val = $vals[0];
       }
       elsif (@vals) {
           $val = \@vals;
       }
       else {
           $val = undef;
       }
   
       if (%conf) {
           $conf{_pre} = $val if $val;
           return \%conf;
       }
       else {
           return $val;
       }
   }
   
   #=item _decode_each_line
   
   sub _decode_each_line {
       my @lines = @_;
       my @decoded;
       foreach my $line (@lines) {
           my $decoded = _decode_lines($line);
           push @decoded, $decoded if defined $decoded && length $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
   
   sub _decode_sulog {
       my @lines = @_;
       my @decoded;
       my $last_tm;
       foreach my $line (@lines) {
           my $decoded = _decode_lines($line);
   
           if ( defined $decoded ) {
               if ( $decoded->{'tm'} ) {
                   $last_tm = $decoded->{'tm'};
                   next;
               }
               else {
                   $decoded->{'tm'} = $last_tm;
               }
               next unless $last_tm;
   
               push @decoded, $decoded if defined $decoded;
           }
       }
       return \@decoded;
   }
   
   #=item _decode_maclist
   
   sub _decode_maclist {
       my @lines = @_;
       my @decoded;
       my $total_entries = 0;
       my $current_tm    = 0;
       foreach my $line (@lines) {
           $line =~ s/\r?\n$//;
           my ( $mac, $loc, $tm ) = $line =~ /
               ([0-9a-fA-F ]{17})\s+
               (.*)\s+
               tm\s+
               (\d+)
           /x;
   
           if ($mac) {
               $mac =~ s/\s+//g;
               $loc =~ s/^\s+//;
               $loc =~ s/\s+$//;
   
               my $suid = undef;
               if ( $loc =~ /suid\s+=\s+(\d+)/ ) {
                   $suid = $1;
                   $loc  = undef;
               }
   
               push @decoded,
                   {
                   mac  => $mac,
                   loc  => $loc,
                   tm   => $tm,
                   suid => $suid,
                   };
           }
           elsif ( $line =~ /(\d+)\s+entries/ ) {
               $total_entries = $1;
           }
           elsif ( $line =~ /current tm = (\d+)\s+sec/ ) {
               $current_tm = $1;
           }
       }
   
       map { $_->{'cur_tm'} = $current_tm } @decoded;
   
       if ( scalar @decoded == $total_entries ) {
           return \@decoded;
       }
       else {
           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
   __END__
   
   =head1 SEE ALSO
   
   Trango Documentation -
   L<http://www.trangobroadband.com/support/product_docs.htm>
   
   L<Net::Telnet>
   
   =head1 TODO
   
   There are still a lot of commands that are not accessed directly.  If
   you call them (as cmd("command + args") or whatever) and it works,
   please send me examples that work and I will try to get it incorporated
   into the next version of the script.
   
   I also want to be able to parse the different types of output from
   commands like su, sudb all and anything else that would be better
   available as a perl datastructure.
   
   =head1 AUTHOR
   
   Andrew Fresh E<lt>andrew@rraz.netE<gt>
   
   =head1 SUPPORT
   
   You can find documentation for this module with the perldoc command.
   
       perldoc Net::Telnet::Trango
   
   You can also look for information at:
   
   =over 4
   
   =item * AnnoCPAN: Annotated CPAN documentation
   
   L<http://annocpan.org/dist/Net-Telnet-Trango>
   
   =item * CPAN Ratings
   
   L<http://cpanratings.perl.org/d/Net-Telnet-Trango>
   
   =item * RT: CPAN's request tracker
   
   L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-Telnet-Trango>
   
   =item * Search CPAN
   
   L<http://search.cpan.org/dist/Net-Telnet-Trango>
   
   =back
   
   =head1 COPYRIGHT AND LICENSE
   
   Copyright (C) 2005,2006,2007 by Andrew Fresh
   
   This program is free software; you can redistribute it and/or modify it
   under the same terms as Perl itself.
   
   =cut
Legend:
Removed from v.1.39  
changed lines
  Added in v.1.60
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>