===================================================================
RCS file: /cvs/trango/Net-Telnet-Trango/lib/Net/Telnet/Trango.pm,v
retrieving revision 1.40
retrieving revision 1.48
diff -u -r1.40 -r1.48
--- trango/Net-Telnet-Trango/lib/Net/Telnet/Trango.pm	2007/02/06 21:15:28	1.40
+++ trango/Net-Telnet-Trango/lib/Net/Telnet/Trango.pm	2008/02/08 18:49:41	1.48
@@ -1,6 +1,6 @@
 package Net::Telnet::Trango;
 
-# $RedRiver: Trango.pm,v 1.39 2007/02/06 20:41:42 andrew Exp $
+# $RedRiver: Trango.pm,v 1.47 2008/02/08 17:40:00 andrew Exp $
 use strict;
 use warnings;
 use base 'Net::Telnet';
@@ -17,7 +17,7 @@
   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: $!";
 
@@ -28,12 +28,12 @@
 
 =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
-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
-things like sysinfo very easy to do.
+A handy feature is that it will parse the output from certain 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 things like sysinfo very easy to
+do.
 
 =head2 EXPORT
 
@@ -112,6 +112,7 @@
 #  help [command]
 #  heater [<on temp> <off temp>]
 #  ipconfig [<new ip> <new subnet mask> <new gateway>]
+#  linktest <suid> [<pkt len, bytes> [<# of pkts> [<# of cycle>]]]
 #  log [<# of entries, 1..179>]
 #  log <sum> <# of entries, 1..179>
 #  logout
@@ -322,6 +323,7 @@
 
 my $success  = 'Success\\.';
 my %COMMANDS = (
+    _clear      => { String => "\n" },
     tftpd       => { decode    => 'all',       expect          => $success },
     ver         => { decode    => 'all' },
     sysinfo     => { decode    => 'all',       expect          => $success },
@@ -342,6 +344,7 @@
       { String => 'su testrflink', decode => 'each', expect    => $success },
     save_ss     => { String => 'save ss',      expect          => $success },
     opmode      => { decode => 'all',          expect          => $success },
+    arq         => { decode => 'all' },
 );
 
 my %ALIASES = (
@@ -504,6 +507,41 @@
 
 =pod
 
+=head2 B<linktest> - Link test to SU
+
+linktest('suid'[, 'pkt len, bytes'[, '# of pkts'[, '# of cycles']]]);
+
+Returns a hash reference to the results of the test
+
+=cut
+
+sub linktest
+{
+    my $self    = shift;
+    my $suid    = shift;
+    # These numbers are what I found as defaults when running the command
+    my $pkt_len = shift || 1600;
+    my $pkt_cnt = shift || 500; 
+    my $cycles  = shift || 10;
+
+    my %config  = @_;
+
+    # * 2, one for the FromAP, one FromSU.  Then / 1000 to get to ms.
+    # XXX This might need to be changed, this makes the default timeout the
+    # same as $pkt_len, and that might not be enough at slower speeds.
+    $config{Timeout} ||= int(($pkt_len * $pkt_cnt * $cycles * 2 ) / 1000);
+
+    my $string = join $SPACE, 'linktest', $suid, $pkt_len, $pkt_cnt, $cycles;
+    return $self->cmd(
+        %config,
+        String => $string,
+        decode => 'linktest',
+    );
+
+}
+
+=pod
+
 =head2 B<su_password> - Set the password on SUs connected to the AP.
 
 su_password('new_password'[, 'suid']) If no suid is specified,
@@ -892,6 +930,7 @@
         $cmd{'String'} .= $SPACE . $cfg{'args'};
     }
 
+    #print "Running cmd $cmd{String}\n";
     my @lines;
     if ( $cfg{'no_prompt'} ) {
         $self->print( $cmd{'String'} );
@@ -913,7 +952,16 @@
         }
         elsif ( $cfg{'decode'} eq 'maclist' ) {
             $vals = _decode_maclist(@lines);
+            if (! $vals) {
+                $self->last_error("Error decoding maclist");
+            }
         }
+        elsif ( $cfg{'decode'} eq 'linktest' ) {
+            $vals = _decode_linktest(@lines);
+            if (! $vals) {
+                $self->last_error("Error decoding linktest");
+            }
+        }
         else {
             $vals = _decode_lines(@lines);
         }
@@ -922,6 +970,7 @@
     $self->last_vals($vals);
 
     my $last = $self->lastline;
+    $self->last_error($EMPTY);
 
     if ( ( not $cfg{'expect'} ) || $last =~ /$cfg{'expect'}$/ ) {
         if ( $cfg{'cmd_disconnects'} ) {
@@ -941,12 +990,12 @@
         my $err;
         if (grep { /\[ERR\]/ } @lines) {
             $err = _decode_lines(@lines);
-        }
+        } 
 
-        if (ref $err eq 'HASH' && $err ->{ERR}) {
+        if (ref $err eq 'HASH' && $err->{ERR}) {
             $self->last_error($err->{ERR} );
         } else {
-            $self->last_error("Error with command ($cfg{'String'}): $last");
+            $self->last_error("Error with command ($cmd{'String'}): $last");
         }
         return;
     }
@@ -1061,6 +1110,34 @@
     return \@decoded;
 }
 
+#=item _decode_linktest
+
+sub _decode_linktest {
+    my @lines = @_;
+    my %decoded;
+    foreach my $line (@lines) {
+
+        if ($line =~ /^(\d+) \s+ (.*) \s+ (\d+ \s+ \w+) \s+ (\d+ \s+ \w+) $/xms) {
+            my $line_id = $1;
+            my $d = _decode_lines($2. "\n");
+            $decoded{tests}[$line_id] = $d;
+            $decoded{tests}[$line_id]{'time'} = $3;
+            $decoded{tests}[$line_id]{rate}   = $4;
+        }
+
+        else {
+            my $d = _decode_lines($line . "\n");
+            if ($d) {
+                while (my ($k, $v) = each %{ $d }) {
+                    $decoded{$k} = $v;
+                }
+           }
+        }
+
+    }
+    return \%decoded;
+}
+
 #=item _decode_sulog
 
 sub _decode_sulog {
@@ -1135,8 +1212,6 @@
         return \@decoded;
     }
     else {
-
-        # XXX we should have a way to set last error, not sure why we don't
         return;
     }
 }