===================================================================
RCS file: /cvs/trango/Net-Telnet-Trango/lib/Net/Telnet/Trango.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- trango/Net-Telnet-Trango/lib/Net/Telnet/Trango.pm	2005/12/29 18:41:17	1.1
+++ trango/Net-Telnet-Trango/lib/Net/Telnet/Trango.pm	2005/12/30 01:02:41	1.2
@@ -1,12 +1,249 @@
 package Net::Telnet::Trango;
+# $RedRiver$
+use strict;
+use warnings;
 use base 'Net::Telnet';
 
+=pod
+
+=head1 NAME
+
+Net::Telnet::Trango - Perl extension for accessing the Trango telnet interface
+
+=head1 SYNOPSIS
+
+  use Net::Telnet::Trango;
+  my $t = new Net::Telnet::Trango ({
+    Host    => $fox,
+    Timeout => 5,
+  });
+  
+  my ($type, $version) = $t->open;
+  
+  unless (defined $type && defined $version) {
+    die "Error connecting: $!";
+  }
+
+  $t->login('password') or die "Couldn't log in: $!";
+  
+  # Do whatever
+  
+  $t->exit;
+  $t->close;
+
+=head1 DESCRIPTION
+
+Perl access to the telnet interface on Trango Foxes, SUs and APs.
+
+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.
+
+=head2 EXPORT
+
+None
+
+=cut
+
+our $VERSION = '0.01';
+
 my %PRIVATE = (
   is_connected => 0,
   logged_in => 0,
 );
 
+=pod
 
