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