File Coverage

blib/lib/Metabrik/Client/Telnet.pm

Criterion	Covered	Total	%
statement	9	44	20.4
branch	0	20	0.0
condition			n/a
subroutine	3	6	50.0
pod	1	3	33.3
total	13	73	17.8

#
# $Id$
#
# client::telnet Brik
#
package Metabrik::Client::Telnet;
use strict;
use warnings;

use base qw(Metabrik);

sub brik_properties {
   return {
      revision => '$Revision$',
      tags => [ qw(unstable) ],
      author => 'GomoR ',
      license => 'http://opensource.org/licenses/BSD-3-Clause',
      attributes => {
         prompt => [ qw(string_list) ],
         timeout => [ qw(seconds) ],
         _client => [ qw(INTERNAL) ],
      },
      attributes_default => {
         prompt => [ ':', '>', '$', '#', '%' ],
         timeout => 5,
      },
      commands => {
         connect => [ qw(host port username password) ],
         read_next => [ ],
      },
      require_modules => {
         'Metabrik::String::Regex' => [ ],
         'Net::Telnet' => [ ],
      },
   };
}

sub connect {
   my $self = shift;
   my ($host, $port, $username, $password) = @_;

   $self->brik_help_run_undef_arg('connect', $host) or return;
   $self->brik_help_run_undef_arg('connect', $port) or return;
   $self->brik_help_run_undef_arg('connect', $username) or return;
   $self->brik_help_run_undef_arg('connect', $password) or return;

   my $timeout = $self->timeout;
   my $prompt = $self->prompt;

   my $sr = Metabrik::String::Regex->new_from_brik_init($self) or return;

   my $re = $sr->encode($prompt) or return;

   my $t = Net::Telnet->new(
      Timeout => $timeout,
      Prompt => "/$re/",
      Port => $port,
   );

   eval {
      $t->open($host);
   };
   if ($@) {
      chomp($@);
      return $self->log->error("connect: failed to host [$host] port [$port] with: [$@]");
   }

   eval {
      $t->login($username, $password);
   };
   if ($@) {
      chomp($@);
      return $self->log->error("connect: login failed with username [$username]");
   }

   $self->_client($t);

   $self->log->verbose("connect: connection successful");

   return 1;
}

sub read_next {
   my $self = shift;

   my $client = $self->_client;
   $self->brik_help_run_undef_arg('connect', $client) or return;

   my $line;
   eval {
      $line = $client->getline;
   };
   if ($@) {
      chomp($@);
      return $self->log->error("read_next: getline failed with: [$@]");
   }

   return $line;
}

1;

__END__