Filename | /usr/local/share/perl/5.18.2/App/Cmd/Command/commands.pm |
Statements | Executed 9 statements in 406µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 12µs | 26µs | BEGIN@1 | Module::Runtime::
1 | 1 | 1 | 11µs | 11µs | BEGIN@7 | App::Cmd::Command::commands::
1 | 1 | 1 | 7µs | 13µs | BEGIN@2 | Module::Runtime::
1 | 1 | 1 | 6µs | 6µs | BEGIN@6 | App::Cmd::Command::commands::
0 | 0 | 0 | 0s | 0s | execute | App::Cmd::Command::commands::
0 | 0 | 0 | 0s | 0s | opt_spec | App::Cmd::Command::commands::
0 | 0 | 0 | 0s | 0s | sort_commands | App::Cmd::Command::commands::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | 2 | 22µs | 2 | 41µs | # spent 26µs (12+14) within Module::Runtime::BEGIN@1 which was called:
# once (12µs+14µs) by Module::Runtime::require_module at line 1 # spent 26µs making 1 call to Module::Runtime::BEGIN@1
# spent 14µs making 1 call to strict::import |
2 | 2 | 33µs | 2 | 20µs | # spent 13µs (7+6) within Module::Runtime::BEGIN@2 which was called:
# once (7µs+6µs) by Module::Runtime::require_module at line 2 # spent 13µs making 1 call to Module::Runtime::BEGIN@2
# spent 6µs making 1 call to warnings::import |
3 | |||||
4 | package App::Cmd::Command::commands; | ||||
5 | 1 | 500ns | $App::Cmd::Command::commands::VERSION = '0.330'; | ||
6 | 2 | 36µs | 1 | 6µs | # spent 6µs within App::Cmd::Command::commands::BEGIN@6 which was called:
# once (6µs+0s) by Module::Runtime::require_module at line 6 # spent 6µs making 1 call to App::Cmd::Command::commands::BEGIN@6 |
7 | 1 | 312µs | 1 | 11µs | # spent 11µs within App::Cmd::Command::commands::BEGIN@7 which was called:
# once (11µs+0s) by Module::Runtime::require_module at line 7 # spent 11µs making 1 call to App::Cmd::Command::commands::BEGIN@7 |
8 | |||||
9 | # ABSTRACT: list the application's commands | ||||
10 | |||||
11 | #pod =head1 DESCRIPTION | ||||
12 | #pod | ||||
13 | #pod This command will list all of the application commands available and their | ||||
14 | #pod abstracts. | ||||
15 | #pod | ||||
16 | #pod =method execute | ||||
17 | #pod | ||||
18 | #pod This is the command's primary method and raison d'etre. It prints the | ||||
19 | #pod application's usage text (if any) followed by a sorted listing of the | ||||
20 | #pod application's commands and their abstracts. | ||||
21 | #pod | ||||
22 | #pod The commands are printed in sorted groups (created by C<sort_commands>); each | ||||
23 | #pod group is set off by blank lines. | ||||
24 | #pod | ||||
25 | #pod =cut | ||||
26 | |||||
27 | sub execute { | ||||
28 | my ($self, $opt, $args) = @_; | ||||
29 | |||||
30 | my $target = $opt->stderr ? *STDERR : *STDOUT; | ||||
31 | |||||
32 | my @cmd_groups = $self->app->command_groups; | ||||
33 | my @primary_commands = map { @$_ if ref $_ } @cmd_groups; | ||||
34 | |||||
35 | if (!@cmd_groups) { | ||||
36 | @primary_commands = | ||||
37 | grep { $_ ne 'version' or $self->app->{show_version} } | ||||
38 | map { ($_->command_names)[0] } | ||||
39 | $self->app->command_plugins; | ||||
40 | |||||
41 | @cmd_groups = $self->sort_commands(@primary_commands); | ||||
42 | } | ||||
43 | |||||
44 | my $fmt_width = 0; | ||||
45 | for (@primary_commands) { $fmt_width = length if length > $fmt_width } | ||||
46 | $fmt_width += 2; # pretty | ||||
47 | |||||
48 | foreach my $cmd_set (@cmd_groups) { | ||||
49 | if (!ref $cmd_set) { | ||||
50 | print { $target } "$cmd_set:\n"; | ||||
51 | next; | ||||
52 | } | ||||
53 | for my $command (@$cmd_set) { | ||||
54 | my $abstract = $self->app->plugin_for($command)->abstract; | ||||
55 | printf { $target } "%${fmt_width}s: %s\n", $command, $abstract; | ||||
56 | } | ||||
57 | print { $target } "\n"; | ||||
58 | } | ||||
59 | } | ||||
60 | |||||
61 | #pod =method C<sort_commands> | ||||
62 | #pod | ||||
63 | #pod my @sorted = $cmd->sort_commands(@unsorted); | ||||
64 | #pod | ||||
65 | #pod This method orders the list of commands into groups which it returns as a list of | ||||
66 | #pod arrayrefs, and optional group header strings. | ||||
67 | #pod | ||||
68 | #pod By default, the first group is for the "help" and "commands" commands, and all | ||||
69 | #pod other commands are in the second group. | ||||
70 | #pod | ||||
71 | #pod This method can be overridden by implementing the C<commands_groups> method in | ||||
72 | #pod your application base clase. | ||||
73 | #pod | ||||
74 | #pod =cut | ||||
75 | |||||
76 | sub sort_commands { | ||||
77 | my ($self, @commands) = @_; | ||||
78 | |||||
79 | my $float = qr/^(?:help|commands)$/; | ||||
80 | |||||
81 | my @head = sort grep { $_ =~ $float } @commands; | ||||
82 | my @tail = sort grep { $_ !~ $float } @commands; | ||||
83 | |||||
84 | return (\@head, \@tail); | ||||
85 | } | ||||
86 | |||||
87 | sub opt_spec { | ||||
88 | return ( | ||||
89 | [ 'stderr' => 'hidden' ], | ||||
90 | ); | ||||
91 | } | ||||
92 | |||||
93 | 1 | 2µs | 1; | ||
94 | |||||
95 | __END__ |