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