File Coverage

blib/lib/Commandable/Invocation.pm
Criterion Covered Total %
statement 40 40 100.0
branch 11 12 91.6
condition 5 6 83.3
subroutine 11 11 100.0
pod 6 6 100.0
total 73 75 97.3


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2018 -- leonerd@leonerd.org.uk
5              
6             package Commandable::Invocation 0.10;
7              
8 5     5   698627 use v5.14;
  5         42  
9 5     5   27 use warnings;
  5         10  
  5         3416  
10              
11             =head1 NAME
12              
13             C - represents one invocation of a CLI command
14              
15             =head1 SYNOPSIS
16              
17             my %commands = (
18             exit => sub { exit },
19             print => sub { print $_[0]->peek_remaining },
20             ...
21             );
22              
23             while(1) {
24             my $inv = Commmandable::Invocation->new( scalar );
25              
26             $commands{ $inv->pull_token }->( $inv );
27             }
28              
29             =head1 DESCRIPTION
30              
31             Instances of this class represent the text of a single invocation of a CLI
32             command, allowing it to be incrementally parsed and broken into individual
33             tokens during dispatch and invocation.
34              
35             =head2 Tokens
36              
37             When parsing for the next token, strings quoted using quote marks (C<"">) will
38             be retained as a single token. Otherwise, tokens are split on (non-preserved)
39             whitespace.
40              
41             Quote marks and backslashes may be escaped using C<\> characters.
42              
43             =cut
44              
45             =head1 CONSTRUCTOR
46              
47             =cut
48              
49             =head2 new
50              
51             $inv = Commandable::Invocation->new( $text )
52              
53             Constructs a new instance, initialised to contain the given text string.
54              
55             =cut
56              
57             sub new
58             {
59 30     30 1 12076 my $class = shift;
60 30         64 my ( $text ) = @_;
61              
62 30         99 $text =~ s/^\s+//;
63              
64 30         145 return bless {
65             text => $text,
66             }, $class;
67             }
68              
69             =head2 new_from_tokens
70              
71             $inv = Commandable::Invocation->new_from_tokens( @tokens )
72              
73             I
74              
75             Constructs a new instance, initialised to contain text from the given tokens,
76             such that subsequent calls to L will yield the given list of
77             tokens. This may be handy for constructing instances from C<@ARGV> or similar
78             cases where text has already been parsed and split into tokens.
79              
80             =cut
81              
82             sub new_from_tokens
83             {
84 1     1 1 401 my $class = shift;
85 1         6 my ( @tokens ) = @_;
86              
87 1         5 my $self = $class->new( "" );
88 1         5 $self->putback_tokens( @tokens );
89              
90 1         3 return $self;
91             }
92              
93             =head1 METHODS
94              
95             =cut
96              
97             sub _next_token
98             {
99 76     76   114 my $self = shift;
100              
101 76 100       186 if( $self->{text} =~ m/^"/ ) {
102             $self->{text} =~ m/^"((?:\\.|[^"])*)"\s*/ and
103 3 50       44 $self->{trim_pos} = $+[0], return $self->_unescape( $1 );
104             }
105             else {
106             $self->{text} =~ m/^(\S+)\s*/ and
107 73 100       377 $self->{trim_pos} = $+[0], return $self->_unescape( $1 );
108             }
109              
110 24         88 return undef;
111             }
112              
113             sub _escape
114             {
115 11     11   17 my $self = shift;
116 11         22 my ( $s ) = @_;
117              
118 11         21 $s =~ s/["\\]/\\$1/g;
119              
120 11         24 return $s;
121             }
122              
123             sub _unescape
124             {
125 52     52   92 my $self = shift;
126 52         124 my ( $s ) = @_;
127              
128 52         112 $s =~ s/\\(["\\])/$1/g;
129              
130 52         216 return $s;
131             }
132              
133             =head2 peek_token
134              
135             $token = $inv->peek_token
136              
137             Looks at, but does not remove, the next token in the text string. Subsequent
138             calls to this method will yield the same string, as will the next call to
139             L.
140              
141             =cut
142              
143             sub peek_token
144             {
145 3     3 1 10 my $self = shift;
146              
147 3   66     18 return $self->{next_token} //= $self->_next_token;
148             }
149              
150             =head2 pull_token
151              
152             $token = $inv->pull_token
153              
154             Removes the next token from the text string and returns it.
155              
156             =cut
157              
158             sub pull_token
159             {
160 75     75 1 139 my $self = shift;
161              
162 75   100     245 my $token = $self->{next_token} //= $self->_next_token;
163              
164 75 100       220 substr $self->{text}, 0, $self->{trim_pos}, "" if defined $token;
165 75         130 undef $self->{next_token};
166              
167 75         240 return $token;
168             }
169              
170             =head2 peek_remaining
171              
172             $text = $inv->peek_remaining
173              
174             I
175              
176             Returns the entire unparsed content of the rest of the text string.
177              
178             =cut
179              
180             sub peek_remaining
181             {
182 26     26 1 92 my $self = shift;
183              
184 26         117 return $self->{text};
185             }
186              
187             =head2 putback_tokens
188              
189             $inv->putback_tokens( @tokens )
190              
191             I
192              
193             Prepends text back onto the stored text string such that subsequent calls to
194             L will yield the given list of tokens once more. This takes care
195             to quote tokens with spaces inside, and escape any embedded backslashes or
196             quote marks.
197              
198             This method is intended to be used, for example, around a commandline option
199             parser which handles mixed options and arguments, to put back the non-option
200             positional arguments after the options have been parsed and removed from it.
201              
202             =cut
203              
204             sub putback_tokens
205             {
206 18     18 1 47 my $self = shift;
207              
208             $self->{text} = join " ",
209             ( map {
210 11         33 my $s = $self->_escape( $_ );
211 11 100       56 $s =~ m/ / ? qq("$s") : $s
212             } @_ ),
213 18 100       101 ( length $self->{text} ? $self->{text} : () );
214             }
215              
216             =head1 AUTHOR
217              
218             Paul Evans
219              
220             =cut
221              
222             0x55AA;