=================================================================== RCS file: /cvs/trango/Net-Telnet-Trango/lib/Net/Telnet/Trango.pm,v retrieving revision 1.42 retrieving revision 1.46 diff -u -r1.42 -r1.46 --- trango/Net-Telnet-Trango/lib/Net/Telnet/Trango.pm 2007/05/21 21:24:13 1.42 +++ trango/Net-Telnet-Trango/lib/Net/Telnet/Trango.pm 2008/02/08 17:34:10 1.46 @@ -1,6 +1,6 @@ package Net::Telnet::Trango; -# $RedRiver: Trango.pm,v 1.41 2007/02/07 20:08:32 andrew Exp $ +# $RedRiver: Trango.pm,v 1.45 2008/02/08 16:49:09 andrew Exp $ use strict; use warnings; use base 'Net::Telnet'; @@ -112,6 +112,7 @@ # help [command] # heater [ ] # ipconfig [ ] +# linktest [ [<# of pkts> [<# of cycle>]]] # log [<# of entries, 1..179>] # log <# 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 - 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 - 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'} ); @@ -917,6 +956,12 @@ $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); } @@ -944,7 +989,7 @@ my $err; if (grep { /\[ERR\]/ } @lines) { $err = _decode_lines(@lines); - } + } if (ref $err eq 'HASH' && $err->{ERR}) { $self->last_error($err->{ERR} ); @@ -1062,6 +1107,32 @@ push @decoded, $decoded if defined $decoded; } return \@decoded; +} + +#=item _decode_linktest + +sub _decode_linktest { + my @lines = @_; + my %decoded; + foreach my $line (@lines) { + + if ($line =~ s/^(\d+) \s*//xms) { + my $line_id = $1; + my $d = _decode_lines($line . "\n"); + $decoded{tests}[$line_id] = $d; + } + + else { + my $d = _decode_lines($line . "\n"); + if ($d) { + while (my ($k, $v) = each %{ $d }) { + $decoded{$k} = $v; + } + } + } + + } + return \%decoded; } #=item _decode_sulog