Net::Telnet::Trango - Net::Telnet::Trango documentation

  use Net::Telnet::Trango;
  my $t = new Net::Telnet::Trango ( Timeout => 5 );

  $t->open( Host => $ap ) or die "Error connecting: $!";

  $t->login('password') or die "Couldn't log in: $!";

  # Do whatever

  $t->exit;
  $t->close;

    new([Options from Net::Telnet,]
        [Decode => 0,]);

  my $old_remarks = $t->remarks();
  $t->remarks($new_remarks);

  $t->su_info($suid);

  $t->su_testrflink($suid|'all');

    $t->set_baseid($baseid);

    $t->set_suid($baseid);

    $t->set_defaultopmode(ap|su);

    $t->opmode([ap y|su y]);

    $channel = '11 v';
    $t->freq([$channel]);

    $channels = '11 v 11 h 12 v 12 h';
    $t->freq_writescan($channels);

    $channels = $t->freq_scantable();
    # now $channels eq '11 v 11 h 12 v 12 h';

  $t->su_password('good_pass', 5);

  $t->ipconfig( '10.0.1.5', '255.255.255.0', '10.0.1.1' );

  $t->su_ipconfig( 5, '10.0.1.5', '255.255.255.0', '10.0.1.1' );

    suid : numeric,
    type : (reg|pr)
    cir  : numeric,
    mir  : numeric,
    mac  : Almost any format, it will be reformatted,

  $t->sudb_add($suid, 'reg', $cir, $mir, $mac);

  $t->sudb_delete($suid);

  $t->sudb_modify($suid, 'cir', 512);

    $t->cmd( String => 'exit', no_prompt => 1, cmd_disconnects => 1 );

    perldoc Net::Telnet::Trango

package Net::Telnet::Trango;

# $RedRiver: Trango.pm,v 1.60 2009/07/31 21:46:07 andrew Exp $
use strict;
use warnings;
use base 'Net::Telnet';

our $VERSION = '0.05';

my $EMPTY = q{};
my $SPACE = q{ };

sub new {
    my $class = shift;

    my %args = ();
    if ( @_ == 1 ) {
        $args{'Host'} = shift;
    }
    else {
        %args = @_;
    }

    $args{'Prompt'} ||= '/[\$#]>\s*\r?\n?$/';

    my $decode = $args{'Decode'};
    delete $args{'Decode'};

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

    $args{Decode}       = defined $decode ? $decode : 1;
    $args{is_connected} = 0;
    $args{logged_in}    = 0;

    *$self->{net_telnet_trango} = \%args;

    return $self;
}

#  _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>]
#  linktest <suid> [<pkt len, bytes> [<# of pkts> [<# of cycle>]]]
#  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 = (
    _clear      => { String    => "\n" },
    tftpd       => { decode    => 'all', expect => $success },
    ver         => { decode    => 'all' },
    sysinfo     => { decode    => 'all', expect => $success },
    updateflash => { decode    => 'all', expect => $success },
    sulog       => { decode    => 'sulog', expect => $success },
    'exit'      => { no_prompt => 1, cmd_disconnects => 1 },
    reboot      => { no_prompt => 1, cmd_disconnects => 1 },
    'reset'   => {},
    remarks   => { decode => 'all', expect => $success },
    save_sudb => { String => 'save sudb', expect => $success },
    syslog  => { expect => $success },
    'pipe'  => {},      # XXX needs a special decode
    maclist => { decode => 'maclist' },
    maclist_reset => { String => 'maclist reset', expect => 'done' },
    eth_link      => { String => 'eth link',      expect => $success },
    su_info => { String => 'su info', decode => 'all', expect => $success },
    su_testrflink =>
        { String => 'su testrflink', decode => 'each', expect => $success },
    save_ss    => { String => 'save ss', expect => $success },
    set_baseid => {
        String => 'set baseid',
        decode => 'all',
        expect => $success
    },
    set_suid => {
        String => 'set suid',
        decode => 'all',
        expect => $success
    },
    set_defaultopmode => {
        String => 'set defaultopmode',
        decode => 'all',
        expect => $success
    },
    opmode => { decode => 'all',  expect => $success },
    freq   => { decode => 'freq', expect => $success },
    freq_writescan =>
        { String => 'freq writescan', decode => 'all', expect => $success },
    freq_scantable =>
        { String => 'freq scantable', decode => 'all', expect => $success },
    arq => { decode => 'all' },
);

my %ALIASES = (
    bye               => 'exit',
    restart           => 'reboot',
    Host              => 'host',
    save_systemseting => 'save_ss',
);

