[BACK]Return to Trango.pm CVS log [TXT][DIR] Up to [local] / trango / Net-Telnet-Trango / lib / Net / Telnet

File: [local] / trango / Net-Telnet-Trango / lib / Net / Telnet / Trango.pm (download)

Revision 1.1, Thu Dec 29 18:41:17 2005 UTC (18 years, 8 months ago) by andrew
Branch: MAIN

move rename to Net::Telnet::Trango and move into its own file.

package Net::Telnet::Trango;
use base 'Net::Telnet';

my %PRIVATE = (
  is_connected => 0,
  logged_in => 0,
);


sub AUTOLOAD 
{
  my $self = shift;

  my ($method) = (our $AUTOLOAD) =~ /^.*::(\w+)$/
    or die "Weird: $AUTOLOAD";

  my $success = 'Success.';
  my %MEMBERS = (
    ver     => {},
    sysinfo => { waitfor => $success },
    tftpd   => { waitfor => $success },
  );

  my %ACCESS = map { $_ => 1 } qw( 
    firmware_version 
    host_type 
    Host 
    is_connected 
    logged_in
    Timeout
  );

  if (exists $MEMBERS{$method}) {
    return $self->cmd($method, $MEMBERS{$method}{waitfor});
  }

  if (exists $ACCESS{$method}) {
    my $var = shift || $PRIVATE{$method};
    $PRIVATE{$method} = $var;
    return $var;
  }

  $method = "SUPER::$method";
  return $self->$method(@_);
}

sub new 
{
  my $class = shift;
  my $args = shift || {};

  $args->{'Timeout'} ||= 5;
  $args->{'Prompt'}  ||= '/#> *$/';

  foreach my $key (keys %{ $args }) {
    $PRIVATE{$key} = $args->{$key};
  }

  my $self = $class->SUPER::new(%{ $args });
  bless $self;

  #bless $self, $package;
  return $self;
}

sub connect
{
  my $self = shift;

  unless ( $self->open( 
      Host => $self->Host,
      Errmode => 'return',
  ) ) {
    $! = "Couldn't connect to $self->Host.  Connection timed out.";
    return undef, undef;
  }
  #$self->dump_log('dump.log');

  ## Login to remote host.
  unless ($self->waitfor(
    -match => '/password: ?$/i',
    -errmode => "return",
  ) ) {
    $! = "problem connecting to host ($self->Host): " . $self->lastline;
    return undef;
  }

  $self->login_banner($self->lastline);

  $self->is_connected(1);

  return ($self->host_type, $self->firmware_version);
}

sub login
{
  my $self = shift;

  my $password = shift;

  $self->print($password);
  unless ($self->waitfor(
    -match => $self->prompt,
    -errmode => "return",
  ) ) {
    $! = "login ($self->Host) failed: " . $self->lastline;
    return undef;
  }

  $self->logged_in(1);

  return $self->logged_in;
}

sub login_banner
{
  my $self = shift;

  my $banner = shift || $self->login_banner;

  my ($type, $ver) = $banner =~ 
    /Welcome to Trango Broadband Wireless (\S+)[\s-]+(.+)$/i;

  $self->host_type($type);
  $self->firmware_version($ver); 

  return $banner;
}

sub reboot
{
  my $self = shift;

  $self->print("reboot\n");
  $self->getline;

  return 1;
}

sub exit
{
  my $self = shift;

  $self->print("exit\n");
  $self->getline;

  return 1;
}

sub enable_tftpd
{
  my $self = shift;

  my $vals = $self->cmd('tftpd on', 'Success.');

  if ($vals->{'Tftpd'} eq 'listen') {
    return $vals;
  } else {
    return undef;
  }
}

sub updateflash
{
  my $self = shift;

  my $old = shift;
  my $new = shift;

  return undef unless $new;

  return $self->cmd("updateflash mainimage $old $new", 'Success.', 90);
}

sub cmd
{
  my $self = shift;

  my $string = shift;
  my $expect_last = shift;
  my $timeout = shift || $self->Timeout;

  unless (defined $string) {
    $! = "No command passed";
    return undef;
  }

  unless ($self->is_connected) {
    $! = "Not connected";
    return undef;
  }

  unless ($self->logged_in) {
    $! = "Not logged in";
    return undef;
  }

  my @lines = $self->SUPER::cmd(String => $string, Timeout => $timeout);

  my $vals = _decode_lines(@lines);

  unless ($expect_last) {
    return $vals;
  }

  my $last = $self->lastline;

  if ($last =~ /$expect_last$/) {
    return $vals;
  } else {
    warn "Error with command ($string): $last";
    return undef;
  }
}

sub _decode_lines
{
  my @lines = @_;

  my %conf;

  my $key = '';
  my $val = '';
  my $in_key = 0;
  my $in_val = 0;

  foreach my $line (@lines) {
    my @chars = split //, $line;

    my $last_key = '';
    foreach my $c (@chars) {

      if ($c eq '[' || $c eq "\r" || $c eq "\n") {
        if ($c eq '[') {
          $in_key = 1;
          $in_val = 0;
        } else {
          $in_key = 0;
          $in_val = 0;
        }

        if ($key) {
          $key =~ s/^\s+//;
          $key =~ s/\s+$//;

          $val =~ s/^\s+//;
          $val =~ s/\s+$//;

          if ($key eq 'Checksum' && $last_key) {
            # Special case for these bastids.
            my $new = $last_key;
            $new =~ s/\s+\S+$//;
            $key = $new . " " . $key;
          }

          $last_key = $key;
          $conf{$key} = $val;
          $key = '';
          $val = '';
        }

      } elsif ($c eq ']') {
        $in_val = 1;
        $in_key = 0;
        $c = shift @chars;

      } elsif ($in_key) {
        $key .= $c;

      } elsif ($in_val) {
        $val .= $c;
      }
    }
  }
  #print Dump \%conf;

  if (%conf) {
    return \%conf;
  } else {
    return \@lines;
  }
}