File Coverage

blib/lib/App/Dochazka/CLI/Completion.pm
Criterion Covered Total %
statement 46 47 97.8
branch 8 12 66.6
condition 1 3 33.3
subroutine 9 9 100.0
pod 0 1 0.0
total 64 72 88.8


line stmt bran cond sub pod time code
1             # *************************************************************************
2             # Copyright (c) 2014-2016, SUSE LLC
3             #
4             # All rights reserved.
5             #
6             # Redistribution and use in source and binary forms, with or without
7             # modification, are permitted provided that the following conditions are met:
8             #
9             # 1. Redistributions of source code must retain the above copyright notice,
10             # this list of conditions and the following disclaimer.
11             #
12             # 2. Redistributions in binary form must reproduce the above copyright
13             # notice, this list of conditions and the following disclaimer in the
14             # documentation and/or other materials provided with the distribution.
15             #
16             # 3. Neither the name of SUSE LLC nor the names of its contributors may be
17             # used to endorse or promote products derived from this software without
18             # specific prior written permission.
19             #
20             # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
21             # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
22             # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
23             # ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
24             # LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
25             # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
26             # SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
27             # INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
28             # CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
29             # ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
30             # POSSIBILITY OF SUCH DAMAGE.
31             # *************************************************************************
32             #
33             # custom completion module
34             #
35             package App::Dochazka::CLI::Completion;
36              
37 1     1   17324 use 5.012;
  1         2  
38 1     1   3 use strict;
  1         1  
  1         14  
39 1     1   2 use warnings;
  1         1  
  1         18  
40              
41 1     1   382 use App::CELL qw( $log );
  1         54977  
  1         83  
42 1     1   396 use App::Dochazka::CLI::Parser qw( parse possible_words );
  1         2  
  1         56  
43 1     1   4 use App::Dochazka::CLI::TokenMap qw( $completion_map $token_map );
  1         1  
  1         72  
44 1     1   3 use Data::Dumper;
  1         1  
  1         38  
45 1     1   3 use Exporter 'import';
  1         1  
  1         269  
46              
47              
48             =head1 NAME
49              
50             App::Dochazka::CLI::Completion - Completion module
51              
52             =cut
53              
54             our @EXPORT_OK = qw(
55             dochazka_cli_completion
56             );
57              
58             sub dochazka_cli_completion {
59 3     3 0 4511 my ( $text, $line, $start ) = @_;
60             #
61             # $text is the current token
62             # $line is the entire line of user input
63             # $start is offset of $text within $line
64             #
65 3         26 $log->debug( "text $text line ->$line<- start $start" );
66              
67 3         3040 my $rv = parse( $line );
68             #
69             # $rv->{ts} is the token stack
70             # $rv->{th} is hash of user-entered strings for each token
71             # $rv->{th}->{_REST} is the unrecognized part
72             # $rv->{nc} is the normalized command
73             #
74             #$log->debug( Dumper $rv );
75              
76             # if _REST contains more than one token, nothing to do
77 3 100       9 if ( split( ' ', $rv->{th}->{_REST} ) > 1 ) {
78             #$log->debug( "Command not recognized: do nothing" );
79 1         5 return;
80             }
81              
82             # if $line ends in '=', do nothing
83 2 50       5 if ( $line =~ m/=$/ ) {
84 0         0 return;
85             }
86              
87             # if there is no $text, match everything
88 2 50       4 $text = '.*' unless $text;
89              
90             # get matching words
91 2         131 my @matches = grep( /^$text/i, keys %$completion_map );
92             #$log->debug( "Matches: " . Dumper( \@matches ) );
93              
94             # possibly adjust token stack
95 2         6 my @ts = @{ $rv->{ts} };
  2         5  
96 2 50 33     5 pop( @ts ) unless $rv->{th}->{_REST} or $line =~ m/ $/;
97             #$log->debug( "Token stack: " . Dumper( \@ts ) );
98              
99             # get permissible tokens in this position
100 2         6 my $permissibles = possible_words( \@ts );
101             #$log->debug( "Permissibles: " . Dumper( $permissibles ) );
102            
103             # construct list of regexes
104 2         4 my @regexes_of_permissibles = ();
105 2         4 foreach my $permissible ( @$permissibles ) {
106 28 50       31 if ( exists( $token_map->{$permissible} ) ) {
107 28         27 push @regexes_of_permissibles, $token_map->{$permissible};
108             }
109             }
110             #$log->debug( "Regexes of permissibles: " . Dumper( \@regexes_of_permissibles ) );
111              
112             # return only those words that match
113 2         3 my @result = ();
114 2         3 foreach my $match ( @matches ) {
115             # does it match one of the permissibles?
116             #$log->debug( "Considering $match" );
117 14 100       14 if ( grep { $match =~ $_; } ( @regexes_of_permissibles ) ) {
  146         899  
118             #$log->debug( "Matches one of the permissible regexes!" );
119 4         8 push( @result, $match )
120             } else {
121             #$log->debug( "(no match)" );
122             }
123             }
124 2         7 $log->debug( "Result: " . Dumper( \@result ) );
125              
126 2         205 return @result;
127             }
128              
129             1;