===================================================================
RCS file: /cvs/trango/Net-Telnet-Trango/lib/Net/Telnet/Trango.pm,v
retrieving revision 1.3
retrieving revision 1.8
diff -u -r1.3 -r1.8
--- trango/Net-Telnet-Trango/lib/Net/Telnet/Trango.pm	2005/12/30 19:26:06	1.3
+++ trango/Net-Telnet-Trango/lib/Net/Telnet/Trango.pm	2006/06/29 01:39:52	1.8
@@ -1,5 +1,5 @@
 package Net::Telnet::Trango;
-# $RedRiver: Trango.pm,v 1.2 2005/12/30 01:02:41 andrew Exp $
+# $RedRiver: Trango.pm,v 1.7 2006/06/28 22:33:18 andrew Exp $
 use strict;
 use warnings;
 use base 'Net::Telnet';
@@ -15,11 +15,7 @@
   use Net::Telnet::Trango;
   my $t = new Net::Telnet::Trango ( Timeout => 5 );
   
-  my ($type, $version) = $t->open( Host => $fox );
-  
-  unless (defined $type && defined $version) {
-    die "Error connecting: $!";
-  }
+  $t->open( Host => $fox ) or die "Error connecting: $!";
 
   $t->login('password') or die "Couldn't log in: $!";
   
@@ -49,6 +45,111 @@
 
 =pod
 
+=item new
+
+Same as new from L<Net::Telnet> but has defaults for the trango 'Prompt'
+
+=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};
+  }
+
+  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 METHODS
 
 =head2 ACCESSORS
@@ -138,91 +239,27 @@
 
 reboots the trango and closes the connection
 
-=cut
+=item sulog
 
-#  _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>
+returns an array ref of hashes containing each log line.
 
+=item save_sudb
 
+returns true on success, undef on failure
+
+=cut
+
+
 my $success = 'Success.';
 my %COMMANDS = (
-  tftpd       => { decode => 1, expect => $success },
-  ver         => { decode => 1 },
-  sysinfo     => { decode => 1, expect => $success },
-  updateflash => { decode => 1, expect => $success },
-  'exit'      => { Prompt => '//', cmd_disconnects => 1 },
-  reboot      => { Prompt => '//', cmd_disconnects => 1 },
+  tftpd       => { decode => 'all',   expect => $success },
+  ver         => { decode => 'all' },
+  sysinfo     => { decode => 'all',   expect => $success },
+  updateflash => { decode => 'all',   expect => $success },
+  sulog       => { decode => 'sulog', expect => $success },
+  'exit'      => { no_prompt => 1, cmd_disconnects => 1 },
+  reboot      => { no_prompt => 1, cmd_disconnects => 1 },
+  save_sudb   => { String => "save sudb", expect => $success },
   #su password???
   #_bootloader
   #temp
@@ -243,6 +280,7 @@
   login_banner
   Timeout
   last_lines
+  last_vals
 );
 
 sub AUTOLOAD 
@@ -275,37 +313,6 @@
 
 =pod
 
-=item new
-
-Same as new from L<Net::Telnet> but has defaults for the trango 'Prompt'
-
-=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};
-  }
-
-  my $self = $class->SUPER::new(%args);
-  bless $self if ref $self;
-
-  return $self;
-}
-
-=pod
-
 =item open
 
 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 host_type() and firmware_version()
@@ -400,6 +407,218 @@
 
 =pod
 