my %ACCESS = map { $_ => 1 } qw(
    firmware_version
    host_type
    is_connected
    logged_in
    login_banner
    Timeout
    last_lines
    last_vals
    last_error
    Decode
);

sub AUTOLOAD {
    my $self = shift;

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

    if ( exists $ALIASES{$method} ) {
        $method = $ALIASES{$method};
        return $self->$method(@_);
    }

    if ( exists $COMMANDS{$method} ) {
        my %cmd;
        foreach my $k ( keys %{ $COMMANDS{$method} } ) {
            $cmd{$k} = $COMMANDS{$method}{$k};
        }
        $cmd{'String'} ||= $method;
        $cmd{'args'} .= $SPACE . shift if ( @_ == 1 );
        return $self->cmd( %cmd, @_ );
    }

    if ( exists $ACCESS{$method} ) {
        my $s    = *$self->{net_telnet_trango};
        my $prev = $s->{$method};
        ( $s->{$method} ) = @_ if @_;
        return $prev;
    }

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

sub open {
    my $self = shift;

    unless ( $self->SUPER::open(@_) ) {
        $self->last_error( "Couldn't connect to " . $self->host . ":  $!" );
        return;
    }

    ## Get to login prompt
    unless (
        $self->waitfor(
            -match   => '/password: ?$/i',
            -errmode => "return",
        )
        )
    {
        $self->last_error( "problem connecting to host ("
                . $self->host . "): "
                . $self->lastline );
        return;
    }

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

    $self->is_connected(1);

    return $self->is_connected;
}

sub login {
    my $self = shift;

    unless ( $self->is_connected ) {
        $self->open or return;
    }

    my $password = shift;

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

    $self->logged_in(1);

    return $self->logged_in;
}

sub parse_login_banner {
    my $self = shift;

    if (@_) {
        $self->login_banner(@_);
    }

    my $banner = $self->login_banner;

    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);

    return 1;
}

sub linktest {
    my $self = shift;
    my $suid = shift;

    # These numbers are what I found as defaults when running the command
    my $pkt_len = shift || 1600;
    my $pkt_cnt = shift || 500;
    my $cycles  = shift || 10;

    my %config = @_;

    # * 2, one for the FromAP, one FromSU.  Then / 1000 to get to ms.
    # XXX This might need to be changed, this makes the default timeout the
    # same as $pkt_len, and that might not be enough at slower speeds.
    $config{Timeout} ||= int( ( $pkt_len * $pkt_cnt * $cycles * 2 ) / 1000 );

    my $string = join $SPACE, 'linktest', $suid, $pkt_len, $pkt_cnt, $cycles;
    return $self->cmd(
        %config,
        String => $string,
        decode => 'linktest',
    );

}

sub su_password {
    my $self     = shift;
    my $new_pass = shift || $EMPTY;
    my $su       = shift || 'all';

    unless ( defined $new_pass ) {
        $self->last_error("No new password");

        #return;
    }

    return $self->cmd(
        String => 'su password ' 
            . $su 
            . $SPACE
            . $new_pass
            . $SPACE
            . $new_pass,
        expect => $success,
    );
}

sub ipconfig {
    my $self = shift;

    my $string = join $SPACE, 'ipconfig', @_;

    if ( @_ == 3 ) {
        $self->print($string);
        my @lines = $self->waitfor( Match => '/save\s+and\s+activate/', );
        $self->print('y');

        $self->logged_in(0);
        $self->is_connected(0);

        foreach my $line (@lines) {
            if ( $line =~ s/New \s configuration:\s+//xms ) {
                return _decode_lines($line);
            }
        }

        return {};
    }

    # ipconfig [ <new ip> <new subnet> <new gateway> ]
    return $self->cmd( String => $string, expect => $success );
}

sub su_ipconfig {
    my $self = shift;

    my $suid        = shift;
    my $new_ip      = shift;
    my $new_subnet  = shift;
    my $new_gateway = shift;

    if ( $suid =~ /\D/ ) {
        $self->last_error("Invalid suid '$suid'");
        return;
    }
    unless ($new_ip) {
        $self->last_error("no new_ip passed");
        return;
    }
    unless ($new_subnet) {
        $self->last_error("no new_subnet passed");
        return;
    }
    unless ($new_gateway) {
        $self->last_error("no new_gateway passed");
        return;
    }

    # su ipconfig <suid> <new ip> <new subnet> <new gateway>
    return $self->cmd(
        String => 'su ipconfig ' 
            . $suid 
            . $SPACE 
            . $new_ip 
            . $SPACE
            . $new_subnet
            . $SPACE
            . $new_gateway,
        expect => $success,
    );
}

