File Coverage

blib/lib/Net/CLI/Interact/Role/Prompt.pm
Criterion Covered Total %
statement 9 60 15.0
branch 0 14 0.0
condition 0 9 0.0
subroutine 3 9 33.3
pod 5 5 100.0
total 17 97 17.5


line stmt bran cond sub pod time code
1             package Net::CLI::Interact::Role::Prompt;
2             $Net::CLI::Interact::Role::Prompt::VERSION = '2.400002';
3 1     1   575 use Moo::Role;
  1         3  
  1         6  
4 1     1   337 use MooX::Types::MooseLike::Base qw(Str RegexpRef);
  1         3  
  1         56  
5 1     1   6 use Net::CLI::Interact::ActionSet;
  1         2  
  1         924  
6              
7             with 'Net::CLI::Interact::Role::FindMatch';
8              
9             has 'wake_up_msg' => (
10             is => 'rw',
11             isa => Str,
12             default => sub { (shift)->transport->ors },
13             predicate => 1,
14             );
15              
16             has '_prompt' => (
17             is => 'rw',
18             isa => RegexpRef,
19             reader => 'prompt_re',
20             predicate => 'has_set_prompt',
21             clearer => 'unset_prompt',
22             trigger => sub {
23             (shift)->logger->log('prompt', 'info', 'prompt has been set to', (shift));
24             },
25             );
26              
27             sub set_prompt {
28 0     0 1   my ($self, $name) = @_;
29 0           $self->_prompt( $self->phrasebook->prompt($name)->first->value->[0] );
30             }
31              
32             sub last_prompt {
33 0     0 1   my $self = shift;
34 0           return $self->last_actionset->item_at(-1)->response;
35             }
36              
37             sub last_prompt_re {
38 0     0 1   my $self = shift;
39 0           my $prompt = $self->last_prompt;
40 0           return qr/^\Q$prompt\E$/;
41             }
42              
43             sub prompt_looks_like {
44 0     0 1   my ($self, $name) = @_;
45 0           return $self->find_match(
46             $self->last_prompt, $self->phrasebook->prompt($name)->first->value
47             );
48             }
49              
50             # create an ActionSet of one send and one match Action, for the wake_up
51             sub _fabricate_actionset {
52 0     0     my $self = shift;
53              
54 0           my $output = $self->transport->flush;
55 0           my $irs_re = $self->transport->irs_re;
56              
57 0           $output =~ s/^(?:$irs_re)+//;
58 0           my @output_lines = split $irs_re, $output;
59 0           my $last_output_line = pop @output_lines;
60 0           my $current_match = [$self->prompt_re];
61              
62 0 0         my $set = Net::CLI::Interact::ActionSet->new({
63             current_match => $current_match,
64             actions => [
65             {
66             type => 'send',
67             value => ($self->has_wake_up_msg ? $self->wake_up_msg : ''),
68             response => (join "\n", @output_lines, ''),
69             },
70             {
71             type => 'match',
72             response => $last_output_line,
73             value => $current_match,
74             prompt_hit => $current_match->[0],
75             },
76             ],
77             });
78              
79 0           return $set;
80             }
81              
82             # pump until any of the prompts matches the output buffer
83             sub find_prompt {
84 0     0 1   my ($self, $wake_up) = @_;
85 0           $self->logger->log('prompt', 'notice', 'finding prompt');
86              
87             # make connection on transport if not yet done
88 0 0         $self->transport->init if not $self->transport->connect_ready;
89              
90             # forget the previous prompt; will set new one if successful or bail out if not
91 0           $self->unset_prompt;
92              
93 0           eval {
94 0           my $started_pumping = time;
95 0           PUMPING: while (1) {
96 0           $self->transport->pump;
97 0           $self->logger->log('dump', 'debug', "SEEN:\n'". $self->transport->buffer. "'");
98 0           foreach my $prompt ($self->phrasebook->prompt_names) {
99             # prompts consist of only one match action
100 0 0         if ($self->find_match(
101             $self->transport->buffer,
102             $self->phrasebook->prompt($prompt)->first->value)) {
103 0           $self->logger->log('prompt', 'info', "hit, matches prompt $prompt");
104 0           $self->set_prompt($prompt);
105 0           $self->last_actionset( $self->_fabricate_actionset() );
106 0           $self->logger->log('dialogue', 'info',
107             "trimmed command response:\n". $self->last_response);
108 0           last PUMPING;
109             }
110 0           $self->logger->log('prompt', 'debug', "nope, doesn't (yet) match $prompt");
111             }
112 0           $self->logger->log('prompt', 'debug', 'no match so far, more data?');
113 0 0 0       last if $self->transport->timeout
114             and time > ($started_pumping + $self->transport->timeout);
115             }
116             };
117              
118 0 0 0       if ($@ and $self->has_wake_up_msg and $wake_up) {
      0        
119 0           $self->logger->log('prompt', 'notice',
120             "failed: [$@], sending WAKE_UP and trying again");
121              
122 0           eval {
123 0           $self->transport->put( $self->wake_up_msg );
124 0           $self->find_prompt(--$wake_up);
125             };
126 0 0         if ($@) {
127             # really died, so this time bail out - with possible transport err
128 0           my $output = $self->transport->flush;
129 0           $self->transport->disconnect;
130 0           die $output;
131             }
132             }
133             else {
134 0 0         if (not $self->has_set_prompt) {
135             # trouble... we were asked to find a prompt but failed :-(
136 0           $self->logger->log('prompt', 'critical', 'failed to find prompt! wrong phrasebook?');
137              
138             # bail out with what we have...
139 0           my $output = $self->transport->flush;
140 0           $self->transport->disconnect;
141 0           die $output;
142             }
143             }
144             }
145              
146             1;
147              
148             =pod
149              
150             =for Pod::Coverage has_wake_up_msg
151              
152             =head1 NAME
153              
154             Net::CLI::Interact::Role::Prompt - Command-line prompt management
155              
156             =head1 DESCRIPTION
157              
158             This is another core component of L<Net::CLI::Interact>, and its role is to
159             keep track of the current prompt on the connected command line interface. The
160             idea is that most CLI have a prompt where you issue commands, and are returned
161             some output which this module gathers. The prompt is a demarcation between
162             each command and its response data.
163              
164             Note that although we "keep track" of the prompt, Net::CLI::Interact is not a
165             state machine, and the choice of command issued to the connected device bears
166             no relation to the current (or last matched) prompt.
167              
168             =head1 INTERFACE
169              
170             =head2 set_prompt( $prompt_name )
171              
172             This method will be used most commonly by applications to select and set a
173             prompt from the Phrasebook which matches the current context of the connected
174             CLI session. This allows a sequence of commands to be sent which share the
175             same Prompt.
176              
177             The name you pass in is looked up in the loaded Phrasebook and the entry's
178             regular expression stored internally. An exception is thrown if the named
179             Prompt is not known.
180              
181             Typically you would either refer to a Prompt in a Macro, or set the prompt you
182             are expecting once for a sequence of commands in a particular CLI context.
183              
184             When a Macro completes and it has been defined in the Phrasebook with an
185             explicit named Prompt at the end, we can assume the user is indicating some
186             change of context. Therefore the C<prompt> is I<automatically updated> on such
187             occasions to have the regular expression from that named Prompt.
188              
189             =head2 prompt_re
190              
191             Returns the current Prompt in the form of a regular expression reference. The
192             Prompt is used as a default to catch the end of command response output, when
193             a Macro has not been set up with explicit Prompt matching.
194              
195             Typically you would either refer to a Prompt in a Macro, or set the prompt you
196             are expecting once for a sequence of commands in a particular CLI context.
197              
198             =head2 unset_prompt
199              
200             Use this method to empty the current C<prompt> setting (see above). The effect
201             is that the module will automatically set the Prompt for itself based on the
202             last line of output received from the connected CLI. Do not use this option
203             unless you know what you are doing.
204              
205             =head2 has_set_prompt
206              
207             Returns True if there is currently a Prompt set, otherwise returns False.
208              
209             =head2 prompt_looks_like( $name )
210              
211             Returns True if the current prompt matches the given named prompt. This is
212             useful when you wish to make a more specific check on the current prompt.
213              
214             =head2 find_prompt( $wake_up? )
215              
216             A helper method that consumes output from the connected CLI session until a
217             line matches any one of the named Prompts in the loaded Phrasebook, at which
218             point no more output is consumed. As a consequence the C<prompt> will be set
219             (see above).
220              
221             This might be used when you're connecting to a device which maintains CLI
222             state between session disconnects (for example a serial console), and you need
223             to discover the current state. However, C<find_prompt> is executed
224             automatically for you if you call a C<cmd> or C<macro> before any interaction
225             with the CLI.
226              
227             The current device output will be scanned against all known named Prompts. If
228             nothing is found, the default behaviour is to die. Passing a positive number
229             to the method (as C<$wake_up>) will instead send the content of our
230             C<wake_up_msg> slot (see below), typically a carriage return, and try to match
231             again. The idea is that by sending one carriage return, the connected device
232             will print its CLI prompt. This "send and try to match" process will be
233             repeated up to "C<$wake_up>" times.
234              
235             =head2 wake_up_msg
236              
237             Text sent to a device within the C<find_prompt> method if no output has so far
238             matched any known named Prompt. Default is the value of the I<output record
239             separator> from the Transport (one newline).
240              
241             =head2 last_prompt
242              
243             Returns the Prompt which most recently was matched and terminated gathering of
244             output from the connected CLI. This is a simple text string.
245              
246             =head2 last_prompt_re
247              
248             Returns the text which was most recently matched and terminated gathering of
249             output from the connected CLI, as a quote-escaped regular expression with line
250             start and end anchors.
251              
252             =cut