trango/Net-Telnet-Trango/lib/Net/Telnet/Trango.pm - diff

Return to Trango.pm CVS log

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.45

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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>