File Coverage

blib/lib/Net/CLI/Interact/Phrasebook.pm
Criterion Covered Total %
statement 15 135 11.1
branch 0 52 0.0
condition 0 15 0.0
subroutine 5 20 25.0
pod 6 8 75.0
total 26 230 11.3


line stmt bran cond sub pod time code
1             package Net::CLI::Interact::Phrasebook;
2             $Net::CLI::Interact::Phrasebook::VERSION = '2.400002';
3 1     1   9 use Moo;
  1         2  
  1         15  
4 1     1   305 use MooX::Types::MooseLike::Base qw(InstanceOf Str Any HashRef);
  1         3  
  1         93  
5              
6 1     1   551 use Path::Class;
  1         37782  
  1         58  
7 1     1   514 use File::ShareDir 'dist_dir';
  1         22030  
  1         51  
8 1     1   472 use Net::CLI::Interact::ActionSet;
  1         3  
  1         2222  
9              
10             has 'logger' => (
11             is => 'ro',
12             isa => InstanceOf['Net::CLI::Interact::Logger'],
13             required => 1,
14             );
15              
16             has 'personality' => (
17             is => 'rw',
18             isa => Str,
19             required => 1,
20             );
21              
22             has 'library' => (
23             is => 'lazy',
24             isa => Any, # FIXME 'Str|ArrayRef[Str]',
25             );
26              
27             sub _build_library {
28 0     0     return [ Path::Class::Dir->new( dist_dir('Net-CLI-Interact') )
29             ->subdir('phrasebook')->stringify ];
30             }
31              
32             has 'add_library' => (
33             is => 'rw',
34             isa => Any, # FIXME 'Str|ArrayRef[Str]',
35             default => sub { [] },
36             );
37              
38             has '_prompt' => (
39             is => 'ro',
40             isa => HashRef[InstanceOf['Net::CLI::Interact::ActionSet']],
41             default => sub { {} },
42             );
43              
44             sub prompt {
45 0     0 1   my ($self, $name) = @_;
46 0 0         die "unknown prompt [$name]" unless $self->has_prompt($name);
47 0           return $self->_prompt->{$name};
48             }
49              
50 0     0 1   sub prompt_names { return keys %{ (shift)->_prompt } }
  0            
51              
52             sub has_prompt {
53 0     0 1   my ($self, $name) = @_;
54 0 0 0       die "missing prompt name!"
55             unless defined $name and length $name;
56 0           return exists $self->_prompt->{$name};
57             }
58              
59             has '_macro' => (
60             is => 'ro',
61             isa => HashRef[InstanceOf['Net::CLI::Interact::ActionSet']],
62             default => sub { {} },
63             );
64              
65             sub macro {
66 0     0 1   my ($self, $name) = @_;
67 0 0         die "unknown macro [$name]" unless $self->has_macro($name);
68 0           return $self->_macro->{$name};
69             }
70              
71 0     0 1   sub macro_names { return keys %{ (shift)->_macro } }
  0            
