[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.25 and 1.37

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