← Index
NYTProf Performance Profile   « line view »
For script/ponapi
  Run on Wed Feb 10 15:51:26 2016
Reported on Thu Feb 11 09:43:09 2016

Filename/usr/local/share/perl/5.18.2/App/Cmd/Command/commands.pm
StatementsExecuted 9 statements in 406µs
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11112µs26µsModule::Runtime::::BEGIN@1 Module::Runtime::BEGIN@1
11111µs11µsApp::Cmd::Command::commands::::BEGIN@7App::Cmd::Command::commands::BEGIN@7
1117µs13µsModule::Runtime::::BEGIN@2 Module::Runtime::BEGIN@2
1116µs6µsApp::Cmd::Command::commands::::BEGIN@6App::Cmd::Command::commands::BEGIN@6
0000s0sApp::Cmd::Command::commands::::executeApp::Cmd::Command::commands::execute
0000s0sApp::Cmd::Command::commands::::opt_specApp::Cmd::Command::commands::opt_spec
0000s0sApp::Cmd::Command::commands::::sort_commandsApp::Cmd::Command::commands::sort_commands
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1222µs241µ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
use strict;
# spent 26µs making 1 call to Module::Runtime::BEGIN@1 # spent 14µs making 1 call to strict::import
2233µs220µ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
use warnings;
# spent 13µs making 1 call to Module::Runtime::BEGIN@2 # spent 6µs making 1 call to warnings::import
3
4package App::Cmd::Command::commands;
51500ns$App::Cmd::Command::commands::VERSION = '0.330';
6236µs16µ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
use App::Cmd::Command;
# spent 6µs making 1 call to App::Cmd::Command::commands::BEGIN@6
71312µs111µ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
BEGIN { our @ISA = 'App::Cmd::Command' };
# 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
27sub 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
76sub 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
87sub opt_spec {
88 return (
89 [ 'stderr' => 'hidden' ],
90 );
91}
92
9312µs1;
94
95__END__