72              
73             sub has_macro {
74 0     0 1   my ($self, $name) = @_;
75 0 0 0       die "missing macro name!"
76             unless defined $name and length $name;
77 0           return exists $self->_macro->{$name};
78             }
79              
80             # matches which are prompt names are resolved to RegexpRefs
81             # and regexp provided by the user are inflated into RegexpRefs
82             sub _resolve_matches {
83 0     0     my ($self, $actions) = @_;
84              
85 0           foreach my $a (@$actions) {
86 0 0         next unless $a->{type} eq 'match';
87 0 0         next unless ref $a->{value} eq ref [];
88              
89 0           my @newvals = ();
90 0           foreach my $v (@{ $a->{value} }) {
  0            
91 0 0 0       if ($v =~ m{^/} and $v =~ m{/$}) {
92 0           $v =~ s{^/}{}; $v =~ s{/$}{};
  0            
93 0           push @newvals, qr/$v/;
94             }
95             else {
96 0           push @newvals, @{ $self->prompt($v)->first->value };
  0            
97             }
98             }
99              
100 0           $a->{value} = \@newvals;
101             }
102              
103 0           return $actions;
104             }
105              
106             # inflate the hashref into action objects
107             sub _bake {
108 0     0     my ($self, $data) = @_;
109              
110 0 0 0       return unless ref $data eq ref {} and keys %$data;
111 0           $self->logger->log('phrasebook', 'debug', 'storing', $data->{type}, $data->{name});
112              
113 0           my $slot = '_'. lc $data->{type};
114             $self->$slot->{$data->{name}}
115             = Net::CLI::Interact::ActionSet->new({
116             actions => $self->_resolve_matches($data->{actions})
117 0           });
118             }
119              
120             sub BUILD {
121 0     0 0   my $self = shift;
122 0           $self->load_phrasebooks;
123             }
124              
125             # parse phrasebook files and load action objects
126             sub load_phrasebooks {
127 0     0 0   my $self = shift;
128 0           my $data = {};
129 0           my $stash = { prompt => [], macro => [] };
130              
131 0           foreach my $file ($self->_find_phrasebooks) {
132 0           $self->logger->log('phrasebook', 'info', 'reading phrasebook', $file);
133 0           my @lines = $file->slurp;
134 0           while ($_ = shift @lines) {
135             # Skip comments and empty lines
136 0 0         next if m/^(?:#|\s*$)/;
137              
138 0 0         if (m{^(prompt|macro)\s+(\w+)\s*$}) {
    0          
139 0 0         if (scalar keys %$data) {
140 0           push @{ $stash->{$data->{type}} }, $data;
  0            
141             }
142 0           $data = {type => $1, name => $2};
143 0           next;
144             }
145             # skip new sections we don't yet understand
146             elsif (m{^\w}) {
147 0           $_ = shift @lines until m{^(?:prompt|macro)};
148 0           unshift @lines, $_;
149 0           next;
150             }
151              
152 0 0         if (m{^\s+send\s+(.+)$}) {
153 0           my $value = $1;
154 0           $value =~ s/^["']//; $value =~ s/["']$//;
  0            
155 0           push @{ $data->{actions} }, {
  0            
156             type => 'send', value => $value,
157             };
158 0           next;
159             }
160              
161 0 0         if (m{^\s+put\s+(.+)$}) {
162 0           my $value = $1;
163 0           $value =~ s/^["']//; $value =~ s/["']$//;
  0            
164 0           push @{ $data->{actions} }, {
  0            
165             type => 'send', value => $value, no_ors => 1,
166             };
167 0           next;
168             }
169              
170 0 0         if (m{^\s+match\s+(.+)\s*$}) {
171 0           my @vals = split m/\s+or\s+/, $1;
172 0 0         if (scalar @vals) {
173 0           push @{ $data->{actions} },
  0            
174             {type => 'match', value => \@vals};
175 0           next;
176             }
177             }
178              
179 0 0         if (m{^\s+follow\s+/(.+)/\s+with\s+(.+)\s*$}) {
180 0           my ($match, $send) = ($1, $2);
181 0           $send =~ s/^["']//; $send =~ s/["']$//;
  0            
182             $data->{actions}->[-1]->{continuation} = [
183 0           {type => 'match', value => [qr/$match/]},
184             ## no critic (ProhibitStringyEval)
185             {type => 'send', value => eval "qq{$send}", no_ors => 1}
186             ## use critic
187             ];
188 0           next;
189             }
190              
191 0           die "don't know what to do with this phrasebook line:\n", $_;
192             }
193             # last entry in the file needs baking
194 0           push @{ $stash->{$data->{type}} }, $data;
  0            
195 0           $data = {};
196             }
197              
198             # bake the prompts before the macros, to allow macros to reference
199             # prompts which appear later in the same file.
200 0           foreach my $t (qw/prompt macro/) {
201 0           foreach my $d (@{ $stash->{$t} }) {
  0            
202 0           $self->_bake($d);
203             }
204             }
205             }
206              
207             # finds the path of Phrasebooks within the Library leading to Personality
208             sub _find_phrasebooks {
209 0     0     my $self = shift;
210 0 0         my @libs = (ref $self->library ? @{$self->library} : ($self->library));
  0            
211 0 0         my @alib = (ref $self->add_library ? @{$self->add_library} : ($self->add_library));
  0            
212              
213             # first find the (relative) path for the requested personality
214             # then within each of @libs gather the files along that path
215              
216 0           my $target = $self->_find_personality_in( @libs, @alib );
217 0 0         die (sprintf "error: unknown personality: '%s'\n",
218             $self->personality) unless $target;
219              
220 0           my @files = $self->_gather_pb_from( $target, @libs, @alib );
221 0 0         die (sprintf "error: personality '%s' contains no phrasebook files!\n",
222             $self->personality) unless scalar @files;
223              
224 0           return @files;
225             }
226              
227             sub _find_personality_in {
228 0     0     my ($self, @libs) = @_;
229 0           my $target = undef;
230              
231 0           foreach my $lib (@libs) {
232             Path::Class::Dir->new($lib)->recurse(callback => sub {
233 0 0   0     return unless $_[0]->is_dir;
234 0 0         $target = Path::Class::Dir->new($_[0])->relative($lib)
235             if $_[0]->dir_list(-1) eq $self->personality
236 0           });
237 0 0         last if defined $target;
238             }
239 0           return $target;
240             }
241              
242             sub _gather_pb_from {
243 0     0     my ($self, $target, @libs) = @_;
244 0           my @files = ();
245              
246 0 0 0       return () unless $target->isa('Path::Class::Dir') and $target->is_relative;
247              
248 0           foreach my $lib (@libs) {
249 0           my $root = Path::Class::Dir->new($lib);
250              
251 0           foreach my $part ($target->dir_list) {
252 0           $root = $root->subdir($part);
253             # $self->logger->log('phrasebook', 'debug', sprintf 'searching in [%s]', $root);
254 0 0         last if not -d $root->stringify;
255              
256             push @files,
257 0           sort {$a->basename cmp $b->basename}
258 0           grep { not $_->is_dir } $root->children(no_hidden => 1);
  0            
259             }
260             }
261 0           return @files;
262             }
263              
264             1;
265              
266             =pod
267              
268             =for Pod::Coverage BUILD load_phrasebooks logger
269              
270             =head1 NAME
271              
272             Net::CLI::Interact::Phrasebook - Load command phrasebooks from a Library
273              
274             =head1 DESCRIPTION
275              
276             A command phrasebook is where you store the repeatable sequences of commands
277             which can be sent to connected network devices. An example would be a command
278             to show the configuration of a device: storing this in a phrasebook (sometimes
279             known as a dictionary) saves time and effort.
280              
281             This module implements the loading and preparing of phrasebooks from an
282             on-disk file-based hierarchical library, and makes them available to the
283             application as smart objects for use in L<Net::CLI::Interact> sessions.
284             Entries in the phrasebook will be one of the following types:
285              
286             =over 4
287              
288             =item Prompt
289              
290             Named regular expressions that match the content of a single line of text in
291             the output returned from a connected device. They are a demarcation between
292             commands sent and responses returned.
293              
294             =item Macro
295              
296             Alternating sequences of command statements sent to the device, and regular
297             expressions to match the response. There are different kinds of Macro,
298             explained below.
299              
300             =back
301              
302             The named regular expressions used in Prompts and Macros are known as I<Match>
303             statements. The command statements in Macros which are sent to the device are
304             known as I<Send> statements. That is, Prompts and Macros are built from one or
305             more Match and Send statements.
306              
307             Each Send or Match statement becomes an instance of the
308             L<Net::CLI::Interact::Action> class. These are built up into Prompts and
309             Macros, which become instances of the L<Net::CLI::Interact::ActionSet> class.
310              
311             =head1 USAGE
312              
313             A phrasebook is a plain text file containing named Prompts or Macros. Each
314             file exists in a directory hierarchy, such that files "deeper" in the
315             hierarchy have their entries override the similarly named entries higher up.
316             For example:
317              
318             /dir1/file1
319             /dir1/file2
320             /dir1/dir2/file3
321              
322             Entries in C<file3> sharing a name with any entries from C<file1> or C<file2>
323             will take precedence. Those in C<file2> will also override entries in
324             C<file1>, because asciibetical sorting places the files in that order, and
325             later definitions with the same name and type override earlier ones.
326              
327             When this module is loaded, a I<personality> key is required. This locates a
328             directory on disk, and then the files in that directory and all its ancestors
329             in the hierarchy are loaded. The directories to search are specified by two
330             I<Library> options (see below). All phrasebooks matching the given
331             I<personality> are loaded, allowing a user to override or augment the default,
332             shipped phrasebooks.
333              
334             =head1 INTERFACE
335              
336             =head2 new( \%options )
337              
338             This takes the following options, and returns a loaded phrasebook object:
339              
340             =over 4
341              
342             =item C<< personality => $directory >> (required)
343              
344             The name of a directory component on disk. Any files higher in the libraries
345             hierarchy are also loaded, but entries in files contained within this
346             directory, or "closer" to it, will take precedence.
347              
348             =item C<< library => $directory | \@directories >>
349              
350             First library hierarchy, specified either as a single directory or a list of
351             directories that are searched in order. The idea is that this option be set in
352             your application code, perhaps specifying some directory of phrasebooks
353             shipped with the distribution.
354              
355             =item C<< add_library => $directory | \@directories >>
356              
357             Second library hierarchy, specified either as a single directory or a list of
358             directories that are searched in order. This parameter is for the end-user to
359             provide the location(s) of their own phrasebook(s). Any entries found via this
360             path will override those found via the first C<library> path.
361              
362             =back
363              
364             =head2 prompt( $name )
365              
366             Returns the Prompt associated to the given C<$name>, or throws an exception if
367             no such prompt can be found. The returned object is an instance of
368             L<Net::CLI::Interact::ActionSet>.
369              
370             =head2 has_prompt( $name )
371              
372             Returns true if a prompt of the given C<$name> exists in the loaded phrasebooks.
373              
374             =head2 prompt_names
375              
376             Returns a list of the names of the current loaded Prompts.
377              
378             =head2 macro( $name )
379              
380             Returns the Macro associated to the given C<$name>, or throws an exception if
381             no such macro can be found. The returned object is an instance of
382             L<Net::CLI::Interact::ActionSet>.
383              
384             =head2 has_macro( $name )
385              
386             Returns true if a macro of the given C<$name> exists in the loaded phrasebooks.
387              
388             =head2 macro_names
389              
390             Returns a list of the names of the current loaded Macros.
391              
392             =head1 PHRASEBOOK FORMAT
393              
394             =head2 Prompt
395              
396             A Prompt is a named regular expression which matches the content of a single
397             line of text. Here is an example:
398              
399             prompt configure
400             match /\(config[^)]*\)# ?$/
401              
402             On the first line is the keyword C<prompt> followed by the name of the Prompt,
403             which must be a valid Perl identifier (letters, numbers, underscores only).
404              
405             On the immediately following line is the keyword C<match> followed by a
406             regular expression, enclosed in two forward-slash characters. Currently, no
407             alternate bookend characters are supported, nor are regular expression
408             modifiers (such as C<xism>) outside of the match, but you can of course
409             include them within.
410              
411             The Prompt is used to find out when the connected CLI has emitted all of the
412             response to a command. Try to make the Prompt as specific as possible,
413             including line-end anchors. Remember that it will be matched against one line
414             of text, only.
415              
416             =head2 Macro
417              
418             In general, Macros are alternating sequences of commands to send to the
419             connected CLI, and regular expressions to match the end of the returned
420             response. Macros are useful for issuing commands which have intermediate
421             prompts, or confirmation steps. They also support the I<slurping> of
422             additional output when the connected CLI has split the response into pages.
423              
424             At its simplest a Macro can be just one command:
425              
426             macro show_int_br
427             send show ip int br
428             match /> ?$/
429              
430             On the first line is the keyword C<macro> followed by the name of the Macro,
431             which must be a valid Perl identifier (letters, numbers, underscores only).
432              
433             On the immediately following line is the keyword C<send> followed by a space
434             and then any text up until the end of the line, and if you want to include
435             whitespace at the beginning or end of the command, use quotes. This text is
436             sent to the connected CLI as a single command statement. The next line
437             contains the keyword C<match> followed by the Prompt (regular expression)
438             which will terminate gathering of returned output from the sent command.
439              
440             Macros support the following features:
441              
442             =over 4
443              
444             =item Automatic Matching
445              
446             Normally, you ought always to specify C<send> statements along with a
447             following C<match> statement so that the module can tell when the output from
448             your command has ended. However you can omit any Match and the module will
449             insert either the current C<prompt> value if set by the user, or the last
450             Prompt from the last Macro. So the previous example could be re-written as:
451              
452             macro show_int_br
453             send show ip int br
454              
455             You can have as many C<send> statements as you like, and the Match statements
456             will be inserted for you:
457              
458             macro show_int_br_and_timestamp
459             send show ip int br
460             send show clock
461              
462             However it is recommended that this type of sequence be implemented as
463             individual commands (or separate Macros) rather than a single Macro, as it
464             will be easier for you to retrieve the command response(s). Normally the
465             Automatic Matching is used just to allow missing off of the final Match
466             statement when it's the same as the current Prompt.
467              
468             =item Format Interpolation
469              
470             Each C<send> statement is in fact run through Perl's C<sprintf> command, so
471             variables may be interpolated into the statement using standard C<"%"> fields.
472             For example:
473              
474             macro show_int_x
475             send show interface %s
476              
477             The method for passing variables into the module upon execution of this Macro
478             is documented in L<Net::CLI::Interact::Role::Engine>. This feature is useful
479             for username/password prompts.
480              
481             =item Named Match References
482              
483             If you're going to use the same Match (regular expression) in a number of
484             Macros, then set it up as a Prompt (see above) and refer to it by name,
485             instead:
486              
487             prompt priv_exec
488             match /# ?$/
489              
490             macro to_priv_exec
491             send enable
492             match /[Pp]assword: ?$/
493             send %s
494             match priv_exec
495              
496             As you can see, in the case of the last Match, we have the keyword C<match>
497             followed by the name of a defined Prompt. To match multiple defined Prompts
498             use this syntax (with as many named references as you like):
499              
500             macro to_privileged
501             send enable
502             match username_prompt or priv_exec
503              
504             =item Continuations
505              
506             Sometimes the connected CLI will not know it's talking to a program and so
507             paginate the output (that is, split it into pages). There is usually a
508             keypress required between each page. This is supported via the following
509             syntax:
510              
511             macro show_run
512             send show running-config
513             follow / --More-- / with ' '
514              
515             On the line following the C<send> statement is the keyword C<follow> and a
516             regular expression enclosed in forward-slashes. This is the Match which will,
517             if seen in the command output, trigger the continuation. On the line you then
518             have the keyword C<with> followed by a space and some text, until the end of
519             the line. If you need to enclose whitespace use quotes, as in the example.
520              
521             The module will send the continuation text and gobble the matched prompt from
522             the emitted output so you only have one complete piece of text returned, even
523             if split over many pages. The sent text can contain metacharacters such as
524             C<\n> for a newline.
525              
526             Note that in the above example the C<follow> statement should be seen as an
527             extension of the C<send> statement. There is still an implicit Match prompt
528             added at the end of this Macro, as per Automatic Matching, above.
529              
530             =item Line Endings
531              
532             Normally all sent command statements are appended with a newline (or the value
533             of C<ors>, if set). To suppress that feature, use the keyword C<put> instead
534             of C<send>. However this does not prevent the Format Interpolation via
535             C<sprintf> as described above (simply use C<"%%"> to get a literal C<"%">).
536              
537             =back
538              
539             =cut
540