+=head1 METHODS
+
+=head2 ACCESSORS
+
+=over
+
+=item Host
+
+returns the name of the host that you are accessing
+
+=item firmware_version
+
+returns the firmware version on the trango if available otherwise undef.  
+Available after a successful open()
+This is usually only set internally
+
+=item host_type
+
+returns the type of host from the login banner for example M5830S or M5300S.  
+Available after a successful open()
+This is usually only set internally
+
+=item is_connected
+
+returns 1 after a successful open() otherwise undef
+This is usually only set internally
+
+=item logged_in
+
+returns 1 after a successful login() 0 if it failed and undef if 
+login() was never called
+This is usually only set internally
+
+=item login_banner
+
+returns the banner that is displayed when first connected at login.  Only set after a successful open()
+
+This is usually only set internally
+
+=item last_lines
+
+returns the output from the last cmd() that was run as an array ref
+This is usually only set internally
+
+=back
+
+=head2 ALIASES
+
+=over
+
+=item bye
+
+alias of exit()
+
+=item reboot
+
+alias of restart()
+
+=back
+
+=head2 COMMANDS
+
+Most of these are just shortcuts to C<cmd(String =E<gt> METHOD)>, as such they accept the same options as C<cmd()>.  Specifically they take a named paramater "args", for example: 
+C<tftpd(args =E<gt> 'on')> would enable tftpd
+
+=over
+
+=item tftpd
+
+Returns a hash ref of the decoded output from the command. 
+
+Also see enable_tftpd() and disable_tftpd() as those check for correct output
+
+=item ver
+
+Returns a hash ref of the decoded output from the command. 
+
+=item sysinfo
+
+Returns a hash ref of the decoded output from the command. 
+
+=item exit
+
+exits the command session with the trango and closes the connection
+
+=item reboot
+
+reboots the trango and closes the connection
+
+=cut
+
+#  _password <new password> <new password>
+#  ? [command]
+#  apsearch <secs> <ch#> <h|v> [<ch#> <h|v>]...
+#  arp -bcast <on|off>
+#  bcastscant <all|suid> <ch#> <h|v> [<ch#> <h|v> ...
+#  bye
+#  cf2cf ap [default|<size>]
+#  date
+#  date <month> <day> <year>
+#  freq scantable
+#  freq channeltable
+#  freq writescan [<ch#> <h|v>]
+#  freq writechannel [<ch#> <freq>] ...
+#  freq <ch #> <h|v>
+#  help [command]
+#  heater [<on temp> <off temp>]
+#  ipconfig [<new ip> <new subnet mask> <new gateway>]
+#  log [<# of entries, 1..179>]
+#  log <sum> <# of entries, 1..179>
+#  logout
+#  opmode [ap [y]]
+#  password
+#  ping <ip addr>
+#  polar <h|v>
+#  power <setism|setunii> <max|min|<dBm>>
+#  reboot
+#  restart
+#  remarks [<str>]
+#  rfrxthreshold [<ism|unii> <-90|-85|-80|-75|-70|-65>]
+#  rfrxth [<ism|unii> <-90|-85|-80|-75|-70|-65>]
+#  sysinfo
+#  set suid <id>
+#  set apid <id>
+#  set baseid <id>
+#  set defaultopmode [<ap|su> <min,0..10>]
+#  set defaultopmode off
+#  set snmpcomm [<read | write | trap (id or setall)> <str>]
+#  set mir [on|off]
+#  set mir threshold <kbps>
+#  set rssitarget [<ism|unii> <dBm>]
+#  set serviceradius [<ism | unii> <miles>]
+#  ssrssi <ch #> <h|v>
+#  su [<suid>|all]
+#  su changechannel <all|suid> <ch#> <h|v>
+#  su ipconfig <suid> <new ip> <new subnet> <new gateway>
+#  su [live|poweroff|priority]
+#  su <ping|info|status> <suid>
+#  su powerleveling <all|suid>
+#  su reboot <all|suid>
+#  su restart <all|suid>
+#  su testrflink <all|suid> [r]
+#  su testrflink <setlen> [64..1600]
+#  su testrflink <aptx> [20..100]
+#  su sw <suid|all> <sw #> <on|off>
+#  sudb [dload | view]
+#  sudb add <suid> pr <cir,kbps> <mir,kbps> <device id,hex>
+#  sudb add <suid> reg <cir,kbps> <mir,kbps> <device id,hex>
+#  sudb delete <all|<suid>>
+#  sudb modify <suid> <cir|mir> <kbps>
+#  sudb modify <suid> <su2su> <group id,hex>
+#  sudb view
+#  sulog [lastmins | sampleperiod <1..60>]
+#  sulog [<# of entry,1..18>]
+#  survey <ism|unii> <time, sec> <h|v>
+#  sw [<sw #> <on|off>]
+#  temp
+#  tftpd [on|off]
+#  time
+#  time <hour> <min> <sec>
+#  save <mainimage|fpgaimage> <current chksum> <new chksum>
+#  save <systemsetting|sudb>
+#  updateflash <mainimage|fpgaimage> <current chksum> <new chksum>
+#  updateflash <systemsetting|sudb>
+
+
+my $success = 'Success.';
+my %COMMANDS = (
+  tftpd       => { decode => 1, expect => $success },
+  ver         => { decode => 1 },
+  sysinfo     => { decode => 1, expect => $success },
+  updateflash => { decode => 1, expect => $success },
+  'exit'      => { Prompt => '//', cmd_disconnects => 1 },
+  reboot      => { Prompt => '//', cmd_disconnects => 1 },
+);
+
+my %ALIASES = (
+  bye     => 'exit',
+  restart => 'reboot',
+);
+
+my %ACCESS = map { $_ => 1 } qw( 
+  firmware_version 
+  host_type 
+  Host 
+  is_connected 
+  logged_in
+  login_banner
+  Timeout
+  last_lines
+);
+
 sub AUTOLOAD 
 {
   my $self = shift;
@@ -14,36 +251,32 @@
   my ($method) = (our $AUTOLOAD) =~ /^.*::(\w+)$/
     or die "Weird: $AUTOLOAD";
 
-  my $success = 'Success.';
-  my %MEMBERS = (
-    ver     => {},
-    sysinfo => { waitfor => $success },
-    tftpd   => { waitfor => $success },
-  );
+  if (exists $ALIASES{$method}) {
+    $method = $ALIASES{$method};
+    return $self->$method(@_);
+  }
 
-  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 $COMMANDS{$method}) {
+    $COMMANDS{$method}{'String'} ||= $method;
+    return $self->cmd(%{ $COMMANDS{$method} }, @_);
   }
 
   if (exists $ACCESS{$method}) {
-    my $var = shift || $PRIVATE{$method};
-    $PRIVATE{$method} = $var;
-    return $var;
+    my $prev = $PRIVATE{$method};
+    ($PRIVATE{$method}) = @_ if @_;
+    return $prev;
   }
 
   $method = "SUPER::$method";
   return $self->$method(@_);
 }
 
