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

version 1.38, 2007/02/06 16:22:46 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.37 2007/02/05 23:09:59 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_list> - eth list command  
   No useful output.
 Returns the output from the eth list command  
   =head2 B<eth_link> - eth link command
   
 =head2 B<su_info> - gets the su info  Returns the output from the eth link command
   
 Returns information about the SU.  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.
 You need to pass in the $suid and it will return the info for that suid.  
   =head2 B<su_info> - gets the su info
   $t->su_info($suid);  
   Returns information about the SU.
 =head2 B<su_testrflink> - tests the RF Link to an su  
   You need to pass in the $suid and it will return the info for that suid.
   $t->su_testrflink($suid|'all');  
     $t->su_info($suid);
 =head2 B<save_ss> - saves the config.    
   =head2 B<su_testrflink> - tests the RF Link to an su
 Returns 1 on success, undef on failure.  
     $t->su_testrflink($suid|'all');
 =head2 B<opmode> - sets opmode ap y or returns the opmode  
   =head2 B<save_ss> - saves the config.
     $t->opmode([ap y]);  
   Returns 1 on success, undef on failure.
 =cut  
   =head2 B<set_baseid> - sets baseid
 my $success  = 'Success\\.';  
 my %COMMANDS = (      $t->set_baseid($baseid);
     tftpd       => { decode    => 'all',       expect          => $success },  
     ver         => { decode    => 'all' },  =head2 B<set_suid> - sets baseid
     sysinfo     => { decode    => 'all',       expect          => $success },  
     updateflash => { decode    => 'all',       expect          => $success },      $t->set_suid($baseid);
     sulog       => { decode    => 'sulog',     expect          => $success },  
     'exit'      => { no_prompt => 1,           cmd_disconnects => 1 },  =head2 B<set_defaultopmode> - sets default opmode
     reboot      => { no_prompt => 1,           cmd_disconnects => 1 },  
     remarks     => { decode    => 'all',       expect          => $success },      $t->set_defaultopmode(ap|su);
     save_sudb   => { String    => 'save sudb', expect          => $success },  
     syslog      => { expect    => $success },  =head2 B<opmode> - sets or returns the opmode
     'pipe'      => {},                        # XXX needs a special decode  
     maclist     => { decode => 'maclist' },      $t->opmode([ap y|su y]);
     maclist_reset => { String => 'maclist reset', expect       => 'done' },  
     eth_link    => { String => 'eth link',     expect          => $success },  =head2 B<freq> - sets or returns the freq
     su_info     =>  
       { String => 'su info',  decode => 'all', expect          => $success },      $channel = '11 v';
     su_testrflink =>      $t->freq([$channel]);
       { String => 'su testrflink', decode => 'each', expect    => $success },  
     save_ss     => { String => 'save ss',      expect          => $success },  =head2 B<freq_writescan> - sets the freq writescan
     opmode      => { decode => 'all',          expect          => $success },  
 );      $channels = '11 v 11 h 12 v 12 h';
       $t->freq_writescan($channels);
 my %ALIASES = (  
     bye     => 'exit',  =head2 B<freq_scantable> - returns the freq scantable
     restart => 'reboot',  
     Host    => 'host',      $channels = $t->freq_scantable();
     save_systemseting => 'save_ss',      # now $channels eq '11 v 11 h 12 v 12 h';
 );  
   
 my %ACCESS = map { $_ => 1 } qw(  =cut
   firmware_version  
   host_type  my $success  = 'Success\\.';
   is_connected  my %COMMANDS = (
   logged_in      _clear      => { String    => "\n" },
   login_banner      tftpd       => { decode    => 'all', expect => $success },
   Timeout      ver         => { decode    => 'all' },
   last_lines      sysinfo     => { decode    => 'all', expect => $success },
   last_vals      updateflash => { decode    => 'all', expect => $success },
   last_error      sulog       => { decode    => 'sulog', expect => $success },
   Decode      'exit'      => { no_prompt => 1, cmd_disconnects => 1 },
 );      reboot      => { no_prompt => 1, cmd_disconnects => 1 },
       'reset'   => {},
 sub AUTOLOAD {      remarks   => { decode => 'all', expect => $success },
     my $self = shift;      save_sudb => { String => 'save sudb', expect => $success },
       syslog  => { expect => $success },
     my ($method) = ( our $AUTOLOAD ) =~ /^.*::(\w+)$/      'pipe'  => {},      # XXX needs a special decode
       or die "Weird: $AUTOLOAD";      maclist => { decode => 'maclist' },
       maclist_reset => { String => 'maclist reset', expect => 'done' },
     if ( exists $ALIASES{$method} ) {      eth_link      => { String => 'eth link',      expect => $success },
         $method = $ALIASES{$method};      su_info => { String => 'su info', decode => 'all', expect => $success },
         return $self->$method(@_);      su_testrflink =>
     }          { String => 'su testrflink', decode => 'each', expect => $success },
       save_ss    => { String => 'save ss', expect => $success },
     if ( exists $COMMANDS{$method} ) {      set_baseid => {
         my %cmd;          String => 'set baseid',
         foreach my $k ( keys %{ $COMMANDS{$method} } ) {          decode => 'all',
             $cmd{$k} = $COMMANDS{$method}{$k};          expect => $success
         }      },
         $cmd{'String'} ||= $method;      set_suid => {
         $cmd{'args'} .= $SPACE . shift if ( @_ == 1 );          String => 'set suid',
         return $self->cmd( %cmd, @_ );          decode => 'all',
     }          expect => $success
       },
     if ( exists $ACCESS{$method} ) {      set_defaultopmode => {
         my $prev = $PRIVATE{$method};          String => 'set defaultopmode',
         ( $PRIVATE{$method} ) = @_ if @_;          decode => 'all',
         return $prev;          expect => $success
     }      },
       opmode => { decode => 'all',  expect => $success },
     $method = "SUPER::$method";      freq   => { decode => 'freq', expect => $success },
     return $self->$method(@_);      freq_writescan =>
 }          { String => 'freq writescan', decode => 'all', expect => $success },
       freq_scantable =>
 =pod          { String => 'freq scantable', decode => 'all', expect => $success },
       arq => { decode => 'all' },
 =head2 B<open> - Open a connection to a Trango AP.  );
   
 Calls Net::Telnet::open() then makes sure you get a password prompt so  my %ALIASES = (
 you are ready to login() and parses the login banner so you can get      bye               => 'exit',
 host_type() and firmware_version()      restart           => 'reboot',
       Host              => 'host',
 =cut      save_systemseting => 'save_ss',
   );
 sub open {  
     my $self = shift;  my %ACCESS = map { $_ => 1 } qw(
       firmware_version
     unless ( $self->SUPER::open(@_) ) {      host_type
         $self->last_error( "Couldn't connect to " . $self->host . ":  $!" );      is_connected
         return;      logged_in
     }      login_banner
       Timeout
     ## Get to login prompt      last_lines
     unless (      last_vals
         $self->waitfor(      last_error
             -match   => '/password: ?$/i',      Decode
             -errmode => "return",  );
         )  
       )  sub AUTOLOAD {
     {      my $self = shift;
         $self->last_error( "problem connecting to host ("  
               . $self->host . "): "      my ($method) = ( our $AUTOLOAD ) =~ /^.*::(\w+)$/
               . $self->lastline );          or die "Weird: $AUTOLOAD";
         return;  
     }      if ( exists $ALIASES{$method} ) {
           $method = $ALIASES{$method};
     $self->parse_login_banner( $self->lastline );          return $self->$method(@_);
       }
     $self->is_connected(1);  
       if ( exists $COMMANDS{$method} ) {
     return $self->is_connected;          my %cmd;
 }          foreach my $k ( keys %{ $COMMANDS{$method} } ) {
               $cmd{$k} = $COMMANDS{$method}{$k};
 =pod          }
           $cmd{'String'} ||= $method;
 =head2 B<login> - Login to the AP.          $cmd{'args'} .= $SPACE . shift if ( @_ == 1 );
           return $self->cmd( %cmd, @_ );
 Calls open() if not already connected, then sends the password and sets      }
 logged_in() if successful  
       if ( exists $ACCESS{$method} ) {
 =cut          my $s    = *$self->{net_telnet_trango};
           my $prev = $s->{$method};
 sub login {          ( $s->{$method} ) = @_ if @_;
     my $self = shift;          return $prev;
       }
     unless ( $self->is_connected ) {  
         $self->open or return;      $method = "SUPER::$method";
     }      return $self->$method(@_);
   }
     my $password = shift;  
   =pod
     $self->print($password);  
     unless (  =head2 B<open> - Open a connection to a Trango AP.
         $self->waitfor(  
             -match   => $self->prompt,  Calls Net::Telnet::open() then makes sure you get a password prompt so
             -errmode => "return",  you are ready to login() and parses the login banner so you can get
         )  host_type() and firmware_version()
       )  
     {  =cut
         $self->last_error( "login ($self->host) failed: " . $self->lastline );  
         return;  sub open {
     }      my $self = shift;
   
     $self->logged_in(1);      unless ( $self->SUPER::open(@_) ) {
           $self->last_error( "Couldn't connect to " . $self->host . ":  $!" );
     return $self->logged_in;          return;
 }      }
   
 =pod      ## Get to login prompt
       unless (
 =head2 B<parse_login_banner> - Converts the login_banner to something useful.          $self->waitfor(
               -match   => '/password: ?$/i',
 Takes a login banner (what you get when you first connect to the Trango)              -errmode => "return",
 or reads what is already in login_banner() then parses it and sets          )
 host_type() and firmware_version() as well as login_banner()          )
       {
 =cut          $self->last_error( "problem connecting to host ("
                   . $self->host . "): "
 sub parse_login_banner {                  . $self->lastline );
     my $self = shift;          return;
       }
     if (@_) {  
         $self->login_banner(@_);      $self->parse_login_banner( $self->lastline );
     }  
       $self->is_connected(1);
     my $banner = $self->login_banner;  
       return $self->is_connected;
     my ( $type, $sep1, $subtype, $sep2, $ver ) =  }
       $banner =~  
       /Welcome to Trango Broadband Wireless (\S+)([\s-]+)(\S+)([\s-]+)(.+)$/i;  =pod
   
     $type .= $sep1 . $subtype;  =head2 B<login> - Login to the AP.
     $ver = $subtype . $sep2 . $ver;  
   Calls open() if not already connected, then sends the password and sets
     $self->login_banner($banner);  logged_in() if successful
     $self->host_type($type);  
     $self->firmware_version($ver);  =cut
   
     return 1;  sub login {
 }      my $self = shift;
   
 =pod      unless ( $self->is_connected ) {
           $self->open or return;
 =head2 B<su_password> - Set the password on SUs connected to the AP.      }
   
 su_password('new_password'[, 'suid']) If no suid is specified,      my $password = shift;
 the default is "all".  
       $self->print($password);
   $t->su_password('good_pass', 5);      unless (
           $self->waitfor(
 =cut              -match   => $self->prompt,
               -errmode => "return",
 sub su_password {          )
     my $self     = shift;          )
     my $new_pass = shift || $EMPTY;      {
     my $su       = shift || 'all';          $self->last_error( "login ($self->host) failed: " . $self->lastline );
           return;
     unless ( defined $new_pass ) {      }
         $self->last_error("No new password");  
       $self->logged_in(1);
         #return;  
     }      return $self->logged_in;
   }
     return $self->cmd(  
         String => 'su password ' . $su . $SPACE . $new_pass . $SPACE . $new_pass,  =pod
         expect => $success,  
     );  =head2 B<parse_login_banner> - Converts the login_banner to something useful.
 }  
   Takes a login banner (what you get when you first connect to the Trango)
 =pod  or reads what is already in login_banner() then parses it and sets
   host_type() and firmware_version() as well as login_banner()
 =head2 B<su_ipconfig> - Change IP configuration on SUs connected to the AP.  
   =cut
 su_ipconfig( 'suid', 'new_ip', 'new_subnet', 'new_gateway' )  
   sub parse_login_banner {
   $t->su_ipconfig( 5, '10.0.1.5', '255.255.255.0', '10.0.1.1' );      my $self = shift;
   
 =cut      if (@_) {
           $self->login_banner(@_);
 sub su_ipconfig {      }
     my $self = shift;  
       my $banner = $self->login_banner;
     my $suid        = shift;  
     my $new_ip      = shift;      my ( $type, $sep1, $subtype, $sep2, $ver )
     my $new_subnet  = shift;          = $banner
     my $new_gateway = shift;          =~ /Welcome to Trango Broadband Wireless,? (\S+)([\s-]+)(\S+)([\s-]+)(.+)$/i;
   
     if ( $suid =~ /\D/ ) {      $type .= $sep1 . $subtype;
         $self->last_error("Invalid suid '$suid'");      $ver = $subtype . $sep2 . $ver;
         return;  
     }      $self->login_banner($banner);
     unless ($new_ip) {      $self->host_type($type);
         $self->last_error("no new_ip passed");      $self->firmware_version($ver);
         return;  
     }      return 1;
     unless ($new_subnet) {  }
         $self->last_error("no new_subnet passed");  
         return;  =pod
     }  
     unless ($new_gateway) {  =head2 B<linktest> - Link test to SU
         $self->last_error("no new_gateway passed");  
         return;  linktest('suid'[, 'pkt len, bytes'[, '# of pkts'[, '# of cycles']]]);
     }  
   Returns a hash reference to the results of the test
     # su ipconfig <suid> <new ip> <new subnet> <new gateway>  
     return $self->cmd(  =cut
         String => 'su ipconfig ' . $suid . $SPACE . $new_ip . $SPACE  
           . $new_subnet . $SPACE  sub linktest {
           . $new_gateway,      my $self = shift;
         expect => $success,      my $suid = shift;
     );  
 }      # These numbers are what I found as defaults when running the command
       my $pkt_len = shift || 1600;
 =pod      my $pkt_cnt = shift || 500;
       my $cycles  = shift || 10;
 =head2 B<sudb_view> - Returns the output from the sudb view command  
       my %config = @_;
 returns a reference to an array of hashes each containing these keys  
 'suid', 'type', 'cir', 'mir' and 'mac'      # * 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
 =cut      # same as $pkt_len, and that might not be enough at slower speeds.
       $config{Timeout} ||= int( ( $pkt_len * $pkt_cnt * $cycles * 2 ) / 1000 );
 sub sudb_view {  
     my $self = shift;      my $string = join $SPACE, 'linktest', $suid, $pkt_len, $pkt_cnt, $cycles;
       return $self->cmd(
     my $lines = $self->cmd( String => 'sudb view', expect => $success ) || [];          %config,
           String => $string,
     return unless @{$lines};          decode => 'linktest',
       );
     unless ( $PRIVATE{'Decode'} ) {  
         return $lines;  }
     }  
   =pod
     my @sus;  
     foreach ( @{$lines} ) {  =head2 B<su_password> - Set the password on SUs connected to the AP.
         next unless $_;  
         if (/^\[(\d+)\]\s+(\d+)\s+(\d+)\s+(\d+)\s+([0-9A-Fa-f\s]+)$/) {  su_password('new_password'[, 'suid']) If no suid is specified,
             my %s = (  the default is "all".
                 suid => $1,  
                 type => $2,    $t->su_password('good_pass', 5);
                 cir  => $3,  
                 mir  => $4,  =cut
                 mac  => $5,  
             );  sub su_password {
       my $self     = shift;
             $s{'mac'} =~ s/\s//g;      my $new_pass = shift || $EMPTY;
             $s{'mac'} = uc( $s{'mac'} );      my $su       = shift || 'all';
   
             push @sus, \%s;      unless ( defined $new_pass ) {
         }          $self->last_error("No new password");
     }  
           #return;
     return \@sus;      }
 }  
       return $self->cmd(
 =pod          String => 'su password '
               . $su
 =head2 B<sudb_add> - Adds an su to the sudb              . $SPACE
               . $new_pass
 Takes the following paramaters              . $SPACE
               . $new_pass,
     suid : numeric,          expect => $success,
     type : (reg|pr)      );
     cir  : numeric,  }
     mir  : numeric,  
     mac  : Almost any format, it will be reformatted,  =pod
   
 and returns true on success or undef otherwise.  =head2 B<ipconfig> - Change IP configuration
   
   $t->sudb_add($suid, 'reg', $cir, $mir, $mac);  ipconfig( 'new_ip', 'new_subnet', 'new_gateway' )
   
 You should save_sudb() after calling this, or your changes  will be lost    $t->ipconfig( '10.0.1.5', '255.255.255.0', '10.0.1.1' );
 when the AP is rebooted.  
   =cut
 =cut  
   sub ipconfig {
 sub sudb_add {      my $self = shift;
     my $self = shift;  
     my $suid = shift;      my $string = join $SPACE, 'ipconfig', @_;
     my $type = shift;  
     my $cir  = shift;      if ( @_ == 3 ) {
     my $mir  = shift;          $self->print($string);
     my $mac  = shift;          my @lines = $self->waitfor( Match => '/save\s+and\s+activate/', );
           $self->print('y');
     if ( $suid =~ /\D/ ) {  
         $self->last_error("Invalid suid '$suid'");          $self->logged_in(0);
         return;          $self->is_connected(0);
     }  
           foreach my $line (@lines) {
     unless ( lc($type) eq 'reg' || lc($type) eq 'pr' ) {              if ( $line =~ s/New \s configuration:\s+//xms ) {
         $self->last_error("Invalid type '$type'");                  return _decode_lines($line);
         return;              }
     }          }
   
     if ( $cir =~ /\D/ ) {          return {};
         $self->last_error("Invalid CIR '$cir'");      }
         return;  
     }      # ipconfig [ <new ip> <new subnet> <new gateway> ]
       return $self->cmd( String => $string, expect => $success );
     if ( $mir =~ /\D/ ) {  }
         $self->last_error("Invalid MIR '$mir'");  
         return;  =pod
     }  
   =head2 B<su_ipconfig> - Change IP configuration on SUs connected to the AP.
     my $new_mac = $mac;  
     $new_mac =~ s/[^0-9A-Fa-f]//;  su_ipconfig( 'suid', 'new_ip', 'new_subnet', 'new_gateway' )
     unless ( length $new_mac == 12 ) {  
         $self->last_error("Invalid MAC '$mac'");    $t->su_ipconfig( 5, '10.0.1.5', '255.255.255.0', '10.0.1.1' );
         return;  
     }  =cut
     $new_mac = join $SPACE, $new_mac =~ /../g;  
   sub su_ipconfig {
     my $string =      my $self = shift;
       'sudb add ' . $suid . $SPACE . $type . $SPACE . $cir . $SPACE . $mir . $SPACE  
       . $new_mac;      my $suid        = shift;
       my $new_ip      = shift;
     return $self->cmd( String => $string, expect => $success );      my $new_subnet  = shift;
 }      my $new_gateway = shift;
   
 =pod      if ( $suid =~ /\D/ ) {
           $self->last_error("Invalid suid '$suid'");
 =head2 B<sudb_delete> - removes an su from the sudb          return;
       }
 Takes either 'all' or the  suid of the su to delete      unless ($new_ip) {
 and returns true on success or undef otherwise.          $self->last_error("no new_ip passed");
           return;
   $t->sudb_delete($suid);      }
       unless ($new_subnet) {
 You should save_sudb() after calling this, or your changes  will be lost          $self->last_error("no new_subnet passed");
 when the AP is rebooted.          return;
       }
 =cut      unless ($new_gateway) {
           $self->last_error("no new_gateway passed");
 sub sudb_delete {          return;
     my $self = shift;      }
     my $suid = shift;  
       # su ipconfig <suid> <new ip> <new subnet> <new gateway>
     #if (lc($suid) ne 'all' || $suid =~ /\D/) {      return $self->cmd(
     if ( $suid =~ /\D/ ) {          String => 'su ipconfig '
         $self->last_error("Invalid suid '$suid'");              . $suid
         return;              . $SPACE
     }              . $new_ip
               . $SPACE
     return $self->cmd( String => 'sudb delete ' . $suid, expect => $success );              . $new_subnet
 }              . $SPACE
               . $new_gateway,
 =pod          expect => $success,
       );
 =head2 B<sudb_modify> - changes the su information in the sudb  }
   
 Takes either the  suid of the su to change  =pod
 as well as what you are changing, either "cir, mir or su2su"  
 and returns true on success or undef otherwise.  =head2 B<sudb_view> - Returns the output from the sudb view command
   
 cir and mir also take a value to set the cir/mir to.  returns a reference to an array of hashes each containing these keys
   'suid', 'su2su', 'type', 'cir', 'mir' and 'mac'
 su2su takes a group id parameter that is in hex.  
   =cut
   $t->sudb_modify($suid, 'cir', 512);  
   sub sudb_view {
 You should save_sudb() after calling this, or your changes  will be lost      my $self = shift;
 when the AP is rebooted.  
       my $lines = $self->cmd( String => 'sudb view', expect => $success ) || [];
 =cut  
       return unless @{$lines};
 sub sudb_modify {  
     my $self  = shift;      my $s = *$self->{net_telnet_trango};
     my $suid  = shift;      return $lines if !$s->{'Decode'};
     my $opt   = shift;  
     my $value = shift;      my @sus;
       foreach ( @{$lines} ) {
     if ( $suid =~ /\D/ ) {          next unless $_;
         $self->last_error("Invalid suid '$suid'");          if (/^
         return;              \[(\d+)\]
     }              \s+
               [[:xdigit:]]{2}
     if ( lc($opt) eq 'cir' or lc($opt) eq 'mir' ) {              ([[:xdigit:]])
         if ( $value =~ /\D/ ) {              ([[:xdigit:]])
             $self->last_error("Invalid $opt '$value'");              \s+
             return;              (\d+)
         }              \s+
     }              (\d+)
     elsif ( lc($opt) eq 'su2su' ) {              \s+
         if ( $value =~ /[^0-9A-Za-f]/ ) {              ([[:xdigit:]\s]+)
             $self->last_error("Invalid MAC '$value'");          $/ixms
             return;              )
         }          {
     }              my %s = (
     else {                  suid  => $1,
         $self->last_error("Invalid option '$opt'");                  su2su => $2 ? $2 : undef,
         return;                  type  => $3 == 1 ? 'reg' : $3 == 5 ? 'pri' : $3,
     }                  cir   => $4,
                   mir   => $5,
     my $string = 'sudb modify ' . $suid . $SPACE . $opt . $SPACE . $value;                  mac   => $6,
               );
     return $self->cmd( String => $string, expect => $success );  
 }              $s{'mac'} =~ s/\s//gxms;
               $s{'mac'} = uc( $s{'mac'} );
 =pod  
               push @sus, \%s;
 =head2 B<enable_tftpd> - enable the TFTP server          }
       }
 runs C<tftpd(args =E<gt> 'on')> and makes sure that Tftpd is now 'listen'ing  
       return \@sus;
 =cut  }
   
 sub enable_tftpd {  =pod
     my $self = shift;  
   =head2 B<sudb_add> - Adds an su to the sudb
     my $vals = $self->tftpd( args => 'on' );  
   Takes the following paramaters
     if ( ref $vals eq 'HASH' && $vals->{'Tftpd'} eq 'listen' ) {  
         return $vals;      suid : numeric,
     }      type : (reg|pr)
     else {      cir  : numeric,
         return;      mir  : numeric,
     }      mac  : Almost any format, it will be reformatted,
 }  
   and returns true on success or undef otherwise.
 =pod  
     $t->sudb_add($suid, 'reg', $cir, $mir, $mac);
 =head2 B<disable_tftpd> - disable the TFTP server  
   You should save_sudb() after calling this, or your changes  will be lost
 runs C<tftpd(args =E<gt> 'off')> and makes sure that Tftpd is now 'disabled'  when the AP is rebooted.
   
 =cut  =cut
   
 sub disable_tftpd {  sub sudb_add {
     my $self = shift;      my $self = shift;
       my $suid = shift;
     my $vals = $self->tftpd( args => 'off' );      my $type = shift;
       my $cir  = shift;
     if ( ref $vals eq 'HASH' && $vals->{'Tftpd'} eq 'disabled' ) {      my $mir  = shift;
         return $vals;      my $mac  = shift;
     }  
     else {      if ( $suid =~ /\D/ ) {
         return;          $self->last_error("Invalid suid '$suid'");
     }          return;
 }      }
   
 =pod      unless ( lc($type) eq 'reg' || lc($type) eq 'pr' ) {
           $self->last_error("Invalid type '$type'");
 =head2 B<cmd> - runs a command on the AP.          return;
       }
 This does most of the work.  At the heart, it calls Net::Telnet::cmd()  
 but it also does some special stuff for Trango.      if ( $cir =~ /\D/ ) {
           $self->last_error("Invalid CIR '$cir'");
 Normally returns the last lines from from the command          return;
       }
 If you are using this, rather than one of the "easy" methods above,  
 you probably want to read through the source of this module to see how      if ( $mir =~ /\D/ ) {
 some of the other commands are called.          $self->last_error("Invalid MIR '$mir'");
           return;
 In addition to the Net::Telnet::cmd() options, it also accepts these:      }
   
 I<decode>      my $new_mac = $mac;
 - if this is true, then it will send the output lines to _decode_lines()      $new_mac =~ s/[^0-9A-Fa-f]//g;
 and then returns the decoded output      unless ( length $new_mac == 12 ) {
           $self->last_error("Invalid MAC '$mac'");
 I<no_prompt>          return;
 - if this is true, it does not wait for a prompt, so you are not stuck      }
 waiting for something that will never happen.      $new_mac = join $SPACE, $new_mac =~ /../g;
   
 I<cmd_disconnects>      my $string
 - if this is true, it then sets logged_in() to false, then it will          = 'sudb add '
 close() the connection and set is_connected() to false          . $suid
           . $SPACE
 I<expect>          . $type
 - 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          . $cir
 command probably failed          . $SPACE
           . $mir
 I<args>          . $SPACE
 - a string containing the command line options that are passed to the          . $new_mac;
 command  
       return $self->cmd( String => $string, expect => $success );
     $t->cmd( String => 'exit', no_prompt => 1, cmd_disconnects => 1 );  }
   
 =cut  =pod
   
 sub cmd {  =head2 B<sudb_delete> - removes an su from the sudb
     my $self = shift;  
   Takes either 'all' or the  suid of the su to delete
     my @valid_net_telnet_opts = qw(  and returns true on success or undef otherwise.
       String  
       Output    $t->sudb_delete($suid);
       Cmd_remove_mode  
       Errmode  You should save_sudb() after calling this, or your changes  will be lost
       Input_record_separator  when the AP is rebooted.
       Ors  
       Output_record_separator  =cut
       Prompt  
       Rs  sub sudb_delete {
       Timeout      my $self = shift;
     );      my $suid = shift;
   
     my %cfg;      #if (lc($suid) ne 'all' || $suid =~ /\D/) {
     if ( @_ == 1 ) {      if ( $suid =~ /\D/ ) {
         $cfg{'String'} = shift;          $self->last_error("Invalid suid '$suid'");
     }          return;
     elsif ( @_ > 1 ) {      }
         %cfg = @_;  
     }      return $self->cmd( String => 'sudb delete ' . $suid, expect => $success );
   }
     $cfg{'Timeout'} ||= $self->Timeout;  
   =pod
     unless ( $cfg{'String'} ) {  
         $self->last_error("No command passed");  =head2 B<sudb_modify> - changes the su information in the sudb
         return;  
     }  Takes either the  suid of the su to change
   as well as what you are changing, either "cir, mir or su2su"
     unless ( $self->is_connected ) {  and returns true on success or undef otherwise.
         $self->last_error("Not connected");  
         return;  cir and mir also take a value to set the cir/mir to.
     }  
   su2su takes a group id parameter that is in hex.
     unless ( $self->logged_in ) {  
         $self->last_error("Not logged in");    $t->sudb_modify($suid, 'cir', 512);
         return;  
     }  You should save_sudb() after calling this, or your changes  will be lost
   when the AP is rebooted.
     my %cmd;  
     foreach (@valid_net_telnet_opts) {  =cut
         if ( exists $cfg{$_} ) {  
             $cmd{$_} = $cfg{$_};  sub sudb_modify {
         }      my $self  = shift;
     }      my $suid  = shift;
     if ( $cfg{'args'} ) {      my $opt   = shift;
         $cmd{'String'} .= $SPACE . $cfg{'args'};      my $value = shift;
     }  
       if ( $suid =~ /\D/ ) {
     my @lines;          $self->last_error("Invalid suid '$suid'");
     if ( $cfg{'no_prompt'} ) {          return;
         $self->print( $cmd{'String'} );      }
         @lines = $self->lastline;  
     }      if ( lc($opt) eq 'cir' or lc($opt) eq 'mir' ) {
     else {          if ( $value =~ /\D/ ) {
         @lines = $self->SUPER::cmd(%cmd);              $self->last_error("Invalid $opt '$value'");
     }              return;
           }
     $self->last_lines( \@lines );      }
       elsif ( lc($opt) eq 'su2su' ) {
     my $vals = 1;          if ( $value =~ /[^0-9A-Za-f]/ ) {
     if ( $PRIVATE{'Decode'} && $cfg{'decode'} ) {              $self->last_error("Invalid MAC '$value'");
         if ( $cfg{'decode'} eq 'each' ) {              return;
             $vals = _decode_each_line(@lines);          }
         }      }
         elsif ( $cfg{'decode'} eq 'sulog' ) {      else {
             $vals = _decode_sulog(@lines);          $self->last_error("Invalid option '$opt'");
         }          return;
         elsif ( $cfg{'decode'} eq 'maclist' ) {      }
             $vals = _decode_maclist(@lines);  
         }      my $string = 'sudb modify ' . $suid . $SPACE . $opt . $SPACE . $value;
         else {  
             $vals = _decode_lines(@lines);      return $self->cmd( String => $string, expect => $success );
         }  }
     }  
   =pod
     $self->last_vals($vals);  
   =head2 B<enable_tftpd> - enable the TFTP server
     my $last = $self->lastline;  
   runs C<tftpd(args =E<gt> 'on')> and makes sure that Tftpd is now 'listen'ing
     if ( ( not $cfg{'expect'} ) || $last =~ /$cfg{'expect'}$/ ) {  
         if ( $cfg{'cmd_disconnects'} ) {  =cut
             $self->logged_in(0);  
             $self->close;  sub enable_tftpd {
             $self->is_connected(0);      my $self = shift;
         }  
       my $vals = $self->tftpd( args => 'on' );
         if ( $PRIVATE{'Decode'} && $cfg{'decode'} ) {  
             return $vals;      if ( ref $vals eq 'HASH' && $vals->{'Tftpd'} eq 'listen' ) {
         }          return $vals;
         else {      }
             return \@lines;      else {
         }          return;
     }      }
     else {  }
         my $err;  
         if (grep { /\[ERR\]/ } @lines) {  =pod
             $err = _decode_lines(@lines);  
         }  =head2 B<disable_tftpd> - disable the TFTP server
   
         if (ref $err eq 'HASH' && $err ->{ERR}) {  runs C<tftpd(args =E<gt> 'off')> and makes sure that Tftpd is now 'disabled'
             $self->last_error($err->{ERR} );  
         } else {  =cut
             $self->last_error("Error with command ($cfg{'String'}): $last");  
         }  sub disable_tftpd {
         return;      my $self = shift;
     }  
 }      my $vals = $self->tftpd( args => 'off' );
   
 #=item _decode_lines      if ( ref $vals eq 'HASH' && $vals->{'Tftpd'} eq 'disabled' ) {
           return $vals;
 sub _decode_lines {      }
     my @lines = @_;      else {
           return;
     my %conf;      }
   }
     my $key = $EMPTY;  
     my $val = undef;  =pod
     my @vals;  
     my $in_key = 0;  =head2 B<cmd> - runs a command on the AP.
     my $in_val = 1;  
   This does most of the work.  At the heart, it calls Net::Telnet::cmd()
     foreach my $line (@lines) {  but it also does some special stuff for Trango.
         next if $line =~ /$success$/;  
   Normally returns the last lines from from the command
         my @chars = split //, $line;  
   If you are using this, rather than one of the "easy" methods above,
         my $last_key = $EMPTY;  you probably want to read through the source of this module to see how
         foreach my $c (@chars) {  some of the other commands are called.
   
             if ( $c eq '[' || $c eq "\r" || $c eq "\n" ) {  In addition to the Net::Telnet::cmd() options, it also accepts these:
                 if ( $c eq '[' ) {  
                     $in_key = 1;  I<decode>
                     $in_val = 0;  - if this is true, then it will send the output lines to _decode_lines()
                 }  and then returns the decoded output
                 else {  
                     $in_key = 0;  I<no_prompt>
                     $in_val = 1;  - if this is true, it does not wait for a prompt, so you are not stuck
                 }  waiting for something that will never happen.
   
                 if ($key) {  I<cmd_disconnects>
                     $key =~ s/^\s+//;  - if this is true, it then sets logged_in() to false, then it will
                     $key =~ s/\s+$//;  close() the connection and set is_connected() to false
   
                     if ($val) {  I<expect>
                         $val =~ s/^\s+//;  - if this is set (usually to 'Success.') it will check for that in the
                         $val =~ s/\s+$//;  last line of output and if it does not, will return undef because the
                     }  command probably failed
   
                     if ( $key eq 'Checksum' && $last_key ) {  I<args>
   - a string containing the command line options that are passed to the
                         # Special case for these bastids.  command
                         my $new = $last_key;  
                         $new =~ s/\s+\S+$//;      $t->cmd( String => 'exit', no_prompt => 1, cmd_disconnects => 1 );
                         $key = $new . $SPACE . $key;  
                     }  =cut
   
                     $conf{$key} = $val;  sub cmd {
                     $last_key   = $key;      my $self = shift;
                     $key        = $EMPTY;      my $s    = *$self->{net_telnet_trango};
                 }  
                 elsif ($val) {      my @valid_net_telnet_opts = qw(
                     push @vals, $val;          String
                 }          Output
                 $val = $EMPTY;          Cmd_remove_mode
           Errmode
             }          Input_record_separator
             elsif ( $c eq ']' ) {          Ors
                 $in_val = 1;          Output_record_separator
                 $in_key = 0;          Prompt
                 $c      = shift @chars;          Rs
           Timeout
             }      );
             elsif ($in_key) {  
                 $key .= $c;      my %cfg;
       if ( @_ == 1 ) {
             }          $cfg{'String'} = shift;
             elsif ($in_val) {      }
                 $val .= $c;      elsif ( @_ > 1 ) {
             }          %cfg = @_;
         }      }
     }  
       $cfg{'Timeout'} ||= $self->Timeout;
     unless ($key) {  
         push @vals, $val;      unless ( $cfg{'String'} ) {
     }          $self->last_error("No command passed");
           return;
     if ( @vals == 1 ) {      }
         $val = $vals[0];  
     }      unless ( $self->is_connected ) {
     elsif (@vals) {          $self->last_error("Not connected");
         $val = \@vals;          return;
     }      }
     else {  
         $val = undef;      unless ( $self->logged_in ) {
     }          $self->last_error("Not logged in");
           return;
     if (%conf) {      }
         $conf{_pre} = $val if $val;  
         return \%conf;      my %cmd;
     }      foreach (@valid_net_telnet_opts) {
     else {          if ( exists $cfg{$_} ) {
         return $val;              $cmd{$_} = $cfg{$_};
     }          }
 }      }
       if ( $cfg{'args'} ) {
 #=item _decode_each_line          $cmd{'String'} .= $SPACE . $cfg{'args'};
       }
 sub _decode_each_line {  
     my @lines = @_;      #print "Running cmd $cmd{String}\n";
     my @decoded;      my @lines;
     foreach my $line (@lines) {      if ( $cfg{'no_prompt'} ) {
         my $decoded = _decode_lines($line);          $self->print( $cmd{'String'} );
         push @decoded, $decoded if defined $decoded;          @lines = $self->lastline;
     }      }
     return \@decoded;      else {
 }          @lines = $self->SUPER::cmd(%cmd);
       }
 #=item _decode_sulog  
       $self->last_lines( \@lines );
 sub _decode_sulog {  
     my @lines = @_;      my $last   = $self->lastline;
     my @decoded;      my $prompt = $self->prompt;
     my $last_tm;      $prompt =~ s{^/}{}xms;
     foreach my $line (@lines) {      $prompt =~ s{/[gixms]*$}{}xms;
         my $decoded = _decode_lines($line);      while ( @lines && $last =~ qr($prompt) ) {
           pop @lines;
         if ( defined $decoded ) {          $last = $lines[-1];
             if ( $decoded->{'tm'} ) {      }
                 $last_tm = $decoded->{'tm'};      $self->last_error($EMPTY);
                 next;  
             }      my $vals = 1;
             else {      if ( $s->{'Decode'} && $cfg{'decode'} ) {
                 $decoded->{'tm'} = $last_tm;          if ( $cfg{'decode'} eq 'each' ) {
             }              $vals = _decode_each_line(@lines);
             next unless $last_tm;          }
           elsif ( $cfg{'decode'} eq 'sulog' ) {
             push @decoded, $decoded if defined $decoded;              $vals = _decode_sulog(@lines);
         }          }
     }          elsif ( $cfg{'decode'} eq 'maclist' ) {
     return \@decoded;              $vals = _decode_maclist(@lines);
 }              if ( !$vals ) {
                   $self->last_error("Error decoding maclist");
 #=item _decode_maclist              }
           }
 sub _decode_maclist {          elsif ( $cfg{'decode'} eq 'linktest' ) {
     my @lines = @_;              $vals = _decode_linktest(@lines);
     my @decoded;              if ( !$vals ) {
     my $total_entries = 0;                  $self->last_error("Error decoding linktest");
     my $current_tm    = 0;              }
     foreach my $line (@lines) {          }
         $line =~ s/\r?\n$//;          elsif ( $cfg{'decode'} eq 'freq' ) {
         my ( $mac, $loc, $tm ) = $line =~ /              $vals = _decode_freq(@lines);
             ([0-9a-fA-F ]{17})\s+          }
             (.*)\s+          else {
             tm\s+              $vals = _decode_lines(@lines);
             (\d+)          }
         /x;      }
       if ( ref $vals eq 'HASH' ) {
         if ($mac) {          $vals->{_raw} = join q{}, @lines;
             $mac =~ s/\s+//g;      }
             $loc =~ s/^\s+//;      $self->last_vals($vals);
             $loc =~ s/\s+$//;  
       if ( ( not $cfg{'expect'} ) || $last =~ /$cfg{'expect'}$/ ) {
             my $suid = undef;          if ( $cfg{'cmd_disconnects'} ) {
             if ( $loc =~ /suid\s+=\s+(\d+)/ ) {              $self->logged_in(0);
                 $suid = $1;              $self->close;
                 $loc  = undef;              $self->is_connected(0);
             }          }
   
             push @decoded,          if ( $s->{'Decode'} && $cfg{'decode'} ) {
               {              return $vals;
                 mac  => $mac,          }
                 loc  => $loc,          else {
                 tm   => $tm,              return \@lines;
                 suid => $suid,          }
               };      }
         }      else {
         elsif ( $line =~ /(\d+)\s+entries/ ) {          my $err;
             $total_entries = $1;          if ( grep {/\[ERR\]/} @lines ) {
         }              $err = _decode_lines(@lines);
         elsif ( $line =~ /current tm = (\d+)\s+sec/ ) {          }
             $current_tm = $1;  
         }          if ( ref $err eq 'HASH' && $err->{ERR} ) {
     }              $self->last_error( $err->{ERR} );
           }
     map { $_->{'cur_tm'} = $current_tm } @decoded;          else {
               $self->last_error("Error with command ($cmd{'String'}): $last");
     if ( scalar @decoded == $total_entries ) {          }
         return \@decoded;          return;
     }      }
     else {  }
   
         # XXX we should have a way to set last error, not sure why we don't  #=item _decode_lines
         return;  
     }  sub _decode_lines {
 }      my @lines = @_;
   
 1;    # End of Net::Telnet::Trango      my %conf;
 __END__  
       my $key = $EMPTY;
 =head1 SEE ALSO      my $val = undef;
       my @vals;
 Trango Documentation -      my $in_key = 0;
 L<http://www.trangobroadband.com/support/product_docs.htm>      my $in_val = 1;
   
 L<Net::Telnet>  LINE: while ( my $line = shift @lines ) {
           next LINE if $line =~ /$success\Z/;
 =head1 TODO          next LINE if $line =~ /^ \*+ \s+ \d+ \s+ \*+ \Z/xms;
   
 There are still a lot of commands that are not accessed directly.  If          # Special decode for sysinfo on a TrangoLink 45
 you call them (as cmd("command + args") or whatever) and it works,          if ( $line =~ /^(.* Channel \s+ Table):\s*(.*)\Z/xms ) {
 please send me examples that work and I will try to get it incorporated              my $key  = $1;
 into the next version of the script.              my $note = $2;
   
 I also want to be able to parse the different types of output from              my %vals;
 commands like su, sudb all and anything else that would be better              while ( $line = shift @lines ) {
 available as a perl datastructure.                  if ( $line =~ /^\Z/ ) {
                       $conf{$key} = \%vals;
 =head1 AUTHOR                      $conf{$key}{note} = $note;
                       next LINE;
 Andrew Fresh E<lt>andrew@rraz.netE<gt>                  }
   
 =head1 SUPPORT                  my $decoded = _decode_lines($line);
                   if ($decoded) {
 You can find documentation for this module with the perldoc command.                      %vals = ( %vals, %{$decoded} );
                   }
     perldoc Net::Telnet::Trango              }
           }
 You can also look for information at:  
           # Another special decode for the TrangoLink
 =over 4          elsif (
               $line =~ /^
 =item * AnnoCPAN: Annotated CPAN documentation              RF \s Band \s \#
               (\d+) \s+
 L<http://annocpan.org/dist/Net-Telnet-Trango>              \( ([^\)]+) \) \s*
               (.*)$
 =item * CPAN Ratings          /xms
               )
 L<http://cpanratings.perl.org/d/Net-Telnet-Trango>          {
               my $num   = $1;
 =item * RT: CPAN's request tracker              my $band  = $2;
               my $extra = $3;
 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-Telnet-Trango>  
               if ( $extra =~ /\[/ ) {
 =item * Search CPAN                  my $decoded = _decode_lines($extra);
                   $conf{'RF Band'}{$num} = $decoded;
 L<http://search.cpan.org/dist/Net-Telnet-Trango>              }
               else {
 =back                  $conf{'RF Band'}{$num}{$extra} = 1;
               }
 =head1 COPYRIGHT AND LICENSE              next LINE;
           }
 Copyright (C) 2005,2006,2007 by Andrew Fresh  
           my @chars = split //, $line;
 This program is free software; you can redistribute it and/or modify it  
 under the same terms as Perl itself.          my $last_key = $EMPTY;
           foreach my $c (@chars) {
 =cut  
               if ( $c eq '[' || $c eq "\r" || $c eq "\n" ) {
                   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.38  
changed lines
  Added in v.1.60
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>