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