Annotation of trango/Net-Telnet-Trango/lib/Net/Telnet/Trango.pm, Revision 1.8
1.1 andrew 1: package Net::Telnet::Trango;
1.8 ! andrew 2: # $RedRiver: Trango.pm,v 1.7 2006/06/28 22:33:18 andrew Exp $
1.2 andrew 3: use strict;
4: use warnings;
1.1 andrew 5: use base 'Net::Telnet';
6:
1.2 andrew 7: =pod
8:
9: =head1 NAME
10:
11: Net::Telnet::Trango - Perl extension for accessing the Trango telnet interface
12:
13: =head1 SYNOPSIS
14:
15: use Net::Telnet::Trango;
1.3 andrew 16: my $t = new Net::Telnet::Trango ( Timeout => 5 );
1.2 andrew 17:
1.6 andrew 18: $t->open( Host => $fox ) or die "Error connecting: $!";
1.2 andrew 19:
20: $t->login('password') or die "Couldn't log in: $!";
21:
22: # Do whatever
23:
24: $t->exit;
25: $t->close;
26:
27: =head1 DESCRIPTION
28:
29: Perl access to the telnet interface on Trango Foxes, SUs and APs.
30:
31: 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.
32:
33: =head2 EXPORT
34:
35: None
36:
37: =cut
38:
39: our $VERSION = '0.01';
40:
1.1 andrew 41: my %PRIVATE = (
42: is_connected => 0,
43: logged_in => 0,
44: );
45:
1.2 andrew 46: =pod
47:
1.4 andrew 48: =item new
49:
50: Same as new from L<Net::Telnet> but has defaults for the trango 'Prompt'
51:
52: =cut
53:
54: sub new
55: {
56: my $class = shift;
57:
58: my %args;
59: if (@_ == 1) {
60: $args{'Host'} = shift;
61: } else {
62: %args = @_;
63: }
64:
65: $args{'Prompt'} ||= '/#> *$/';
66:
67: foreach my $key (keys %args) {
68: $PRIVATE{$key} = $args{$key};
69: }
70:
71: my $self = $class->SUPER::new(%args);
72: bless $self if ref $self;
73:
74: return $self;
75: }
76:
77: # _password <new password> <new password>
78: # ? [command]
79: # apsearch <secs> <ch#> <h|v> [<ch#> <h|v>]...
80: # arp -bcast <on|off>
81: # bcastscant <all|suid> <ch#> <h|v> [<ch#> <h|v> ...
82: # bye
83: # cf2cf ap [default|<size>]
84: # date
85: # date <month> <day> <year>
86: # freq scantable
87: # freq channeltable
88: # freq writescan [<ch#> <h|v>]
89: # freq writechannel [<ch#> <freq>] ...
90: # freq <ch #> <h|v>
91: # help [command]
92: # heater [<on temp> <off temp>]
93: # ipconfig [<new ip> <new subnet mask> <new gateway>]
94: # log [<# of entries, 1..179>]
95: # log <sum> <# of entries, 1..179>
96: # logout
97: # opmode [ap [y]]
98: # password
99: # ping <ip addr>
100: # polar <h|v>
101: # power <setism|setunii> <max|min|<dBm>>
102: # reboot
103: # restart
104: # remarks [<str>]
105: # rfrxthreshold [<ism|unii> <-90|-85|-80|-75|-70|-65>]
106: # rfrxth [<ism|unii> <-90|-85|-80|-75|-70|-65>]
107: # sysinfo
108: # set suid <id>
109: # set apid <id>
110: # set baseid <id>
111: # set defaultopmode [<ap|su> <min,0..10>]
112: # set defaultopmode off
113: # set snmpcomm [<read | write | trap (id or setall)> <str>]
114: # set mir [on|off]
115: # set mir threshold <kbps>
116: # set rssitarget [<ism|unii> <dBm>]
117: # set serviceradius [<ism | unii> <miles>]
118: # ssrssi <ch #> <h|v>
119: # su [<suid>|all]
120: # su changechannel <all|suid> <ch#> <h|v>
121: # su ipconfig <suid> <new ip> <new subnet> <new gateway>
122: # su [live|poweroff|priority]
123: # su <ping|info|status> <suid>
124: # su powerleveling <all|suid>
125: # su reboot <all|suid>
126: # su restart <all|suid>
127: # su testrflink <all|suid> [r]
128: # su testrflink <setlen> [64..1600]
129: # su testrflink <aptx> [20..100]
130: # su sw <suid|all> <sw #> <on|off>
131: # sudb [dload | view]
132: # sudb add <suid> pr <cir,kbps> <mir,kbps> <device id,hex>
133: # sudb add <suid> reg <cir,kbps> <mir,kbps> <device id,hex>
134: # sudb delete <all|<suid>>
135: # sudb modify <suid> <cir|mir> <kbps>
136: # sudb modify <suid> <su2su> <group id,hex>
137: # sudb view
138: # sulog [lastmins | sampleperiod <1..60>]
139: # sulog [<# of entry,1..18>]
140: # survey <ism|unii> <time, sec> <h|v>
141: # sw [<sw #> <on|off>]
142: # temp
143: # tftpd [on|off]
144: # time
145: # time <hour> <min> <sec>
146: # save <mainimage|fpgaimage> <current chksum> <new chksum>
147: # save <systemsetting|sudb>
148: # updateflash <mainimage|fpgaimage> <current chksum> <new chksum>
149: # updateflash <systemsetting|sudb>
150:
151: =pod
152:
1.2 andrew 153: =head1 METHODS
154:
155: =head2 ACCESSORS
156:
157: =over
158:
159: =item Host
160:
161: returns the name of the host that you are accessing
162:
163: =item firmware_version
164:
165: returns the firmware version on the trango if available otherwise undef.
166: Available after a successful open()
167: This is usually only set internally
168:
169: =item host_type
170:
171: returns the type of host from the login banner for example M5830S or M5300S.
172: Available after a successful open()
173: This is usually only set internally
174:
175: =item is_connected
176:
177: returns 1 after a successful open() otherwise undef
178: This is usually only set internally
179:
180: =item logged_in
181:
182: returns 1 after a successful login() 0 if it failed and undef if
183: login() was never called
184: This is usually only set internally
185:
186: =item login_banner
187:
188: returns the banner that is displayed when first connected at login. Only set after a successful open()
189:
190: This is usually only set internally
191:
192: =item last_lines
193:
194: returns the output from the last cmd() that was run as an array ref
195: This is usually only set internally
196:
197: =back
198:
199: =head2 ALIASES
200:
201: =over
202:
203: =item bye
204:
205: alias of exit()
206:
1.3 andrew 207: =item restart
1.2 andrew 208:
1.3 andrew 209: alias of reboot()
1.2 andrew 210:
211: =back
212:
213: =head2 COMMANDS
214:
215: 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:
216: C<tftpd(args =E<gt> 'on')> would enable tftpd
217:
218: =over
219:
220: =item tftpd
221:
222: Returns a hash ref of the decoded output from the command.
223:
224: Also see enable_tftpd() and disable_tftpd() as those check for correct output
225:
226: =item ver
227:
228: Returns a hash ref of the decoded output from the command.
229:
230: =item sysinfo
231:
232: Returns a hash ref of the decoded output from the command.
233:
234: =item exit
235:
236: exits the command session with the trango and closes the connection
237:
238: =item reboot
239:
240: reboots the trango and closes the connection
241:
1.4 andrew 242: =item sulog
243:
244: returns an array ref of hashes containing each log line.
245:
1.8 ! andrew 246: =item save_sudb
! 247:
! 248: returns true on success, undef on failure
! 249:
1.2 andrew 250: =cut
251:
252:
253: my $success = 'Success.';
254: my %COMMANDS = (
1.4 andrew 255: tftpd => { decode => 'all', expect => $success },
256: ver => { decode => 'all' },
257: sysinfo => { decode => 'all', expect => $success },
258: updateflash => { decode => 'all', expect => $success },
259: sulog => { decode => 'sulog', expect => $success },
1.5 andrew 260: 'exit' => { no_prompt => 1, cmd_disconnects => 1 },
261: reboot => { no_prompt => 1, cmd_disconnects => 1 },
1.8 ! andrew 262: save_sudb => { String => "save sudb", expect => $success },
1.3 andrew 263: #su password???
264: #_bootloader
265: #temp
266: #heater
1.2 andrew 267: );
268:
269: my %ALIASES = (
270: bye => 'exit',
271: restart => 'reboot',
272: );
273:
274: my %ACCESS = map { $_ => 1 } qw(
275: firmware_version
276: host_type
277: Host
278: is_connected
279: logged_in
280: login_banner
281: Timeout
282: last_lines
1.5 andrew 283: last_vals
1.2 andrew 284: );
1.1 andrew 285:
286: sub AUTOLOAD
287: {
288: my $self = shift;
289:
290: my ($method) = (our $AUTOLOAD) =~ /^.*::(\w+)$/
291: or die "Weird: $AUTOLOAD";
292:
1.2 andrew 293: if (exists $ALIASES{$method}) {
294: $method = $ALIASES{$method};
295: return $self->$method(@_);
296: }
1.1 andrew 297:
1.2 andrew 298: if (exists $COMMANDS{$method}) {
1.3 andrew 299: $method = shift if (@_ == 1);
1.2 andrew 300: $COMMANDS{$method}{'String'} ||= $method;
301: return $self->cmd(%{ $COMMANDS{$method} }, @_);
1.1 andrew 302: }
303:
304: if (exists $ACCESS{$method}) {
1.2 andrew 305: my $prev = $PRIVATE{$method};
306: ($PRIVATE{$method}) = @_ if @_;
307: return $prev;
1.1 andrew 308: }
309:
310: $method = "SUPER::$method";
311: return $self->$method(@_);
312: }
313:
1.2 andrew 314: =pod
315:
316: =item open
317:
1.3 andrew 318: Calls Net::Telnet::open() then makes sure you get a password prompt so you are ready to login() and parses the login banner so you can get host_type() and firmware_version()
319:
1.2 andrew 320: =cut
321:
322: sub open
1.1 andrew 323: {
324: my $self = shift;
325:
1.3 andrew 326: unless ( $self->SUPER::open(@_) ) {
1.2 andrew 327: #$! = "Couldn't connect to " . $self->Host . ": $!";
328: return undef;
1.1 andrew 329: }
330:
1.3 andrew 331: ## Get to login prompt
1.1 andrew 332: unless ($self->waitfor(
1.3 andrew 333: -match => '/password: ?$/i',
334: -errmode => "return",
335: ) ) {
336: #$! = "problem connecting to host (" . $self->Host . "): " .
337: # $self->lastline;
1.1 andrew 338: return undef;
339: }
340:
1.2 andrew 341: $self->parse_login_banner($self->lastline);
1.1 andrew 342:
343: $self->is_connected(1);
344:
1.2 andrew 345: return $self->is_connected;
1.1 andrew 346: }
347:
1.2 andrew 348: =pod
349:
350: =item login
351:
1.3 andrew 352: Calls open() if not already connected, then sends the password and sets logged_in() if successful
353:
1.2 andrew 354: =cut
355:
1.1 andrew 356: sub login
357: {
358: my $self = shift;
359:
1.2 andrew 360: unless ($self->is_connected) {
361: $self->open or return undef;
362: }
363:
1.1 andrew 364: my $password = shift;
365:
366: $self->print($password);
367: unless ($self->waitfor(
368: -match => $self->prompt,
369: -errmode => "return",
370: ) ) {
1.2 andrew 371: #$! = "login ($self->Host) failed: " . $self->lastline;
1.1 andrew 372: return undef;
373: }
374:
375: $self->logged_in(1);
376:
377: return $self->logged_in;
378: }
379:
1.2 andrew 380: =pod
381:
382: =item parse_login_banner
383:
1.3 andrew 384: Takes a login banner (what you get when you first connect to the Trango) or reads what is already in login_banner() then parses it and sets host_type() and firmware_version() as well as login_banner()
385:
1.2 andrew 386: =cut
387:
388: sub parse_login_banner
1.1 andrew 389: {
390: my $self = shift;
391:
1.2 andrew 392: if (@_) {
393: $self->login_banner(@_);
394: }
395:
396: my $banner = $self->login_banner;
1.1 andrew 397:
398: my ($type, $ver) = $banner =~
399: /Welcome to Trango Broadband Wireless (\S+)[\s-]+(.+)$/i;
400:
1.2 andrew 401: $self->login_banner($banner);
1.1 andrew 402: $self->host_type($type);
403: $self->firmware_version($ver);
404:
1.2 andrew 405: return 1;
1.1 andrew 406: }
407:
1.2 andrew 408: =pod
409:
1.5 andrew 410: =item su_password
411:
412: C<su_password('all'|suid, 'new_password')>
413:
414: =cut
415:
416: sub su_password
417: {
418: my $self = shift;
419: my $su = shift || '!';
420: my $new_pass = shift || '';
421:
422: unless (defined $su) {
423: warn "No su passed!"
424: #return undef;
425: }
426:
427: unless (defined $new_pass) {
428: warn "No new password!"
429: #return undef;
430: }
431:
432: return $self->cmd(String => 'su password ' .
433: $su . ' ' .
434: $new_pass . ' ' .
435: $new_pass,
436: expect => $success,
437: );
438: }
439:
440:
441: =pod
442:
443: =item sudb_view
444:
445: returns a reference to an array of hashes each containing:
446:
447: suid
448: type
449: cir
450: mir
451: mac
452:
453: =cut
454:
455: sub sudb_view
456: {
457: my $self = shift;
458:
459: my @lines = $self->cmd( String => 'sudb view', expect => $success );
460:
461: return undef unless @lines;
462:
463: my @sus;
464: foreach (@lines) {
1.6 andrew 465: if (/^\[(\d+)\]\s+(\d+)\s+(\d+)\s+(\d+)\s+([0-9A-Fa-f\s]+)$/) {
1.5 andrew 466: my %s = (
467: suid => $1,
468: type => $2,
469: cir => $3,
470: mir => $4,
471: mac => $5,
472: );
1.6 andrew 473:
474: $s{'mac'} =~ s/\s//g;
475: $s{'mac'} = uc($s{'mac'});
476:
1.5 andrew 477: push @sus, \%s;
478: }
479: }
480:
481: return \@sus;
1.6 andrew 482: }
483:
484: =pod
485:
486: =item sudb_add
487:
488: Takes the following paramaters
489:
490: suid : numeric,
491: type : (reg|pr)
492: cir : numeric,
493: mir : numeric,
494: mac : Almost any format, it will be reformatted,
495:
496: and returns true on success or undef otherwise.
497:
1.8 ! andrew 498: You should save_sudb() after calling this, or your changes will be lost
1.6 andrew 499: when the AP is rebooted.
500:
501: =cut
502:
503: sub sudb_add
504: {
505: my $self = shift;
506: my $suid = shift;
507: my $type = shift;
508: my $cir = shift;
509: my $mir = shift;
510: my $mac = shift;
511:
512: if ($suid =~ /\D/) {
513: return undef;
514: }
515:
516: unless (lc($type) eq 'reg' || lc($type) eq 'pr') {
517: warn "Invalid type '$type'!";
518: return undef;
519: }
520:
521: if ($cir =~ /\D/) {
522: warn "Invalid CIR '$cir'!";
523: return undef;
524: }
525:
526: if ($mir =~ /\D/) {
527: warn "Invalid MIR '$mir'!";
528: return undef;
529: }
530:
531: my $new_mac = $mac;
532: $new_mac =~ s/[^0-9A-Fa-f]//;
533: unless (length $new_mac == 12) {
534: warn "Invalid MAC '$mac'!";
535: return undef;
536: }
537: $new_mac = join ' ', $new_mac =~ /../g;
538:
539: my $string = 'sudb add ' .
540: $suid . ' ' .
541: $type . ' ' .
542: $cir . ' ' .
543: $mir . ' ' .
544: $new_mac;
545:
546:
547: return $self->cmd( String => $string, expect => $success );
548: }
549:
550: =pod
551:
552: =item sudb_delete
553:
554: Takes either 'all' or the suid of the su to delete
555: and returns true on success or undef otherwise.
556:
1.8 ! andrew 557: You should save_sudb() after calling this, or your changes will be lost
1.6 andrew 558: when the AP is rebooted.
559:
560: =cut
561:
562: sub sudb_delete
563: {
564: my $self = shift;
565: my $suid = shift;
566:
1.7 andrew 567: if (lc($suid) ne 'all' || $suid =~ /\D/) {
1.6 andrew 568: return undef;
569: }
570:
571: return $self->cmd( String => 'sudb delete ' . $suid, expect => $success );
572: }
573:
574:
575: =pod
576:
577: =item sudb_modify
578:
579: Takes either the suid of the su to delete
580: as well as what you are changing, either "cir, mir or su2su"
581: and returns true on success or undef otherwise.
582:
583: cir and mir also take a value to set the cir/mir to.
584:
585: su2su takes a group id parameter that is in hex.
586:
1.8 ! andrew 587: You should save_sudb() after calling this, or your changes will be lost
1.6 andrew 588: when the AP is rebooted.
589:
590: =cut
591:
592: sub sudb_modify
593: {
594: my $self = shift;
595: my $suid = shift;
596: my $opt = shift;
597: my $value = shift;
598:
599: if ($suid =~ /\D/) {
600: return undef;
601: }
602:
603: if (lc($opt) eq 'cir' or lc($opt) eq 'mir') {
604: if ($value =~ /\D/) {
605: return undef;
606: }
607: } elsif (lc($opt) eq 'su2su') {
608: if ($value =~ /[^0-9A-Za-f]/) {
609: return undef;
610: }
611: } else {
612: return undef;
613: }
614:
615: my $string = 'sudb modify ' . $suid . ' ' . $opt . ' ' . $value;
616:
617: return $self->cmd( String => $string, expect => $success );
1.5 andrew 618: }
619:
620: =pod
621:
1.2 andrew 622: =item enable_tftpd
623:
1.3 andrew 624: runs C<tftpd(args =E<gt> 'on')> and makes sure that Tftpd is now 'listen'ing
625:
1.2 andrew 626: =cut
627:
628: sub enable_tftpd
1.1 andrew 629: {
630: my $self = shift;
631:
1.2 andrew 632: my $vals = $self->tftpd( args => 'on' );
1.1 andrew 633:
1.2 andrew 634: if ($vals->{'Tftpd'} eq 'listen') {
635: return $vals;
636: } else {
637: return undef;
638: }
1.1 andrew 639: }
640:
1.2 andrew 641: =pod
1.1 andrew 642:
1.2 andrew 643: =item disable_tftpd
1.1 andrew 644:
1.3 andrew 645: runs C<tftpd(args =E<gt> 'off')> and makes sure that Tftpd is now 'disabled'
646:
1.2 andrew 647: =cut
1.1 andrew 648:
1.2 andrew 649: sub disable_tftpd
1.1 andrew 650: {
651: my $self = shift;
652:
1.2 andrew 653: my $vals = $self->tftpd( args => 'off' );
1.1 andrew 654:
1.2 andrew 655: if (ref $vals eq 'HASH' && $vals->{'Tftpd'} eq 'disabled') {
1.1 andrew 656: return $vals;
657: } else {
658: return undef;
659: }
660: }
661:
1.2 andrew 662: =pod
1.1 andrew 663:
1.2 andrew 664: =item cmd
1.1 andrew 665:
1.3 andrew 666: This does most of the work. At the heart, it calls Net::Telnet::cmd() but it also does some special stuff for Trango.
667:
668: Normally returns the last lines from from the command
669:
670: Also accepts these options:
671:
672: I<decode>
673: - if this is true, then it will send the output lines to _decode_lines() and then returns the decoded output
674:
675: I<cmd_disconnects>
676: - if this is true, it then sets logged_in() to false, then it will close() the connection and then sets is_connected() to false
677:
678: I<expect>
679: - if this is set (usually to 'Success.') it will check for that in the last line of output and if it does not, will return undef because the command probably failed
680:
681: I<args>
682: - a string containing the command line options that are passed to the command
683:
1.2 andrew 684: =cut
1.1 andrew 685:
686: sub cmd
687: {
688: my $self = shift;
689:
1.2 andrew 690: my @valid_net_telnet_opts = qw(
691: String
692: Output
693: Cmd_remove_mode
694: Errmode
695: Input_record_separator
696: Ors
697: Output_record_separator
698: Prompt
699: Rs
700: Timeout
701: );
702:
703: my %cfg;
704: if (@_ == 2) {
705: $cfg{'String'} = shift;
706: } elsif (@_ > 2) {
707: %cfg = @_;
708: }
1.1 andrew 709:
1.2 andrew 710: $cfg{'Timeout'} ||= $self->Timeout;
711:
712: unless ($cfg{'String'}) {
713: #$! = "No command passed";
1.3 andrew 714: #warn "No command passed\n";
1.1 andrew 715: return undef;
716: }
717:
718: unless ($self->is_connected) {
1.2 andrew 719: #$! = "Not connected";
1.3 andrew 720: #warn "Not connected\n";
1.1 andrew 721: return undef;
722: }
723:
724: unless ($self->logged_in) {
1.2 andrew 725: #$! = "Not logged in";
1.3 andrew 726: #warn "Not logged in\n";
1.1 andrew 727: return undef;
728: }
729:
730:
1.2 andrew 731: my %cmd;
732: foreach (@valid_net_telnet_opts) {
733: if (exists $cfg{$_}) {
734: $cmd{$_} = $cfg{$_};
735: }
736: }
737: if ($cfg{'args'}) {
738: $cmd{'String'} .= ' ' . $cfg{'args'};
739: }
1.5 andrew 740: my @lines;
741: unless ($cfg{'no_prompt'}) {
742: @lines = $self->SUPER::cmd(%cmd);
743: } else {
744: $self->print($cmd{'String'});
745: @lines = $self->lastline;
746: }
1.1 andrew 747:
1.2 andrew 748: $self->last_lines(\@lines);
749:
750: my $vals = 1;
751: if ($cfg{'decode'}) {
1.4 andrew 752: if ($cfg{'decode'} eq 'each') {
753: $vals = _decode_each_line(@lines);
754: } elsif ($cfg{'decode'} eq 'sulog') {
755: $vals = _decode_sulog(@lines);
756: } else {
757: $vals = _decode_lines(@lines);
758: }
1.1 andrew 759: }
1.5 andrew 760:
761: $self->last_vals($vals);
1.1 andrew 762:
1.2 andrew 763:
1.1 andrew 764: my $last = $self->lastline;
765:
1.2 andrew 766: if ((not $cfg{'expect'}) || $last =~ /$cfg{'expect'}$/) {
767: if ($cfg{'cmd_disconnects'}) {
768: $self->logged_in(0);
769: $self->close;
770: $self->is_connected(0);
771: }
772:
773: if ($cfg{'decode'}) {
774: return $vals;
775: } else {
776: return @lines;
777: }
1.1 andrew 778: } else {
1.2 andrew 779: #$! = "Error with command ($cfg{'string'}): $last";
1.1 andrew 780: return undef;
781: }
782: }
783:
1.2 andrew 784: #=item _decode_lines
785:
1.1 andrew 786: sub _decode_lines
787: {
788: my @lines = @_;
789:
790: my %conf;
791:
792: my $key = '';
793: my $val = '';
794: my $in_key = 0;
795: my $in_val = 0;
796:
797: foreach my $line (@lines) {
1.4 andrew 798: next if $line =~ /$success$/;
799:
1.1 andrew 800: my @chars = split //, $line;
801:
802: my $last_key = '';
803: foreach my $c (@chars) {
804:
805: if ($c eq '[' || $c eq "\r" || $c eq "\n") {
806: if ($c eq '[') {
807: $in_key = 1;
808: $in_val = 0;
809: } else {
810: $in_key = 0;
811: $in_val = 0;
812: }
813:
814: if ($key) {
815: $key =~ s/^\s+//;
816: $key =~ s/\s+$//;
817:
818: $val =~ s/^\s+//;
819: $val =~ s/\s+$//;
820:
821: if ($key eq 'Checksum' && $last_key) {
822: # Special case for these bastids.
823: my $new = $last_key;
824: $new =~ s/\s+\S+$//;
825: $key = $new . " " . $key;
826: }
827:
828: $last_key = $key;
829: $conf{$key} = $val;
830: $key = '';
831: $val = '';
832: }
833:
834: } elsif ($c eq ']') {
835: $in_val = 1;
836: $in_key = 0;
837: $c = shift @chars;
838:
839: } elsif ($in_key) {
840: $key .= $c;
841:
842: } elsif ($in_val) {
843: $val .= $c;
844: }
845: }
846: }
847:
848: if (%conf) {
849: return \%conf;
850: } else {
1.4 andrew 851: return undef;
852: }
853: }
854:
855: #=item _decode_each_line
856:
857: sub _decode_each_line
858: {
859: my @lines = @_;
860: my @decoded;
861: foreach my $line (@lines) {
862: my $decoded = _decode_lines($line);
863: push @decoded, $decoded if defined $decoded;
864: }
865: return \@decoded;
866: }
867:
868: #=item _decode_sulog
869:
870: sub _decode_sulog
871: {
872: my @lines = @_;
873: my @decoded;
874: my $last_tm;
875: foreach my $line (@lines) {
876: my $decoded = _decode_lines($line);
877:
878: if (defined $decoded) {
879: if ($decoded->{'tm'}) {
880: $last_tm = $decoded->{'tm'};
881: next;
882: } else {
883: $decoded->{'tm'} = $last_tm;
884: }
885: next unless $last_tm;
886:
887: push @decoded, $decoded if defined $decoded;
888: }
1.1 andrew 889: }
1.4 andrew 890: return \@decoded;
1.1 andrew 891: }
1.2 andrew 892:
893: 1;
894: __END__
895:
896: =back
897:
898: =head1 SEE ALSO
899:
900: Trango Documentation - http://www.trangobroadband.com/support/product_docs.htm
901:
902: L<Net::Telnet>
903:
904: =head1 TODO
905:
906: 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.
907:
908: 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.
909:
910: =head1 AUTHOR
911:
912: Andrew Fresh E<lt>andrew@rraz.netE<gt>
913:
914: =head1 COPYRIGHT AND LICENSE
915:
916: Copyright (C) 2005 by Andrew Fresh
917:
918: This library is free software; you can redistribute it and/or modify
919: it under the same terms as Perl itself, either Perl version 5.8.7 or,
920: at your option, any later version of Perl 5 you may have available.
921:
922:
923: =cut
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to Trango.pm CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / trango / Net-Telnet-Trango / lib / Net / Telnet