+=pod
+
+=item new
+
+=cut
+
 sub new 
 {
   my $class = shift;
@@ -57,22 +290,27 @@
   }
 
   my $self = $class->SUPER::new(%{ $args });
-  bless $self;
+  bless $self if ref $self;
 
-  #bless $self, $package;
   return $self;
 }
 
-sub connect
+=pod
+
+=item open
+
+=cut
+
+sub open
 {
   my $self = shift;
 
-  unless ( $self->open( 
-      Host => $self->Host,
-      Errmode => 'return',
+  unless ( $self->SUPER::open( 
+      #Host => $self->Host,
+      #Errmode => 'return',
   ) ) {
-    $! = "Couldn't connect to $self->Host.  Connection timed out.";
-    return undef, undef;
+    #$! = "Couldn't connect to " . $self->Host . ":  $!";
+    return undef;
   }
   #$self->dump_log('dump.log');
 
@@ -81,21 +319,32 @@
     -match => '/password: ?$/i',
     -errmode => "return",
   ) ) {
-    $! = "problem connecting to host ($self->Host): " . $self->lastline;
+  #$! = "problem connecting to host (" . $self->Host . "): " . 
+  #    $self->lastline;
     return undef;
   }
 
-  $self->login_banner($self->lastline);
+  $self->parse_login_banner($self->lastline);
 
   $self->is_connected(1);
 
-  return ($self->host_type, $self->firmware_version);
+  return $self->is_connected;
 }
 
+=pod
+
+=item login
+
+=cut
+
 sub login
 {
   my $self = shift;
 
+  unless ($self->is_connected) {
+    $self->open or return undef;
+  }
+
   my $password = shift;
 
   $self->print($password);
@@ -103,7 +352,7 @@
     -match => $self->prompt,
     -errmode => "return",
   ) ) {
-    $! = "login ($self->Host) failed: " . $self->lastline;
+    #$! = "login ($self->Host) failed: " . $self->lastline;
     return undef;
   }
 
@@ -112,46 +361,43 @@
   return $self->logged_in;
 }
 
-sub login_banner
+=pod
+
+=item parse_login_banner
+
+=cut
+
+sub parse_login_banner
 {
   my $self = shift;
 
-  my $banner = shift || $self->login_banner;
+  if (@_) {
+    $self->login_banner(@_);
+  }
 
+  my $banner = $self->login_banner;
+
   my ($type, $ver) = $banner =~ 
     /Welcome to Trango Broadband Wireless (\S+)[\s-]+(.+)$/i;
 
+  $self->login_banner($banner);
   $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;
+=pod
 
-  $self->print("exit\n");
-  $self->getline;
+=item enable_tftpd
 
-  return 1;
-}
+=cut
 
 sub enable_tftpd
 {
   my $self = shift;
 
-  my $vals = $self->cmd('tftpd on', 'Success.');
+  my $vals = $self->tftpd( args => 'on' );
 
   if ($vals->{'Tftpd'} eq 'listen') {
     return $vals;
@@ -160,59 +406,117 @@
   }
 }
 
-sub updateflash
+=pod
+
+=item disable_tftpd
+
+=cut
+
+sub disable_tftpd
 {
   my $self = shift;
 
-  my $old = shift;
-  my $new = shift;
+  my $vals = $self->tftpd( args => 'off' );
 
-  return undef unless $new;
-
-  return $self->cmd("updateflash mainimage $old $new", 'Success.', 90);
+  if (ref $vals eq 'HASH' && $vals->{'Tftpd'} eq 'disabled') {
+    return $vals;
+  } else {
+    return undef;
+  }
 }
 
