=================================================================== RCS file: /cvs/trango/Net-Telnet-Trango/lib/Net/Telnet/Trango.pm,v retrieving revision 1.26 retrieving revision 1.29 diff -u -r1.26 -r1.29 --- trango/Net-Telnet-Trango/lib/Net/Telnet/Trango.pm 2007/01/17 23:15:13 1.26 +++ trango/Net-Telnet-Trango/lib/Net/Telnet/Trango.pm 2007/02/01 17:58:33 1.29 @@ -1,5 +1,5 @@ package Net::Telnet::Trango; -# $RedRiver: Trango.pm,v 1.25 2007/01/17 20:48:46 andrew Exp $ +# $RedRiver: Trango.pm,v 1.28 2007/02/01 17:10:07 mike Exp $ use strict; use warnings; use base 'Net::Telnet'; @@ -65,8 +65,8 @@ 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 an array of the lines that were returned from the -command. +instead return a reference to an array of the lines that were returned +from the command. =cut @@ -179,10 +179,6 @@ =over -=item B - -- returns the name of the host that you are accessing - =item B - returns the firmware version @@ -342,7 +338,7 @@ =cut -my $success = 'Success.'; +my $success = 'Success\\.'; my %COMMANDS = ( tftpd => { decode => 'all', expect => $success }, ver => { decode => 'all' }, @@ -371,12 +367,12 @@ my %ALIASES = ( bye => 'exit', restart => 'reboot', + Host => 'host', ); my %ACCESS = map { $_ => 1 } qw( firmware_version host_type - Host is_connected logged_in login_banner @@ -384,6 +380,7 @@ last_lines last_vals last_error + Decode ); sub AUTOLOAD @@ -431,8 +428,8 @@ my $self = shift; unless ( $self->SUPER::open(@_) ) { - $self->last_error("Couldn't connect to " . $self->Host . ": $!"); - return undef; + $self->last_error("Couldn't connect to " . $self->host . ": $!"); + return; } ## Get to login prompt @@ -440,9 +437,9 @@ -match => '/password: ?$/i', -errmode => "return", ) ) { - $self->last_error("problem connecting to host (" . $self->Host . "): " . + $self->last_error("problem connecting to host (" . $self->host . "): " . $self->lastline); - return undef; + return; } $self->parse_login_banner($self->lastline); @@ -468,7 +465,7 @@ my $self = shift; unless ($self->is_connected) { - $self->open or return undef; + $self->open or return; } my $password = shift; @@ -478,8 +475,8 @@ -match => $self->prompt, -errmode => "return", ) ) { - $self->last_error("login ($self->Host) failed: " . $self->lastline); - return undef; + $self->last_error("login ($self->host) failed: " . $self->lastline); + return; } $self->logged_in(1); @@ -510,9 +507,12 @@ my $banner = $self->login_banner; - my ($type, $ver) = $banner =~ - /Welcome to Trango Broadband Wireless (\S+)[\s-]+(.+)$/i; + my ($type, $sep1, $subtype, $sep2, $ver) = $banner =~ + /Welcome to Trango Broadband Wireless (\S+)([\s-]+)(\S+)([\s-]+)(.+)$/i; + $type .= $sep1 . $subtype; + $ver = $subtype . $sep2 . $ver; + $self->login_banner($banner); $self->host_type($type); $self->firmware_version($ver); @@ -541,7 +541,7 @@ unless (defined $new_pass) { $self->last_error("No new password"); - #return undef; + #return; } return $self->cmd(String => 'su password ' . @@ -576,19 +576,19 @@ if ($suid =~ /\D/) { $self->last_error("Invalid suid '$suid'"); - return undef; + return; } unless ($new_ip) { $self->last_error("no new_ip passed"); - return undef; + return; } unless ($new_subnet) { $self->last_error("no new_subnet passed"); - return undef; + return; } unless ($new_gateway) { $self->last_error("no new_gateway passed"); - return undef; + return; } # su ipconfig @@ -616,16 +616,16 @@ { my $self = shift; - my @lines = $self->cmd( String => 'sudb view', expect => $success ); + my $lines = $self->cmd( String => 'sudb view', expect => $success ) || []; - return undef unless @lines; + return unless @{ $lines }; unless ($PRIVATE{'Decode'}) { - return @lines; + return $lines; } my @sus; - foreach (@lines) { + foreach (@{ $lines }) { next unless $_; if (/^\[(\d+)\]\s+(\d+)\s+(\d+)\s+(\d+)\s+([0-9A-Fa-f\s]+)$/) { my %s = ( @@ -678,29 +678,29 @@ if ($suid =~ /\D/) { $self->last_error("Invalid suid '$suid'"); - return undef; + return; } unless (lc($type) eq 'reg' || lc($type) eq 'pr') { $self->last_error("Invalid type '$type'"); - return undef; + return; } if ($cir =~ /\D/) { $self->last_error("Invalid CIR '$cir'"); - return undef; + return; } if ($mir =~ /\D/) { $self->last_error("Invalid MIR '$mir'"); - return undef; + return; } my $new_mac = $mac; $new_mac =~ s/[^0-9A-Fa-f]//; unless (length $new_mac == 12) { $self->last_error("Invalid MAC '$mac'"); - return undef; + return; } $new_mac = join ' ', $new_mac =~ /../g; @@ -737,7 +737,7 @@ #if (lc($suid) ne 'all' || $suid =~ /\D/) { if ($suid =~ /\D/) { $self->last_error("Invalid suid '$suid'"); - return undef; + return; } return $self->cmd( String => 'sudb delete ' . $suid, expect => $success ); @@ -771,22 +771,22 @@ if ($suid =~ /\D/) { $self->last_error("Invalid suid '$suid'"); - return undef; + return; } if (lc($opt) eq 'cir' or lc($opt) eq 'mir') { if ($value =~ /\D/) { $self->last_error("Invalid $opt '$value'"); - return undef; + return; } } elsif (lc($opt) eq 'su2su') { if ($value =~ /[^0-9A-Za-f]/) { $self->last_error("Invalid MAC '$value'"); - return undef; + return; } } else { $self->last_error("Invalid option '$opt'"); - return undef; + return; } my $string = 'sudb modify ' . $suid . ' ' . $opt . ' ' . $value; @@ -813,7 +813,7 @@ if ($vals->{'Tftpd'} eq 'listen') { return $vals; } else { - return undef; + return; } } @@ -836,7 +836,7 @@ if (ref $vals eq 'HASH' && $vals->{'Tftpd'} eq 'disabled') { return $vals; } else { - return undef; + return; } } @@ -915,17 +915,17 @@ unless ($cfg{'String'}) { $self->last_error("No command passed"); - return undef; + return; } unless ($self->is_connected) { $self->last_error("Not connected"); - return undef; + return; } unless ($self->logged_in) { $self->last_error("Not logged in"); - return undef; + return; } @@ -976,11 +976,11 @@ if ($PRIVATE{'Decode'} && $cfg{'decode'}) { return $vals; } else { - return @lines; + return \@lines; } } else { $self->last_error("Error with command ($cfg{'String'}): $last"); - return undef; + return; } } @@ -994,6 +994,7 @@ my $key = ''; my $val = undef; + my @vals; my $in_key = 0; my $in_val = 1; @@ -1018,7 +1019,7 @@ $key =~ s/^\s+//; $key =~ s/\s+$//; - if (defined $val) { + if ($val) { $val =~ s/^\s+//; $val =~ s/\s+$//; } @@ -1030,11 +1031,13 @@ $key = $new . " " . $key; } - $last_key = $key; $conf{$key} = $val; + $last_key = $key; $key = ''; - $val = ''; - } + } elsif ($val) { + push @vals, $val; + } + $val = ''; } elsif ($c eq ']') { $in_val = 1; @@ -1050,7 +1053,20 @@ } } + unless ($key) { + push @vals, $val; + } + + if (@vals == 1) { + $val = $vals[0]; + } elsif (@vals) { + $val= \@vals; + } else { + $val = undef; + } + if (%conf) { + $conf{_pre} = $val if $val; return \%conf; } else { return $val; @@ -1142,7 +1158,7 @@ return \@decoded; } else { # XXX we should have a way to set last error, not sure why we don't - return undef; + return; } }