File Coverage

blib/lib/Net/CLI/Interact/Transport/Wrapper/Net_Telnet.pm
Criterion Covered Total %
statement 15 37 40.5
branch 2 14 14.2
condition n/a
subroutine 5 8 62.5
pod 0 3 0.0
total 22 62 35.4


line stmt bran cond sub pod time code
1             package Net::CLI::Interact::Transport::Wrapper::Net_Telnet;
2             $Net::CLI::Interact::Transport::Wrapper::Net_Telnet::VERSION = '2.400002';
3 1     1   7031 use Moo;
  1         3  
  1         6  
4 1     1   313 use Sub::Quote;
  1         5  
  1         87  
5 1     1   9 use MooX::Types::MooseLike::Base qw(Str InstanceOf);
  1         2  
  1         77  
6              
7             extends 'Net::CLI::Interact::Transport::Wrapper::Base';
8              
9             {
10             package # hide from pause
11             Net::CLI::Interact::Transport::Wrapper::Options;
12 1     1   7 use Moo;
  1         3  
  1         4  
13             extends 'Net::CLI::Interact::Transport::Wrapper::Base::Options';
14             }
15              
16 0     0 0 0 sub put { (shift)->wrapper->put( join '', @_ ) }
17              
18             has '_buffer' => (
19             is => 'rw',
20             isa => Str,
21             default => quote_sub(q{''}),
22             );
23              
24             sub buffer {
25 4     4 0 7 my $self = shift;
26 4 100       44 return $self->_buffer if scalar(@_) == 0;
27 2         35 return $self->_buffer(shift);
28             }
29              
30             sub pump {
31 0     0 0   my $self = shift;
32              
33             # try to read all blocks of already available data first
34 0           my $pump_buffer;
35 0           my $available_content = '';
36 0           while (defined $available_content) {
37 0           $available_content = $self->wrapper->get(Errmode => 'return', Timeout => 0);
38 0 0         if (defined $available_content) {
39 0           $self->logger->log('transport', 'debug', 'read one block of data, appending to pump buffer');
40 0           $pump_buffer .= $available_content;
41             }
42             else {
43 0           $self->logger->log('transport', 'debug', 'no block of data available');
44             }
45             }
46              
47             # only try harder if no content was already available
48 0 0         if (not defined $pump_buffer) {
49             # this either returns data or throws an exception because of Net::Telnets default Errmode die
50 0           my $content = $self->wrapper->get(Timeout => $self->timeout);
51 0 0         if (defined $content) {
52 0           $self->logger->log('transport', 'debug', 'read one block of data while waiting for timeout, appending to pump buffer');
53 0           $pump_buffer .= $content;
54             }
55             else {
56 0           $self->logger->log('transport', 'debug', 'no block of data available waiting for timeout');
57             }
58             }
59 0 0         $self->_buffer($self->_buffer . $pump_buffer)
60             if defined $pump_buffer;
61             }
62              
63             has '+timeout' => (
64             trigger => 1,
65             );
66              
67             sub _trigger_timeout {
68 0     0     my $self = shift;
69 0 0         if (scalar @_) {
70 0           my $timeout = shift;
71 0 0         if ($self->connect_ready) {
72 0           $self->wrapper->timeout($timeout);
73             }
74             }
75             }
76              
77             has '+wrapper' => (
78             isa => InstanceOf['Net::Telnet'],
79             );
80              
81             around '_build_wrapper' => sub {
82             my ($orig, $self) = (shift, shift);
83              
84             $self->logger->log('transport', 'notice', 'creating Net::Telnet wrapper for', $self->app);
85             $self->$orig(@_);
86              
87             $SIG{CHLD} = 'IGNORE'
88             if not $self->connect_options->reap;
89              
90             with 'Net::CLI::Interact::Transport::Role::ConnectCore';
91             return $self->connect_core($self->app, $self->runtime_options);
92             };
93              
94             after 'disconnect' => sub {
95             delete $SIG{CHLD};
96             };
97              
98             =pod
99              
100             =begin Pod::Coverage
101              
102             buffer
103             connect_ready
104             disconnect
105             pump
106             put
107              
108             =end Pod::Coverage
109              
110             =cut
111              
112             1;