| 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 | Module::Runtime::BEGIN@1 |
| 1 | 1 | 1 | 11µs | 11µs | App::Cmd::Command::commands::BEGIN@7 |
| 1 | 1 | 1 | 7µs | 13µs | Module::Runtime::BEGIN@2 |
| 1 | 1 | 1 | 6µs | 6µs | App::Cmd::Command::commands::BEGIN@6 |
| 0 | 0 | 0 | 0s | 0s | App::Cmd::Command::commands::execute |
| 0 | 0 | 0 | 0s | 0s | App::Cmd::Command::commands::opt_spec |
| 0 | 0 | 0 | 0s | 0s | App::Cmd::Command::commands::sort_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__ |