sub sudb_view {
    my $self = shift;

    my $lines = $self->cmd( String => 'sudb view', expect => $success ) || [];

    return unless @{$lines};

    my $s = *$self->{net_telnet_trango};
    return $lines if !$s->{'Decode'};

    my @sus;
    foreach ( @{$lines} ) {
        next unless $_;
        if (/^
                        \[(\d+)\]
                        \s+
                        [[:xdigit:]]{2}
                        ([[:xdigit:]])
                        ([[:xdigit:]])
                        \s+
                        (\d+)
                        \s+
                        (\d+)
                        \s+
                        ([[:xdigit:]\s]+)
                $/ixms
            )
        {
            my %s = (
                suid  => $1,
                su2su => $2 ? $2 : undef,
                type  => $3 == 1 ? 'reg' : $3 == 5 ? 'pri' : $3,
                cir   => $4,
                mir   => $5,
                mac   => $6,
            );

            $s{'mac'} =~ s/\s//gxms;
            $s{'mac'} = uc( $s{'mac'} );

            push @sus, \%s;
        }
    }

    return \@sus;
}

sub sudb_add {
    my $self = shift;
    my $suid = shift;
    my $type = shift;
    my $cir  = shift;
    my $mir  = shift;
    my $mac  = shift;

    if ( $suid =~ /\D/ ) {
        $self->last_error("Invalid suid '$suid'");
        return;
    }

    unless ( lc($type) eq 'reg' || lc($type) eq 'pr' ) {
        $self->last_error("Invalid type '$type'");
        return;
    }

    if ( $cir =~ /\D/ ) {
        $self->last_error("Invalid CIR '$cir'");
        return;
    }

    if ( $mir =~ /\D/ ) {
        $self->last_error("Invalid MIR '$mir'");
        return;
    }

    my $new_mac = $mac;
    $new_mac =~ s/[^0-9A-Fa-f]//g;
    unless ( length $new_mac == 12 ) {
        $self->last_error("Invalid MAC '$mac'");
        return;
    }
    $new_mac = join $SPACE, $new_mac =~ /../g;

    my $string
        = 'sudb add ' 
        . $suid 
        . $SPACE 
        . $type 
        . $SPACE 
        . $cir 
        . $SPACE 
        . $mir
        . $SPACE
        . $new_mac;

    return $self->cmd( String => $string, expect => $success );
}

sub sudb_delete {
    my $self = shift;
    my $suid = shift;

    #if (lc($suid) ne 'all' || $suid =~ /\D/) {
    if ( $suid =~ /\D/ ) {
        $self->last_error("Invalid suid '$suid'");
        return;
    }

    return $self->cmd( String => 'sudb delete ' . $suid, expect => $success );
}

sub sudb_modify {
    my $self  = shift;
    my $suid  = shift;
    my $opt   = shift;
    my $value = shift;

    if ( $suid =~ /\D/ ) {
        $self->last_error("Invalid suid '$suid'");
        return;
    }

    if ( lc($opt) eq 'cir' or lc($opt) eq 'mir' ) {
        if ( $value =~ /\D/ ) {
            $self->last_error("Invalid $opt '$value'");
            return;
        }
    }
    elsif ( lc($opt) eq 'su2su' ) {
        if ( $value =~ /[^0-9A-Za-f]/ ) {
            $self->last_error("Invalid MAC '$value'");
            return;
        }
    }
    else {
        $self->last_error("Invalid option '$opt'");
        return;
    }

    my $string = 'sudb modify ' . $suid . $SPACE . $opt . $SPACE . $value;

    return $self->cmd( String => $string, expect => $success );
}

