File Coverage

blib/lib/Net/CLI/Interact/Transport/Wrapper/Base.pm
Criterion Covered Total %
statement 21 57 36.8
branch 0 16 0.0
condition 0 5 0.0
subroutine 7 14 50.0
pod 0 8 0.0
total 28 100 28.0


line stmt bran cond sub pod time code
1             package Net::CLI::Interact::Transport::Wrapper::Base;
2             { $Net::CLI::Interact::Transport::Wrapper::Base::VERSION = '2.300005' }
3              
4 1     1   610 use Moo;
  1         7  
  1         6  
5 1     1   350 use Sub::Quote;
  1         3  
  1         62  
6 1     1   6 use MooX::Types::MooseLike::Base qw(Int RegexpRef Str Object);
  1         2  
  1         99  
7              
8             with 'Net::CLI::Interact::Role::FindMatch';
9              
10             {
11             package # hide from pause
12             Net::CLI::Interact::Transport::Wrapper::Base::Options;
13 1     1   7 use Moo;
  1         2  
  1         4  
14             }
15              
16             has 'use_net_telnet_connection' => (
17             is => 'rw',
18             isa => Int,
19             default => quote_sub('0'),
20             );
21              
22             has 'irs_re' => (
23             is => 'ro',
24             isa => RegexpRef,
25             default => quote_sub(q{ qr/(?:\015\012|\015|\012)/ }), # first wins
26             );
27              
28             has 'ors' => (
29             is => 'rw',
30             isa => Str,
31             default => quote_sub(q{"\n"}),
32             );
33              
34             has 'timeout' => (
35             is => 'rw',
36             isa => quote_sub(q{ die "$_[0] is not a posint!" unless $_[0] > 0 }),
37             default => quote_sub('10'),
38             );
39              
40             has 'app' => (
41             is => 'lazy',
42             isa => Str,
43             predicate => 1,
44             clearer => 1,
45             );
46              
47             has 'stash' => (
48             is => 'rw',
49             isa => Str,
50             default => quote_sub(q{''}),
51             );
52              
53             has 'wrapper' => (
54             is => 'lazy',
55             isa => Object,
56             predicate => 'connect_ready',
57             clearer => 1,
58             );
59              
60             sub _build_wrapper {
61 0     0   0 my $self = shift;
62             $self->logger->log('transport', 'notice', 'connecting with: ',
63 0 0       0 $self->app, (join ' ', map {($_ =~ m/\s/) ? ("'". $_ ."'") : $_}
  0         0  
64             $self->runtime_options));
65             # this better be wrapped otherwise it'll blow up
66             };
67              
68 0     0 0 0 sub init { (shift)->wrapper(@_) }
69              
70             sub flush {
71 2     2 0 3 my $self = shift;
72 2         40 my $content = $self->stash . $self->buffer;
73 2         45 $self->stash('');
74 2         120 $self->buffer('');
75 2         41 return $content;
76             }
77              
78             sub disconnect {
79 2     2 0 21 my $self = shift;
80 2         37 $self->clear_wrapper;
81 2         23 $self->flush;
82             }
83              
84 0     0   0 sub _abc { die "not implemented." }
85              
86 0     0 0 0 sub put { _abc() }
87 0     0 0 0 sub pump { _abc() }
88 0     0 0 0 sub buffer { _abc() }
89              
90 2     2 0 2471 sub DEMOLISH { (shift)->disconnect }
91              
92             sub do_action {
93 0     0 0   my ($self, $action) = @_;
94 0           $self->logger->log('transport', 'info', 'callback received for', $action->type);
95              
96 0 0         if ($action->type eq 'match') {
97 0           my $irs_re = $self->irs_re;
98 0           my $cont = $action->continuation;
99              
100 0           while ($self->pump) {
101             # remove control characters
102 0           (my $buffer = $self->buffer) =~ s/[\000-\010\013\014\016-\032\034-\037]//g;
103 0           $self->logger->log('dump', 'debug', "SEEN:\n". $buffer);
104              
105 0 0         if ($buffer =~ m/^(.*$irs_re)(.*)/s) {
106 0           $self->stash($self->stash . $1);
107 0   0       $self->buffer($2 || '');
108             }
109              
110 0 0 0       if ($cont and $self->find_match($self->buffer, $cont->first->value)) {
    0          
111 0           $self->logger->log('transport', 'debug', 'continuation matched');
112 0           $self->buffer('');
113 0           $self->put($cont->last->value);
114             }
115             elsif (my $hit = $self->find_match($self->buffer, $action->value)) {
116 0           $self->logger->log('transport', 'info',
117             sprintf 'output matched %s, storing and returning', $hit);
118 0           $action->prompt_hit($hit);
119 0           $action->response_stash($self->stash);
120 0           $action->response($self->buffer);
121 0           $self->flush;
122 0           last;
123             }
124             else {
125             $self->logger->log('transport', 'debug', "nope, doesn't (yet) match",
126 0 0         (ref $action->value eq ref [] ? (join '|', @{$action->value})
  0            
127             : $action->value));
128             }
129             }
130             }
131 0 0         if ($action->type eq 'send') {
132 0           my $command = sprintf $action->value, @{ $action->params };
  0            
133 0           $self->logger->log('dialogue', 'notice', 'queueing data for send: "'. $command .'"');
134 0 0         $self->put( $command, ($action->no_ors ? () : $self->ors) );
135             }
136             }
137              
138             1;