+=pod
+
+=item cmd
+
+=cut
+
 sub cmd
 {
   my $self = shift;
 
-  my $string = shift;
-  my $expect_last = shift;
-  my $timeout = shift || $self->Timeout;
+  my @valid_net_telnet_opts = qw(
+    String
+    Output
+    Cmd_remove_mode
+    Errmode
+    Input_record_separator
+    Ors
+    Output_record_separator
+    Prompt
+    Rs
+    Timeout
+  );
 
-  unless (defined $string) {
-    $! = "No command passed";
+  my %cfg;
+  if (@_ == 2) {
+    $cfg{'String'} = shift;
+  } elsif (@_ > 2) {
+    %cfg = @_;
+  }
+
+  $cfg{'Timeout'} ||= $self->Timeout;
+
+  unless ($cfg{'String'}) {
+    #$! = "No command passed";
+    warn "No command passed\n";
     return undef;
   }
 
   unless ($self->is_connected) {
-    $! = "Not connected";
+    #$! = "Not connected";
+    warn "Not connected\n";
     return undef;
   }
 
   unless ($self->logged_in) {
-    $! = "Not logged in";
+    #$! = "Not logged in";
+    warn "Not logged in\n";
     return undef;
   }
 
-  my @lines = $self->SUPER::cmd(String => $string, Timeout => $timeout);
 
-  my $vals = _decode_lines(@lines);
+  my %cmd;
+  foreach (@valid_net_telnet_opts) {
+    if (exists $cfg{$_}) {
+      $cmd{$_} = $cfg{$_};
+    }
+  }
+  if ($cfg{'args'}) {
+    $cmd{'String'} .= ' ' . $cfg{'args'};
+  }
+  my @lines = $self->SUPER::cmd(%cmd);
 
-  unless ($expect_last) {
-    return $vals;
+  $self->last_lines(\@lines);
+
+  my $vals = 1;
+  if ($cfg{'decode'}) {
+    $vals = _decode_lines(@lines);
   }
 
+
   my $last = $self->lastline;
 
-  if ($last =~ /$expect_last$/) {
-    return $vals;
+  if ((not $cfg{'expect'}) || $last =~ /$cfg{'expect'}$/) {
+    if ($cfg{'cmd_disconnects'}) {
+      $self->logged_in(0);
+      $self->close;
+      $self->is_connected(0);
+    }
+
+    if ($cfg{'decode'}) {
+      return $vals;
+    } else {
+      return @lines;
+    }
   } else {
-    warn "Error with command ($string): $last";
+    #$! = "Error with command ($cfg{'string'}): $last";
     return undef;
   }
 }
 
+#=item _decode_lines
+
 sub _decode_lines
 {
   my @lines = @_;
@@ -272,7 +576,6 @@
       }
     }
   }
-  #print Dump \%conf;
 
   if (%conf) {
     return \%conf;
@@ -280,3 +583,37 @@
     return \@lines;
   }
 }
+
+1;
+__END__
+
+=back
+
+=head1 SEE ALSO
+
+If you have a web site set up for your module, mention it here.
+
+Trango Documentation - http://www.trangobroadband.com/support/product_docs.htm
+
+L<Net::Telnet>
+
+=head1 TODO
+
+There are still a lot of commands that are not accessed directly.  If you call them (as cmd("command + args") or whatever) and it works, please send me examples that work and I will try to get it incorporated into the next version of the script.
+
+I also want to be able to parse the different types of output from commands like su, sudb all and anything else that would be better available as a perl datastructure.
+
+=head1 AUTHOR
+
+Andrew Fresh E<lt>andrew@rraz.netE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2005 by Andrew Fresh
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.8.7 or,
+at your option, any later version of Perl 5 you may have available.
+
+
+=cut