sub enable_tftpd {
    my $self = shift;

    my $vals = $self->tftpd( args => 'on' );

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

sub disable_tftpd {
    my $self = shift;

    my $vals = $self->tftpd( args => 'off' );

    if ( ref $vals eq 'HASH' && $vals->{'Tftpd'} eq 'disabled' ) {
        return $vals;
    }
    else {
        return;
    }
}

sub cmd {
    my $self = shift;
    my $s    = *$self->{net_telnet_trango};

    my @valid_net_telnet_opts = qw(
        String
        Output
        Cmd_remove_mode
        Errmode
        Input_record_separator
        Ors
        Output_record_separator
        Prompt
        Rs
        Timeout
    );

    my %cfg;
    if ( @_ == 1 ) {
        $cfg{'String'} = shift;
    }
    elsif ( @_ > 1 ) {
        %cfg = @_;
    }

    $cfg{'Timeout'} ||= $self->Timeout;

    unless ( $cfg{'String'} ) {
        $self->last_error("No command passed");
        return;
    }

    unless ( $self->is_connected ) {
        $self->last_error("Not connected");
        return;
    }

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

    my %cmd;
    foreach (@valid_net_telnet_opts) {
        if ( exists $cfg{$_} ) {
            $cmd{$_} = $cfg{$_};
        }
    }
    if ( $cfg{'args'} ) {
        $cmd{'String'} .= $SPACE . $cfg{'args'};
    }

    #print "Running cmd $cmd{String}\n";
    my @lines;
    if ( $cfg{'no_prompt'} ) {
        $self->print( $cmd{'String'} );
        @lines = $self->lastline;
    }
    else {
        @lines = $self->SUPER::cmd(%cmd);
    }

    $self->last_lines( \@lines );

    my $last   = $self->lastline;
    my $prompt = $self->prompt;
    $prompt =~ s{^/}{}xms;
    $prompt =~ s{/[gixms]*$}{}xms;
    while ( @lines && $last =~ qr($prompt) ) {
        pop @lines;
        $last = $lines[-1];
    }
    $self->last_error($EMPTY);

    my $vals = 1;
    if ( $s->{'Decode'} && $cfg{'decode'} ) {
        if ( $cfg{'decode'} eq 'each' ) {
            $vals = _decode_each_line(@lines);
        }
        elsif ( $cfg{'decode'} eq 'sulog' ) {
            $vals = _decode_sulog(@lines);
        }
        elsif ( $cfg{'decode'} eq 'maclist' ) {
            $vals = _decode_maclist(@lines);
            if ( !$vals ) {
                $self->last_error("Error decoding maclist");
            }
        }
        elsif ( $cfg{'decode'} eq 'linktest' ) {
            $vals = _decode_linktest(@lines);
            if ( !$vals ) {
                $self->last_error("Error decoding linktest");
            }
        }
        elsif ( $cfg{'decode'} eq 'freq' ) {
            $vals = _decode_freq(@lines);
        }
        else {
            $vals = _decode_lines(@lines);
        }
    }
    if ( ref $vals eq 'HASH' ) {
        $vals->{_raw} = join q{}, @lines;
    }
    $self->last_vals($vals);

    if ( ( not $cfg{'expect'} ) || $last =~ /$cfg{'expect'}$/ ) {
        if ( $cfg{'cmd_disconnects'} ) {
            $self->logged_in(0);
            $self->close;
            $self->is_connected(0);
        }

        if ( $s->{'Decode'} && $cfg{'decode'} ) {
            return $vals;
        }
        else {
            return \@lines;
        }
    }
    else {
        my $err;
        if ( grep {/\[ERR\]/} @lines ) {
            $err = _decode_lines(@lines);
        }

        if ( ref $err eq 'HASH' && $err->{ERR} ) {
            $self->last_error( $err->{ERR} );
        }
        else {
            $self->last_error("Error with command ($cmd{'String'}): $last");
        }
        return;
    }
}

#=item _decode_lines

sub _decode_lines {
    my @lines = @_;

    my %conf;

    my $key = $EMPTY;
    my $val = undef;
    my @vals;
    my $in_key = 0;
    my $in_val = 1;

LINE: while ( my $line = shift @lines ) {
        next LINE if $line =~ /$success\Z/;
        next LINE if $line =~ /^ \*+ \s+ \d+ \s+ \*+ \Z/xms;

        # Special decode for sysinfo on a TrangoLink 45
        if ( $line =~ /^(.* Channel \s+ Table):\s*(.*)\Z/xms ) {
            my $key  = $1;
            my $note = $2;

            my %vals;
            while ( $line = shift @lines ) {
                if ( $line =~ /^\Z/ ) {
                    $conf{$key} = \%vals;
                    $conf{$key}{note} = $note;
                    next LINE;
                }

                my $decoded = _decode_lines($line);
                if ($decoded) {
                    %vals = ( %vals, %{$decoded} );
                }
            }
        }

        # Another special decode for the TrangoLink
        elsif (
            $line =~ /^
                        RF \s Band \s \# 
                        (\d+) \s+ 
                        \( ([^\)]+) \) \s*
                        (.*)$
                /xms
            )
        {
            my $num   = $1;
            my $band  = $2;
            my $extra = $3;

            if ( $extra =~ /\[/ ) {
                my $decoded = _decode_lines($extra);
                $conf{'RF Band'}{$num} = $decoded;
            }
            else {
                $conf{'RF Band'}{$num}{$extra} = 1;
            }
            next LINE;
        }

        my @chars = split //, $line;

        my $last_key = $EMPTY;
        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 = 1;
                }

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

                    if ($val) {
                        $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 . $SPACE . $key;
                    }

                    $conf{$key} = $val;
                    $last_key   = $key;
                    $key        = $EMPTY;
                }
                elsif ($val) {
                    push @vals, $val;
                }
                $val = $EMPTY;

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

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

            }
            elsif ($in_val) {
                $val .= $c;
            }
        }
    }

    unless ($key) {
        push @vals, $val;
    }

    foreach my $val (@vals) {
        if ( defined $val && length $val ) {
            $val =~ s/^\s+//;
            $val =~ s/\s+\.*$//;
        }
    }

    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;
    }
}

