| version 1.43, 2007/05/21 21:45:48 |
version 1.45, 2008/02/08 16:49:09 |
|
|
| package Net::Telnet::Trango; |
package Net::Telnet::Trango; |
| |
|
| # $RedRiver: Trango.pm,v 1.42 2007/05/21 20:24:13 andrew Exp $ |
# $RedRiver: Trango.pm,v 1.44 2007/06/05 19:54:05 mike Exp $ |
| use strict; |
use strict; |
| use warnings; |
use warnings; |
| use base 'Net::Telnet'; |
use base 'Net::Telnet'; |
|
|
| |
|
| my $success = 'Success\\.'; |
my $success = 'Success\\.'; |
| my %COMMANDS = ( |
my %COMMANDS = ( |
| _clear => { decode => 'all', String => '', args => '' }, |
_clear => { String => "\n" }, |
| tftpd => { decode => 'all', expect => $success }, |
tftpd => { decode => 'all', expect => $success }, |
| ver => { decode => 'all' }, |
ver => { decode => 'all' }, |
| sysinfo => { decode => 'all', expect => $success }, |
sysinfo => { decode => 'all', expect => $success }, |
|
|
| { String => 'su testrflink', decode => 'each', expect => $success }, |
{ String => 'su testrflink', decode => 'each', expect => $success }, |
| save_ss => { String => 'save ss', expect => $success }, |
save_ss => { String => 'save ss', expect => $success }, |
| opmode => { decode => 'all', expect => $success }, |
opmode => { decode => 'all', expect => $success }, |
| |
arq => { decode => 'all' }, |
| ); |
); |
| |
|
| my %ALIASES = ( |
my %ALIASES = ( |
|
|
| $cmd{'String'} .= $SPACE . $cfg{'args'}; |
$cmd{'String'} .= $SPACE . $cfg{'args'}; |
| } |
} |
| |
|
| |
#print "Running cmd $cmd{String}\n"; |
| my @lines; |
my @lines; |
| if ( $cfg{'no_prompt'} ) { |
if ( $cfg{'no_prompt'} ) { |
| $self->print( $cmd{'String'} ); |
$self->print( $cmd{'String'} ); |
|
|
| $self->last_error($err->{ERR} ); |
$self->last_error($err->{ERR} ); |
| } else { |
} else { |
| $self->last_error("Error with command ($cmd{'String'}): $last"); |
$self->last_error("Error with command ($cmd{'String'}): $last"); |
| $self->_clear(); |
|
| } |
} |
| return; |
return; |
| } |
} |
|
|
| push @decoded, $decoded if defined $decoded; |
push @decoded, $decoded if defined $decoded; |
| } |
} |
| return \@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 |
#=item _decode_sulog |