Beefy Boxes and Bandwidth Generously Provided by pair Networks
go ahead... be a heretic
 
PerlMonks  

Please critique: TL1ng::Base

by Hercynium (Hermit)
on Aug 22, 2007 at 18:25 UTC ( [id://634466]=note: print w/replies, xml ) Need Help??


in reply to RFC: Looking for review of a set of modules for handling TL1

Code for the Base class:
package TL1ng::Base; use strict; use warnings; use TL1ng::Parser; our $DEBUG = 2; =pod =head2 new Create a new TL1 object representing the connection to the TL1 NE/GNE. +<BR> <BR> Right now I've only written a subclass to support working over a Telne +t connection but in the future I may add the ability to use a serial por +t or named pipe or something... =cut sub new { my $class = shift; my $self = bless( {@_}, $class ); # Set up a parser: $self->{parser} = new TL1ng::Parser(); # Set up a queue for response messages that get read in, but haven +'t # been retrieved by the calling app. These can be any type of TL1 +message. $self->{response_queue} = []; return $self; } =pod =head2 get_next Retrieves the next available message, regardless of it's type. If none are available, returns undef. my $msg = $tl1->get_next(); =cut sub get_next { my $self = shift; my $msg; $msg = shift( @{ $self->{response_queue} } ); $msg = $self->{parser}->parse_string( $self->_read_msg() ) unless +$msg; return $msg; } =pod =head2 get_auto - NOT TESTED Retrieves the next available autonomous message. Will wait until $time +out seconds or default to $self->timeout(). If no autonomous message can b +e retrieved, returns false. my $msg = $tl1->get_auto(); =cut sub get_auto { my $self = shift; my $timeout = shift; $timeout = $self->timeout() unless defined $timeout; my $start = time; # Search the response queue my $queue = $self->{response_queue}; for ( my $x = 0 ; $x < @$queue ; $x++ ) { if ( exists $queue->[$x]{type} and $queue->[$x]{type} eq 'AUT' + ) { return splice @$queue, $x, 1; } } # If that didn't work attempt to retrieve messages until the # timeout is exceeded. while ( time < $start + $timeout ) { if ( my $msg = $self->{parser}->parse_string( $self->_read_msg +() ) ) { return $msg if exists $msg->{type} and $msg->{type} eq 'AU +T'; push @$queue, $msg if $msg; } } return; } =pod =head2 get_resp Retrieves the next available message that is a response to the given C +TAG. (Remember, all TL1 commands must have a CTAG for identifying the respo +nse messages to the command) If $timeout is specified, waits that many sec +onds for a matching message. If no timeout is specified, uses $self->timeou +t(). If no matching message is found, returns false. my $CTAG = '12345'; my $timeout = 60; my $msg = $tl1->get_resp($CTAG, $timeout); =cut sub get_resp { my $self = shift; my $CTAG = shift; my $timeout = shift; $timeout = $self->timeout() unless defined $timeout; my $start = time; # Search the response queue my $queue = $self->{response_queue}; for ( my $x = 0 ; $x < @$queue ; $x++ ) { if ( exists $queue->[$x]{CTAG} and $queue->[$x]{CTAG} == $CTAG + ) { return splice @$queue, $x, 1; } } # If that didn't work attempt to retrieve messages until the # timeout is exceeded. while ( time < $start + $timeout ) { if ( my $msg = $self->{parser}->parse_string( $self->_read_msg +() ) ) { return $msg if exists $msg->{CTAG} and $msg->{CTAG} == $CT +AG; push @$queue, $msg if $msg; } } return; } =pod =head2 send_cmd Sends a TL1 command string to the connected NE. This method will NOT w +ait for the NE to return any response, but my experience shows that this response may or not be useful, or even related to the issued command! Therefore, after sending the command this method returns the status of + the output operation.(almost *always* true) Any responses to this command (or whatever the NE sends next) can be retrieved with get_next(). my $cmd = 'rtrv-alm-all:andvmael3001::1;'; $tl1->send_cmd($cmd); my $resp = $tl1->get_next(); Just a trick - this method (on success) actually returns $self, so you + can chain it with another method, like this... my $ctag = '1234'; my $cmd = 'rtrv-alm-all:andvmael3001::${ctag};'; my $resp = $tl1->send_cmd($cmd)->get_resp($ctag); =cut sub send_cmd { my $self = shift; $self->_send_cmd(shift) and return $self; return; } 1;

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://634466]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others pondering the Monastery: (6)
As of 2024-04-25 11:42 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found