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


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # client::telnet Brik
5             #
6             package Metabrik::Client::Telnet;
7 1     1   1182 use strict;
  1         4  
  1         31  
8 1     1   8 use warnings;
  1         2  
  1         27  
9              
10 1     1   6 use base qw(Metabrik);
  1         2  
  1         616  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             attributes => {
19             prompt => [ qw(string_list) ],
20             timeout => [ qw(seconds) ],
21             _client => [ qw(INTERNAL) ],
22             },
23             attributes_default => {
24             prompt => [ ':', '>', '$', '#', '%' ],
25             timeout => 5,
26             },
27             commands => {
28             connect => [ qw(host port username password) ],
29             read_next => [ ],
30             },
31             require_modules => {
32             'Metabrik::String::Regex' => [ ],
33             'Net::Telnet' => [ ],
34             },
35             };
36             }
37              
38             sub connect {
39 0     0 0   my $self = shift;
40 0           my ($host, $port, $username, $password) = @_;
41              
42 0 0         $self->brik_help_run_undef_arg('connect', $host) or return;
43 0 0         $self->brik_help_run_undef_arg('connect', $port) or return;
44 0 0         $self->brik_help_run_undef_arg('connect', $username) or return;
45 0 0         $self->brik_help_run_undef_arg('connect', $password) or return;
46              
47 0           my $timeout = $self->timeout;
48 0           my $prompt = $self->prompt;
49              
50 0 0         my $sr = Metabrik::String::Regex->new_from_brik_init($self) or return;
51              
52 0 0         my $re = $sr->encode($prompt) or return;
53              
54 0           my $t = Net::Telnet->new(
55             Timeout => $timeout,
56             Prompt => "/$re/",
57             Port => $port,
58             );
59              
60 0           eval {
61 0           $t->open($host);
62             };
63 0 0         if ($@) {
64 0           chomp($@);
65 0           return $self->log->error("connect: failed to host [$host] port [$port] with: [$@]");
66             }
67              
68 0           eval {
69 0           $t->login($username, $password);
70             };
71 0 0         if ($@) {
72 0           chomp($@);
73 0           return $self->log->error("connect: login failed with username [$username]");
74             }
75              
76 0           $self->_client($t);
77              
78 0           $self->log->verbose("connect: connection successful");
79              
80 0           return 1;
81             }
82              
83             sub read_next {
84 0     0 0   my $self = shift;
85              
86 0           my $client = $self->_client;
87 0 0         $self->brik_help_run_undef_arg('connect', $client) or return;
88              
89 0           my $line;
90 0           eval {
91 0           $line = $client->getline;
92             };
93 0 0         if ($@) {
94 0           chomp($@);
95 0           return $self->log->error("read_next: getline failed with: [$@]");
96             }
97              
98 0           return $line;
99             }
100              
101             1;
102              
103             __END__