File Coverage

blib/lib/Commandable/Invocation.pm
Criterion Covered Total %
statement 60 60 100.0
branch 11 12 91.6
condition 5 6 83.3
subroutine 12 12 100.0
pod 6 6 100.0
total 94 96 97.9


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