Code for the Telnet sub-class:
package TL1ng::Telnet;
=pod
This package inherits from the TL1ng::Base class and implements the se
+nding and
collection of TL1 messages to and from a Telnet (or telnet-like) conne
+ction.
=cut
#our @ISA = qw(TL1ng::Base);
use base 'TL1ng::Base';
use Net::Telnet;
sub new {
my $class = shift;
# Defaults for this sub-class.
my %default_params = (
timeout => 60,
hostname => '',
port => '',
connect => 1, # Establish the Telnet connection no
+w...
prompt => '/[;><]/', # Overriding this could be bad,
# but you can if you want.
@_, # merge additional params into this
+hash.
);
# All TL1ng::Base subclasses must do this.
my $self = $class->SUPER::new(%default_params);
# Set up $self->{socket} with a Net::Telnet connection
# App will die if connection fails.
$self->connect() if $self->{connect};
return $self;
}
=pod
=head2 _read_msg - MOVE TO TELNET-SPECIFIC SUBCLASS?
Reads a TL1 message from the connection to the NE and returns it as a
multi-line string.
my $msg = $tl1->_read_msg();
=cut
sub _read_msg {
my $self = shift;
my $recurse = shift || 0;
my $msg;
my ( $line, $terminator ) = $self->{'socket'}->waitfor( $self->{pr
+ompt} );
$msg = $line . $terminator if $line and $terminator;
# Check for and handle errors reading frtom the telnet connection:
if ( $self->{'socket'}->timed_out() ) {
# Timeout isn't inherently fatal.
warn "Timed Out! (error not fatal)" if $DEBUG > 2;
}
elsif ( $self->{'socket'}->eof() ) {
warn "EOF detected. Connection failed?\n\t"
. $self->{'socket'}->errmsg('');
$self->disconnect();
}
elsif ( $self->{'socket'}->errmsg() ) {
# Some other unknown type of error?
warn "\t" . $self->{'socket'}->errmsg('');
$self->disconnect();
}
# if this message's terminator isn't on a line by itself,
# this may be an echoed command... try getting the next message.
elsif ( $msg !~ /^[;><]/m ) {
$msg = $self->_read_msg( ++$recurse ) unless $recurse;
}
return $msg;
}
sub _send_cmd {
shift->{'socket'}->print(shift);
}
=pod
=head2 connect
Connects to the TL1 port using Telnet. The settings for the session ar
+e set
when creating the TL1 object (via new) Dies if the connection fails.<B
+R>
<BR>
I may change this method drastically in the future.
=cut
sub connect {
my $self = shift;
# 0 is a better default than auto for this 'cause it's more predic
+table.
my $cmd_remove_mode =
defined $self->{Cmd_remove_mode} ? $self->{Cmd_remove_mode} : 0;
# Changed default from 0 to 1 for the Lucent nodes.
my $telnetmode = defined $self->{Telnetmode} ? $self->{Telnetmode}
+ : 1;
my $timeout = defined $self->{timeout} ? $self->{timeout} : 15;
$self->{'socket'} = new Net::Telnet(
Timeout => $timeout,
Errmode => 'return',
Telnetmode => $telnetmode,
Cmd_remove_mode => $cmd_remove_mode,
Prompt => $self->{prompt},
);
$self->{socket}->dump_log('telnet_dump.log') if $DEBUG > 3;
$self->{socket}->input_log('telnet_input.log') if $DEBUG > 3;
$self->{socket}->open(
Host => $self->{hostname},
Port => $self->{port},
) || die "Couldn't connect to " . "$self->{hostname}:$self->{port}
+\n";
$self->{connected} = 1;
print "Connected to $self->{hostname}:$self->{port}\n" if $DEBUG >
+ 1;
return 1;
}
=pod
=head2 connected
Use this to determine if the module is still connected to the TL1 data
+ source.
my $status = $tl1->connected();
=cut
sub connected { shift->{connected} }
=pod
=head2 disconnect
Close the connection to the TL1 data source. Always returns 1.
$tl1->disconnect();
=cut
sub disconnect {
my $self = shift;
$self->{socket}->close() if $self->connected();
$self->{connected} = undef;
return 1;
}
=pod
=head2 timeout
Use this to change the amount of time the module will wait for input f
+rom the
TL1 connection.
my $timeout = 10;
my $old_timeout = $tl1->timeout($timeout);
=cut
sub timeout {
my $self = shift;
my $timeout = shift;
# Net::Telnet's timeout can be set to some funky values, so the un
+less
# clause is kinda necessary. 0 is valid, undef is valid, negative
+numbers
# are not valid. See the module's docs for an explanation.
return $self->{'socket'}->timeout($timeout)
if defined $timeout and $timeout >= 0;
return $self->{'socket'}->timeout();
}
=pod
=head2 DESTROY
Some TL1 NE/GNE devices *really* don't like it when the connection isn
+'t
properly terminated. Therefore, the destructor helps prevent that from
+
happening by calling close().
=cut
sub DESTROY { shift->disconnect() }
1;