#=item _decode_each_line

sub _decode_each_line {
    my @lines = @_;
    my @decoded;
    foreach my $line (@lines) {
        my $decoded = _decode_lines($line);
        push @decoded, $decoded if defined $decoded && length $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 ( $tm, $rt );
            if ( $line =~ s/\s+ (\d+ \s+ \w+) \s* $//xms ) {
                $rt = $1;
            }
            if ( $line =~ s/\s+ (\d+ \s+ \w+) \s* $//xms ) {
                $tm = $1;
            }

            my $d = _decode_lines( $line . "\n" );
            $decoded{tests}[$line_id]         = $d;
            $decoded{tests}[$line_id]{'time'} = $tm;
            $decoded{tests}[$line_id]{rate}   = $rt;
        }

        else {
            my $d = _decode_lines( $line . "\n" );
            if ($d) {
                while ( my ( $k, $v ) = each %{$d} ) {
                    $decoded{$k} = $v;
                }
            }
        }

    }
    return \%decoded;
}

#=item _decode_sulog

sub _decode_sulog {
    my @lines = @_;
    my @decoded;
    my $last_tm;
    foreach my $line (@lines) {
        my $decoded = _decode_lines($line);

        if ( defined $decoded ) {
            if ( $decoded->{'tm'} ) {
                $last_tm = $decoded->{'tm'};
                next;
            }
            else {
                $decoded->{'tm'} = $last_tm;
            }
            next unless $last_tm;

            push @decoded, $decoded if defined $decoded;
        }
    }
    return \@decoded;
}

#=item _decode_maclist

sub _decode_maclist {
    my @lines = @_;
    my @decoded;
    my $total_entries = 0;
    my $current_tm    = 0;
    foreach my $line (@lines) {
        $line =~ s/\r?\n$//;
        my ( $mac, $loc, $tm ) = $line =~ /
                        ([0-9a-fA-F ]{17})\s+
                        (.*)\s+
                        tm\s+
                        (\d+)
                /x;

        if ($mac) {
            $mac =~ s/\s+//g;
            $loc =~ s/^\s+//;
            $loc =~ s/\s+$//;

            my $suid = undef;
            if ( $loc =~ /suid\s+=\s+(\d+)/ ) {
                $suid = $1;
                $loc  = undef;
            }

            push @decoded,
                {
                mac  => $mac,
                loc  => $loc,
                tm   => $tm,
                suid => $suid,
                };
        }
        elsif ( $line =~ /(\d+)\s+entries/ ) {
            $total_entries = $1;
        }
        elsif ( $line =~ /current tm = (\d+)\s+sec/ ) {
            $current_tm = $1;
        }
    }

    map { $_->{'cur_tm'} = $current_tm } @decoded;

    if ( scalar @decoded == $total_entries ) {
        return \@decoded;
    }
    else {
        return;
    }
}

#=item _decode_freq

sub _decode_freq {
    my @lines   = @_;
    my $decoded = _decode_lines(@lines);

    if ( $decoded && $decoded->{ERR} ) {
        return $decoded;
    }

LINE: foreach my $line (@lines) {
        if (my ( $channel, $polarity, $freq )
            = $line =~ /
                        Ch \s+ \#(\d+) 
                        \s+
                        (\w+)
                        \s+
                        \[ (\d+) \s+ MHz\]
                /ixms
            )
        {
            $decoded = {
                channel   => $channel,
                polarity  => $polarity,
                frequency => $freq,
            };
            last LINE;
        }
    }
    return $decoded;
}

1;    # End of Net::Telnet::Trango
__END__