File: Command.pm

package info (click to toggle)
libcommandable-perl 0.14-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 228 kB
  • sloc: perl: 1,530; makefile: 2
file content (264 lines) | stat: -rw-r--r-- 6,002 bytes parent folder | download
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
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
#  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, 2021-2024 -- leonerd@leonerd.org.uk

package Commandable::Command 0.14;

use v5.26;
use warnings;
use experimental qw( signatures );

=head1 NAME

C<Commandable::Command> - represent metadata for an invokable command

=head1 DESCRIPTION

Objects in this class are returned by a L<Commandable::Finder> instance to
represent individual commands that exist.

=cut

sub new ( $class, %args )
{
   $args{arguments} //= [];
   $args{options}   //= {};
   bless [ @args{qw( name description arguments options package code )} ], $class;
}

=head1 ACCESSORS

The following simple methods return metadata fields about the command

=cut

=head2 name

=head2 description

   $name = $command->name;
   $desc = $command->description;

Strings giving the short name (to be used on a commandline), and descriptive
text for the command.

=head2 arguments

   @args = $command->arguments;

A (possibly-empty) list of argument metadata structures.

=head2 options

   %opts = $command->options;

A (possibly-empty) kvlist of option metadata structures.

=head2 package

   $pkg = $command->package;

The package name as a plain string.

=head2 code

   $sub = $command->code;

A CODE reference to the code actually implementing the command.

=cut

sub name        { shift->[0] }
sub description { shift->[1] }
sub arguments   { shift->[2]->@* }
sub options     { shift->[3]->%* }
sub package     { shift->[4] }
sub code        { shift->[5] }

=head1 METHODS

=cut

=head2 parse_invocation

I<Since version 0.12> this method has been moved to L<Commandable::Finder>.

=cut

package # hide
   Commandable::Command::_Argument;

=head1 ARGUMENT SPECIFICATIONS

Each argument specification is given by an object having the following structure:

=head2 name

=head2 description

   $name = $argspec->name;

   $desc = $argspec->description;

Text strings for the user, used to generate the help text.

=head2 optional

   $bool = $argspec->optional;

If false, the option is mandatory and an error is raised if no value is
provided for it. If true, it is optional and if absent an C<undef> will passed
instead.

=head2 slurpy

   $bool = $argspec->slurpy;

If true, the argument will be passed as an ARRAY reference containing the
entire remaining list of tokens provided by the user.

=cut

sub new ( $class, %args )
{
   bless [ @args{qw( name description optional slurpy )} ], $class;
}

sub name        { shift->[0] }
sub description { shift->[1] }
sub optional    { shift->[2] }
sub slurpy      { shift->[3] }

package # hide
   Commandable::Command::_Option;

=head1 OPTION SPECIFICATIONS

Each option specification is given by an object having the following
structure:

=head2 name

   $name = $optspec->name;

A string giving the primary human-readable name of the option.

=head2 keyname

   $keyname = $optspec->keyname;

A string giving the name this option will be given in the options hash
provided to the command subroutine. This is generated from the human-readable
name, but hyphens are converted to underscores, to make it simpler to use as a
hash key in Perl code.

=head2 names

   @names = $optspec->names;

A list containing the name plus all the aliases this option is known by.

=head2 description

   $desc = $optspec->description;

A text string containing information for the user, used to generate the help
text.

=head2 mode

   $mode = $optspec->mode;

A string that describes the behaviour of the option.

C<set> options do not expect a value to be suppled by the user, and will store a
true value in the options hash if present.

C<value> options take a value from the rest of the token, or the next token.

   --opt=value
   --opt value

C<multi_value> options can be supplied more than once; values are pushed into
an ARRAY reference which is passed in the options hash.

C<inc> options may be supplied more than once; each occurance will increment
the stored value by one.

=head2 default

   $val = $optspec->default;

A value to provide in the options hash if the user did not specify a different
one.

=head2 negatable

   $bool = $optspec->negatable;

If true, also accept a C<--no-OPT> option to reset the value of the option to
C<undef>.

=head2 typespec

I<Since version 0.13> no longer supported.

=head2 matches

   $re = $optspec->matches;

If defined, gives a precompiled regexp that any user-supplied value must
conform to.

A few shortcuts are provided, which are used if the provided name ends in
C<=i> (for "integer"), C<=u> (for "unsigned integer", i.e. non-negative) or
C<=f> (for "float").

=cut

my %typespecs = (
   i => [ "be an integer", qr/^-?\d+$/ ],
   u => [ "be a non-negative integer", qr/^\d+$/ ],
   f => [ "be a floating-point number", qr/^-?\d+(?:\.\d+)?$/ ],
);

sub new ( $class, %args )
{
   warn "Use of $args{name} in a Commandable command option name; should be " . $args{name} =~ s/:$/=/r
      if $args{name} =~ m/:$/;

   if( $args{name} =~ s/([=:])(.+?)$/$1/ ) {
      # Convert a type abbreviation
      my $typespec = $typespecs{$2} or
         die "Unrecognised typespec $2";

      ( $args{match_msg}, $args{matches} ) = @$typespec;
   }
   $args{mode} = "value" if $args{name} =~ s/[=:]$//;
   $args{mode} = "multi_value" if $args{multi};
   my @names = split m/\|/, delete $args{name};
   $args{mode} //= "set";
   $args{negatable} //= 1 if $args{mode} eq "bool";
   bless [ \@names, @args{qw( description mode default negatable matches match_msg )} ], $class;
}

sub name        { shift->[0]->[0] }
sub keyname     { shift->name =~ s/-/_/gr }
sub names       { shift->[0]->@* }
sub description { shift->[1] }
sub mode        { shift->[2] }
sub default     { shift->[3] }
sub negatable   { shift->[4] }
sub matches     { shift->[5] }
sub match_msg   { shift->[6] }

sub mode_expects_value { shift->mode =~ m/value$/ }

=head1 AUTHOR

Paul Evans <leonerd@leonerd.org.uk>

=cut

0x55AA;