+=item su_password
+
+C<su_password('all'|suid, 'new_password')>
+
+=cut
+
+sub su_password
+{
+  my $self     = shift;
+  my $su       = shift || '!';
+  my $new_pass = shift || '';
+
+  unless (defined $su) {
+    warn "No su passed!" 
+    #return undef;
+  }
+
+  unless (defined $new_pass) {
+    warn "No new password!"  
+    #return undef;
+  }
+
+  return $self->cmd(String => 'su password ' . 
+                     $su . ' ' . 
+                     $new_pass . ' ' . 
+                     $new_pass,
+                     expect => $success,
+                    );
+}
+
+
+=pod
+
+=item sudb_view
+
+returns a reference to an array of hashes each containing:
+
+  suid
+  type
+  cir
+  mir
+  mac
+
+=cut
+
+sub sudb_view
+{
+  my $self = shift;
+
+  my @lines = $self->cmd( String => 'sudb view', expect => $success );
+
+  return undef unless @lines;
+
+  my @sus;
+  foreach (@lines) {
+    if (/^\[(\d+)\]\s+(\d+)\s+(\d+)\s+(\d+)\s+([0-9A-Fa-f\s]+)$/) {
+      my %s = (
+        suid => $1,
+        type => $2,
+        cir  => $3,
+        mir  => $4,
+        mac  => $5,
+      );
+
+	  $s{'mac'} =~ s/\s//g;
+	  $s{'mac'} = uc($s{'mac'});
+
+      push @sus, \%s;
+    }
+  }
+
+  return \@sus;
+}
+
+=pod
+
+=item sudb_add
+
+Takes the following paramaters
+
+	suid : numeric,
+	type : (reg|pr)
+	cir  : numeric,
+	mir  : numeric,
+	mac  : Almost any format, it will be reformatted,
+
+and returns true on success or undef otherwise.
+
+You should save_sudb() after calling this, or your changes  will be lost 
+when the AP is rebooted.
+
+=cut
+
+sub sudb_add
+{
+	my $self = shift;
+	my $suid = shift;
+	my $type = shift;
+	my $cir  = shift;
+	my $mir  = shift;
+	my $mac  = shift;
+
+	if ($suid =~ /\D/) {
+		return undef;
+	}
+
+	unless (lc($type) eq 'reg' || lc($type) eq 'pr') {
+		warn "Invalid type '$type'!";
+		return undef;
+	}
+
+	if ($cir =~ /\D/) {
+		warn "Invalid CIR '$cir'!";
+		return undef;
+	}
+
+	if ($mir =~ /\D/) {
+		warn "Invalid MIR '$mir'!";
+		return undef;
+	}
+
+	my $new_mac = $mac;
+	$new_mac =~ s/[^0-9A-Fa-f]//;
+	unless (length $new_mac == 12) {
+		warn "Invalid MAC '$mac'!";
+		return undef;
+	}
+	$new_mac = join ' ', $new_mac =~ /../g;
+
+	my $string = 'sudb add ' . 
+		$suid . ' ' .
+		$type . ' ' .
+		$cir  . ' ' .
+		$mir  . ' ' .
+		$new_mac;
+
+
+	return $self->cmd( String => $string, expect => $success );
+}
+
+=pod
+
+=item sudb_delete
+
+Takes either 'all' or the  suid of the su to delete
+and returns true on success or undef otherwise.
+
+You should save_sudb() after calling this, or your changes  will be lost 
+when the AP is rebooted.
+
+=cut
+
+sub sudb_delete
+{
+	my $self = shift;
+	my $suid = shift;
+
+	if (lc($suid) ne 'all' || $suid =~ /\D/) {
+		return undef;
+	}
+
+	return $self->cmd( String => 'sudb delete ' . $suid, expect => $success );
+}
+
+
+=pod
+
+=item sudb_modify
+
+Takes either the  suid of the su to delete
+as well as what you are changing, either "cir, mir or su2su"
+and returns true on success or undef otherwise.
+
+cir and mir also take a value to set the cir/mir to.
+
+su2su takes a group id parameter that is in hex.
+
+You should save_sudb() after calling this, or your changes  will be lost 
+when the AP is rebooted.
+
+=cut
+
+sub sudb_modify
+{
+	my $self  = shift;
+	my $suid  = shift;
+	my $opt   = shift;
+	my $value = shift;
+
+	if ($suid =~ /\D/) {
+		return undef;
+	}
+
+	if (lc($opt) eq 'cir' or lc($opt) eq 'mir') {
+		if ($value =~ /\D/) {
+			return undef;
+		}
+	} elsif (lc($opt) eq 'su2su') {
+		if ($value =~ /[^0-9A-Za-f]/) {
+			return undef;
+		}
+	} else {
+		return undef;
+	}
+
+	my $string = 'sudb modify ' . $suid . ' ' . $opt . ' ' . $value;
+
+	return $self->cmd( String => $string, expect => $success );
+}
+
+=pod
+
 =item enable_tftpd
 
 runs C<tftpd(args =E<gt> 'on')> and makes sure that Tftpd is now 'listen'ing
@@ -518,16 +737,30 @@
   if ($cfg{'args'}) {
     $cmd{'String'} .= ' ' . $cfg{'args'};
   }
-  my @lines = $self->SUPER::cmd(%cmd);
+  my @lines;
+  unless ($cfg{'no_prompt'}) {
+    @lines = $self->SUPER::cmd(%cmd);
+  } else {
+    $self->print($cmd{'String'});
+    @lines = $self->lastline;
+  }
 
   $self->last_lines(\@lines);
 
   my $vals = 1;
   if ($cfg{'decode'}) {
-    $vals = _decode_lines(@lines);
+    if ($cfg{'decode'} eq 'each') {
+      $vals = _decode_each_line(@lines);
+    } elsif ($cfg{'decode'} eq 'sulog') {
+      $vals = _decode_sulog(@lines);
+    } else {
+      $vals = _decode_lines(@lines);
+    }
   }
 
+  $self->last_vals($vals);
 
+
   my $last = $self->lastline;
 
   if ((not $cfg{'expect'}) || $last =~ /$cfg{'expect'}$/) {
@@ -562,6 +795,8 @@
   my $in_val = 0;
 
   foreach my $line (@lines) {
+    next if $line =~ /$success$/;
+
     my @chars = split //, $line;
 
     my $last_key = '';
@@ -613,8 +848,46 @@
   if (%conf) {
     return \%conf;
   } else {
-    return \@lines;
+    return undef;
   }
+}
+
+#=item _decode_each_line
+
+sub _decode_each_line
+{
+  my @lines = @_;
+  my @decoded;
+  foreach my $line (@lines) {
+    my $decoded = _decode_lines($line);
+    push @decoded, $decoded if defined $decoded;
+  }
+  return \@decoded;
+}
+
+#=item _decode_sulog
+
+sub _decode_sulog
+{
+  my @lines = @_;
+  my @decoded;
+  my $last_tm;
+  foreach my $line (@lines) {
+    my $decoded = _decode_lines($line);
+
+    if (defined $decoded) {
+      if ($decoded->{'tm'}) {
+        $last_tm = $decoded->{'tm'};
+        next;
+      } else {
+        $decoded->{'tm'} = $last_tm;
+      }
+      next unless $last_tm;
+
+      push @decoded, $decoded if defined $decoded;
+    }
+  }
+  return \@decoded;
 }
 
 1;