File Coverage

blib/lib/Net/Telnet/Brcd.pm

Criterion	Covered	Total	%
statement	24	80	30.0
branch	0	28	0.0
condition			n/a
subroutine	8	15	53.3
pod	6	6	100.0
total	38	129	29.4

#!/usr/local/bin/perl
# @(#)Brcd.pm	1.12

package Net::Telnet::Brcd;

use 5.008;
use Net::Telnet;
use Carp;
use Data::Dumper;
use Socket;

use strict;
use constant DEBUG => 0;

use base qw(Net::Brcd Exporter);

# Variables de gestion du package

our $VERSION      = 1.13;

# Variables privées
my $_brcd_prompt     = '\w+:\w+>\s+';
my $_brcd_commit     = 'yes, y, no, n';
my $_brcd_continue   = 'Type  to continue, Q to stop:';
my $_brcd_prompt_re  = "/(?:${_brcd_prompt}|${_brcd_continue}|${_brcd_commit})/";
my $_brcd_timeout    = 20; # secondes

sub new {
    my ($class)=shift;

    my $self  = $class->SUPER::new();
    bless $self, $class;
    return $self;
}

sub proto_connect {
    my ($self, $switch, $user, $pass) = @_;

    my $proto = new Net::Telnet (Timeout => ${_brcd_timeout},
                                 Prompt  => "/${_brcd_prompt}/",
                                 );
    $proto->errmode("return");
    unless ($proto->open($switch)) {
        croak __PACKAGE__,": Cannot open connection with '$switch': $!\n";
    }
    unless ($proto->login($user, $pass)) {
        croak __PACKAGE__,": Cannot login as $user/*****: $!\n";
    }
    $self->{PROTO} = $proto;

    # Retourne l'objet TELNET
    return $proto;
}


sub cmd {
    my ($self, $cmd, @cmd)=@_;

    DEBUG && warn "DEBUG: $cmd, @cmd\n";

    my $proto = $self->{PROTO} or croak __PACKAGE__, ": Error - Not connected.\n";

    if (@cmd) {
        $cmd .= ' "' . join('", "', @cmd) . '"';
    }
    $self->sendcmd($cmd);
    #sleep(1); # Temps d'envoi de la commande

    # Lecture en passant les continue
    @cmd = ();
    CMD: while (1) {
       my ($str, $match) = $proto->waitfor(${_brcd_prompt_re});

       DEBUG && warn "DEBUG:: !$match!$str!\n";
       push @cmd, split m/[\n\r]+/, $str;
       if ($match eq ${_brcd_commit}) {
            $proto->print('yes');
            next CMD;
       }
       if ($match eq ${_brcd_continue}) {
          $proto->print("");
          next CMD;
       }
       last CMD;
    }
    @cmd = grep {defined $_} @cmd;

    $self->{OUTPUT} = \@cmd;

    return @cmd;
}

sub sendcmd {
    my ($self, $cmd) = @_;

    my $proto = $self->{PROTO} or croak __PACKAGE__, ": Error - Not connected.\n";

    DEBUG && $proto->dump_log("/tmp/telnet.log");
    DEBUG && warn "Execute: $cmd\n";

    unless ($proto->print($cmd)) {
        croak __PACKAGE__,": Cannot send '$cmd': $!\n";
    }
    return 1;
}

sub sendeof {
    my ($self) = @_;

    my $proto = $self->{PROTO} or croak __PACKAGE__, ": Error - Not connected.\n";

    unless ($proto->print("\cD")) {
        croak __PACKAGE__,": Cannot Ctrl-D: $!\n";
    }
    return 1;
}

sub readline {
    my ($self, $arg_ref) = @_;

    #my ($str, $match) = $proto->waitfor(m/^\s+/);
    my $proto = $self->{PROTO} or croak __PACKAGE__, ": Error - Not connected.\n";
    #DEBUG && warn "DEBUG:: <$str>:<$match>\n";
    #return $str;
    my $str = $proto->getline(($arg_ref?%{$arg_ref}:undef));
    if ($str =~ m/{_brcd_prompt_re}/) {
        return;
    }
    return $str;
}

sub DESTROY {
    my $self = shift;

    $self->{PROTO}->close() if exists $self->{PROTO};
}


1;

__END__