File Coverage

blib/lib/App/Cmd/Simple.pm
Criterion Covered Total %
statement 55 56 98.2
branch 7 10 70.0
condition 4 6 66.6
subroutine 17 18 94.4
pod 1 1 100.0
total 84 91 92.3


line stmt bran cond sub pod time code
1 5     5   12348 use strict;
  5         11  
  5         147  
2 5     5   24 use warnings;
  5         11  
  5         203  
3              
4             package App::Cmd::Simple 0.336;
5              
6 5     5   2318 use App::Cmd::Command;
  5         12  
  5         193  
7 5     5   208 BEGIN { our @ISA = 'App::Cmd::Command' }
8              
9             # ABSTRACT: a helper for building one-command App::Cmd applications
10              
11 5     5   2491 use App::Cmd;
  5         18  
  5         26  
12 5     5   1114 use Sub::Install;
  5         13  
  5         37  
13              
14             #pod =head1 SYNOPSIS
15             #pod
16             #pod in F:
17             #pod
18             #pod use YourApp::Cmd;
19             #pod Your::Cmd->run;
20             #pod
21             #pod in F:
22             #pod
23             #pod package YourApp::Cmd 0.01;
24             #pod use parent qw(App::Cmd::Simple);
25             #pod
26             #pod sub opt_spec {
27             #pod return (
28             #pod [ "blortex|X", "use the blortex algorithm" ],
29             #pod [ "recheck|r", "recheck all results" ],
30             #pod );
31             #pod }
32             #pod
33             #pod sub validate_args {
34             #pod my ($self, $opt, $args) = @_;
35             #pod
36             #pod # no args allowed but options!
37             #pod $self->usage_error("No args allowed") if @$args;
38             #pod }
39             #pod
40             #pod sub execute {
41             #pod my ($self, $opt, $args) = @_;
42             #pod
43             #pod my $result = $opt->{blortex} ? blortex() : blort();
44             #pod
45             #pod recheck($result) if $opt->{recheck};
46             #pod
47             #pod print $result;
48             #pod }
49             #pod
50             #pod and, finally, at the command line:
51             #pod
52             #pod knight!rjbs$ simplecmd --recheck
53             #pod
54             #pod All blorts successful.
55             #pod
56             #pod =head1 SUBCLASSING
57             #pod
58             #pod When writing a subclass of App::Cmd:Simple, there are only a few methods that
59             #pod you might want to implement. They behave just like the same-named methods in
60             #pod App::Cmd.
61             #pod
62             #pod =head2 opt_spec
63             #pod
64             #pod This method should be overridden to provide option specifications. (This is
65             #pod list of arguments passed to C from Getopt::Long::Descriptive,
66             #pod after the first.)
67             #pod
68             #pod If not overridden, it returns an empty list.
69             #pod
70             #pod =head2 usage_desc
71             #pod
72             #pod This method should be overridden to provide the top level usage line.
73             #pod It's a one-line summary of how the command is to be invoked, and
74             #pod should be given in the format used for the C<$usage_desc> parameter to
75             #pod C in Getopt::Long::Descriptive.
76             #pod
77             #pod If not overridden, it returns something that prints out like:
78             #pod
79             #pod yourapp [-?h] [long options...]
80             #pod
81             #pod =head2 validate_args
82             #pod
83             #pod $cmd->validate_args(\%opt, \@args);
84             #pod
85             #pod This method is passed a hashref of command line options (as processed by
86             #pod Getopt::Long::Descriptive) and an arrayref of leftover arguments. It may throw
87             #pod an exception (preferably by calling C) if they are invalid, or it
88             #pod may do nothing to allow processing to continue.
89             #pod
90             #pod =head2 execute
91             #pod
92             #pod Your::App::Cmd::Simple->execute(\%opt, \@args);
93             #pod
94             #pod This method does whatever it is the command should do! It is passed a hash
95             #pod reference of the parsed command-line options and an array reference of left
96             #pod over arguments.
97             #pod
98             #pod =cut
99              
100             # The idea here is that the user will someday replace "Simple" in his ISA with
101             # "Command" and then write a standard App::Cmd package. To make that possible,
102             # we produce a behind-the-scenes App::Cmd object when the user says 'use
103             # MyApp::Simple' and redirect MyApp::Simple->run to that.
104             my $i;
105 5     5   682 BEGIN { $i = 0 }
106              
107             sub import {
108 5     5   46953 my ($class) = @_;
109 5 50       27 return if $class eq __PACKAGE__;
110              
111             # This signals that something has already set the target up.
112 5 50       35 return $class if $class->_cmd_pkg;
113              
114 5         62 my $core_execute = App::Cmd::Command->can('execute');
115 5         33 my $our_execute = $class->can('execute');
116 5 50 33     43 Carp::confess(
117             "App::Cmd::Simple subclasses must implement ->execute, not ->run"
118             ) unless $our_execute and $our_execute != $core_execute;
119              
120             # I doubt the $i will ever be needed, but let's start paranoid.
121 5         27 my $generated_name = join('::', $class, '_App_Cmd', $i++);
122              
123             {
124 5     5   29 no strict 'refs';
  5         13  
  5         1230  
  5         12  
125 5         13 *{$generated_name . '::ISA'} = [ 'App::Cmd' ];
  5         85  
126             }
127              
128             Sub::Install::install_sub({
129             into => $class,
130             as => '_cmd_pkg',
131 0     0   0 code => sub { $generated_name },
132 5         57 });
133              
134             Sub::Install::install_sub({
135             into => $class,
136             as => 'command_names',
137 5     5   20 code => sub { 'only' },
138 5         412 });
139              
140             Sub::Install::install_sub({
141             into => $generated_name,
142             as => '_plugins',
143 5     5   22 code => sub { $class },
144 5         261 });
145              
146             Sub::Install::install_sub({
147             into => $generated_name,
148             as => 'default_command',
149 6     6   27 code => sub { 'only' },
150 5         251 });
151              
152             Sub::Install::install_sub({
153             into => $generated_name,
154             as => '_cmd_from_args',
155             code => sub {
156 6     6   19 my ($self, $args) = @_;
157 6 100       28 if (defined(my $command = $args->[0])) {
158 5         40 my $plugin = $self->plugin_for($command);
159             # If help was requested, show the help for the command, not the
160             # main help. Because the main help would talk about subcommands,
161             # and a "Simple" app has no subcommands.
162 5 100 100     44 if (
163             $plugin
164 6         17 and grep { $plugin eq $self->plugin_for($_) } qw(help version)
165             ) {
166 2         9 return ($command, [ $self->default_command ]);
167             }
168             # Any other value for "command" isn't really a command at all --
169             # it's the first argument. So call the default command instead.
170             }
171 4         18 return ($self->default_command, $args);
172             },
173 5         251 });
174              
175             {
176 5     5   42 no strict 'refs';
  5         10  
  5         876  
  5         209  
177 5         73 *{ "$generated_name\::VERSION" } = \$class->VERSION;
  5         37  
178             }
179              
180             Sub::Install::install_sub({
181             into => $class,
182             as => 'run',
183             code => sub {
184 5     5   78 $generated_name->new({
185             no_help_plugin => 0,
186             no_version_plugin => 0,
187             no_commands_plugin => 1,
188             })->run(@_);
189             }
190 5         42 });
191              
192 5         6589 return $class;
193             }
194              
195             sub usage_desc {
196 4     4 1 21 return "%c %o"
197             }
198              
199       5     sub _cmd_pkg { }
200              
201             #pod =head1 WARNINGS
202             #pod
203             #pod B Although it is probably not going
204             #pod to change much, don't build your business model around it yet, okay?
205             #pod
206             #pod App::Cmd::Simple is not rich in black magic, but it does do some somewhat
207             #pod gnarly things to make an App::Cmd::Simple look as much like an
208             #pod App::Cmd::Command as possible. This means that you can't deviate too much from
209             #pod the sort of thing shown in the synopsis as you might like. If you're doing
210             #pod something other than writing a fairly simple command, and you want to screw
211             #pod around with the App::Cmd-iness of your program, Simple might not be the best
212             #pod choice.
213             #pod
214             #pod B if you are writing a program with the
215             #pod App::Cmd::Simple class embedded in it, you B call import on the class.
216             #pod That's how things work. You can just do this:
217             #pod
218             #pod YourApp::Cmd->import->run;
219             #pod
220             #pod =cut
221              
222             1;
223              
224             __END__