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