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;
|