File Coverage

blib/lib/Commandable/Finder/Packages.pm
Criterion Covered Total %
statement 62 62 100.0
branch 15 16 93.7
condition 12 20 60.0
subroutine 11 11 100.0
pod 3 4 75.0
total 103 113 91.1


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, 2019-2023 -- leonerd@leonerd.org.uk
5              
6             package Commandable::Finder::Packages 0.10;
7              
8 7     7   912046 use v5.14;
  7         58  
9 7     7   40 use warnings;
  7         15  
  7         198  
10 7     7   35 use base qw( Commandable::Finder );
  7         15  
  7         2681  
11              
12 7     7   49 use Carp;
  7         15  
  7         396  
13              
14 7     7   2346 use Commandable::Command;
  7         29  
  7         223  
15 7     7   3394 use Module::Pluggable::Object;
  7         65707  
  7         4439  
16              
17             =head1 NAME
18              
19             C - find commands stored per package
20              
21             =head1 SYNOPSIS
22              
23             use Commandable::Finder::Packages;
24              
25             my $finder = Commandable::Finder::Packages->new(
26             base => "MyApp::Command",
27             );
28              
29             my $help_command = $finder->find_command( "help" );
30              
31             foreach my $command ( $finder->find_commands ) {
32             ...
33             }
34              
35             =head1 DESCRIPTION
36              
37             This implementation of L looks for implementations of
38             commands, where each command is implemented by a different package somewhere
39             in the symbol table.
40              
41             This class uses L to load packages from the filesystem.
42             As commands are located per package (and not per file), the application can
43             provide special-purpose internal commands by implementing more packages in the
44             given namespace, regardless of which files they come from.
45              
46             =head1 CONSTANTS
47              
48             package My::App::Commands::example;
49              
50             use constant COMMAND_NAME => "example";
51             use constant COMMAND_DESC => "an example of a command";
52              
53             ...
54              
55             Properties about each command are stored as methods (usually constant methods)
56             within each package. Often the L pragma module is used to create
57             them.
58              
59             The following constant names are used by default:
60              
61             =head2 COMMAND_NAME
62              
63             use constant COMMAND_NAME => "name";
64              
65             Gives a string name for the command.
66              
67             =head2 COMMAND_DESC
68              
69             use constant COMMAND_DESC => "description";
70              
71             Gives a string description for the command.
72              
73             =head2 COMMAND_ARGS
74              
75             use constant COMMAND_ARGS => (
76             { name => "argname", description => "description" },
77             );
78              
79             Gives a list of command argument specifications. Each specification is a HASH
80             reference corresponding to one positional argument, and should contain keys
81             named C, C, and optionally C.
82              
83             =head2 COMMAND_OPTS
84              
85             use constant COMMAND_OPTS => (
86             { name => "optname", description => "description" },
87             );
88              
89             Gives a list of command option specifications. Each specification is a HASH
90             reference giving one named option, in no particular order, and should contain
91             keys named C, C and optionally C, C and
92             C.
93              
94             =cut
95              
96             =head1 CONSTRUCTOR
97              
98             =cut
99              
100             =head2 new
101              
102             $finder = Commandable::Finder::Packages->new( %args )
103              
104             Constructs a new instance of C.
105              
106             Takes the following named arguments:
107              
108             =over 4
109              
110             =item base => STR
111              
112             The base of the package namespace to look inside for packages that implement
113             commands.
114              
115             =item name_method => STR
116              
117             Optional. Gives the name of the method inside each command package to invoke
118             to generate the name of the command. Default C.
119              
120             =item description_method => STR
121              
122             Optional. Gives the name of the method inside each command package to invoke
123             to generate the description text of the command. Default C.
124              
125             =item arguments_method => STR
126              
127             Optional. Gives the name of the method inside each command package to invoke
128             to generate a list of argument specifications. Default C.
129              
130             =item options_method => STR
131              
132             Optional. Gives the name of the method inside each command package to invoke
133             to generate a list of option specifications. Default C.
134              
135             =item code_method => STR
136              
137             Optional. Gives the name of the method inside each command package which
138             implements the actual command behaviour. Default C.
139              
140             =item named_by_package => BOOL
141              
142             Optional. If true, the name of each command will be taken from its package
143             name. with the leading C string removed. If absent or false, the
144             C will be used instead.
145              
146             =back
147              
148             If either name or description method are missing from a package, that package
149             is silently ignored.
150              
151             Any additional arguments are passed to the C method to be used as
152             configuration options.
153              
154             =cut
155              
156             sub new
157             {
158 6     6 1 561 my $class = shift;
159 6         30 my %args = @_;
160              
161 6 50       35 my $base = ( delete $args{base} ) or croak "Require 'base'";
162              
163 6   50     48 my $name_method = ( delete $args{name_method} ) // "COMMAND_NAME";
164 6   50     39 my $description_method = ( delete $args{description_method} ) // "COMMAND_DESC";
165 6   50     34 my $arguments_method = ( delete $args{arguments_method} ) // "COMMAND_ARGS";
166 6   50     33 my $options_method = ( delete $args{options_method} ) // "COMMAND_OPTS";
167 6   50     37 my $code_method = ( delete $args{code_method} ) // "run"; # App-csvtool
168              
169 6 100       35 undef $name_method if delete $args{named_by_package};
170              
171 6         65 my $mp = Module::Pluggable::Object->new(
172             search_path => $base,
173             require => 1,
174             );
175              
176 6         114 my $self = bless {
177             mp => $mp,
178             base => $base,
179             methods => {
180             name => $name_method,
181             desc => $description_method,
182             args => $arguments_method,
183             opts => $options_method,
184             code => $code_method,
185             },
186             }, $class;
187              
188 6 100       33 $self->configure( %args ) if %args;
189              
190 6         23 return $self;
191             }
192              
193             sub packages
194             {
195 6     6 0 13 my $self = shift;
196              
197 6         17 my $name_method = $self->{methods}{name};
198              
199 6   50     47 my $packages = $self->{cache_packages} //= [ $self->{mp}->plugins ];
200              
201 6         5750 return @$packages;
202             }
203              
204             sub _commands
205             {
206 28     28   46 my $self = shift;
207              
208 28         84 my $name_method = $self->{methods}{name};
209 28   66     139 return $self->{cache_commands} //= do {
210 6         13 my %commands;
211 6         23 foreach my $pkg ( $self->packages ) {
212 16 100 100     218 next if defined $name_method and not $pkg->can( $name_method );
213              
214 15 100       98 my $name = defined $name_method
215             ? $pkg->$name_method
216             : ( $pkg =~ s/\Q$self->{base}\E:://r );
217              
218 15 100       123 my $code = $pkg->can( $self->{methods}{code} ) or next;
219              
220 14   50     100 my $desc = ( $pkg->can( $self->{methods}{desc} ) or next )->( $pkg );
221              
222 14         25 my $args;
223 14 100       87 if( my $argsmeth = $pkg->can( $self->{methods}{args} ) ) {
224             $args = [
225 7         22 map { Commandable::Command::_Argument->new( %$_ ) } $pkg->$argsmeth
  7         71  
226             ];
227             }
228              
229 14         30 my $opts;
230 14 100       94 if( my $optsmeth = $pkg->can( $self->{methods}{opts} ) ) {
231             $opts = {
232 6         25 map { my $o = Commandable::Command::_Option->new( %$_ );
  12         74  
233 12         68 map { ( $_ => $o ) } $o->names
  18         109  
234             } $pkg->$optsmeth
235             };
236             }
237              
238 14         72 $commands{ $name } = Commandable::Command->new(
239             name => $name,
240             description => $desc,
241             arguments => $args,
242             options => $opts,
243              
244             package => $pkg,
245             code => $code,
246             );
247             }
248              
249 6         54 $self->add_builtin_commands( \%commands );
250              
251 6         45 \%commands;
252             };
253             }
254              
255             sub find_commands
256             {
257 3     3 1 14 my $self = shift;
258              
259 3         15 return values %{ $self->_commands };
  3         12  
260             }
261              
262             sub find_command
263             {
264 25     25 1 10569 my $self = shift;
265 25         55 my ( $cmd ) = @_;
266              
267 25         69 return $self->_commands->{$cmd};
268             }
269              
270             =head1 AUTHOR
271              
272             Paul Evans
273              
274             =cut
275              
276             0x55AA;