Profile of Getopt/Long/Descriptive/Usage.pm

← 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/Getopt/Long/Descriptive/Usage.pm
Statements | Executed 20 statements in 675µs

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
2 | 1 | 1 | 13µs | 13µs | Getopt::Long::Descriptive::Usage::::newGetopt::Long::Descriptive::Usage::new
1 | 1 | 1 | 12µs | 43µs | Getopt::Long::Descriptive::Usage::::BEGIN@171Getopt::Long::Descriptive::Usage::BEGIN@171
1 | 1 | 1 | 11µs | 42µs | Getopt::Long::Descriptive::Usage::::BEGIN@6Getopt::Long::Descriptive::Usage::BEGIN@6
1 | 1 | 1 | 10µs | 20µs | Getopt::Long::Descriptive::::BEGIN@1.16 Getopt::Long::Descriptive::BEGIN@1.16
1 | 1 | 1 | 7µs | 10µs | Getopt::Long::Descriptive::::BEGIN@2.17 Getopt::Long::Descriptive::BEGIN@2.17
0 | 0 | 0 | 0s | 0s | Getopt::Long::Descriptive::Usage::::__ANON__[:179]Getopt::Long::Descriptive::Usage::__ANON__[:179]
0 | 0 | 0 | 0s | 0s | Getopt::Long::Descriptive::Usage::::__ANON__[:180]Getopt::Long::Descriptive::Usage::__ANON__[:180]
0 | 0 | 0 | 0s | 0s | Getopt::Long::Descriptive::Usage::::_split_descriptionGetopt::Long::Descriptive::Usage::_split_description
0 | 0 | 0 | 0s | 0s | Getopt::Long::Descriptive::Usage::::dieGetopt::Long::Descriptive::Usage::die
0 | 0 | 0 | 0s | 0s | Getopt::Long::Descriptive::Usage::::leader_textGetopt::Long::Descriptive::Usage::leader_text
0 | 0 | 0 | 0s | 0s | Getopt::Long::Descriptive::Usage::::option_textGetopt::Long::Descriptive::Usage::option_text
0 | 0 | 0 | 0s | 0s | Getopt::Long::Descriptive::Usage::::textGetopt::Long::Descriptive::Usage::text
0 | 0 | 0 | 0s | 0s | Getopt::Long::Descriptive::Usage::::warnGetopt::Long::Descriptive::Usage::warn

Call graph for these subroutines as a Graphviz dot language file.

Line | State ments | Time on line | Calls | Time in subs | Code
--- | --- | --- | --- | --- | ---
1 | 2 | 21µs | 2 | 31µs | # spent 20µs (10+11) within Getopt::Long::Descriptive::BEGIN@1.16 which was called: # once (10µs+11µs) by Getopt::Long::Descriptive::BEGIN@14 at line 1 use strict; # spent 20µs making 1 call to Getopt::Long::Descriptive::BEGIN@1.16 # spent 11µs making 1 call to strict::import
2 | 2 | 40µs | 2 | 14µs | # spent 10µs (7+3) within Getopt::Long::Descriptive::BEGIN@2.17 which was called: # once (7µs+3µs) by Getopt::Long::Descriptive::BEGIN@14 at line 2 use warnings; # spent 10µs making 1 call to Getopt::Long::Descriptive::BEGIN@2.17 # spent 4µs making 1 call to warnings::import
3 |  |  |  |  | package Getopt::Long::Descriptive::Usage;
4 |  |  |  |  | # ABSTRACT: the usage description for GLD
5 | 1 | 700ns |  |  | $Getopt::Long::Descriptive::Usage::VERSION = '0.097';
6 | 2 | 572µs | 2 | 50µs | # spent 42µs (11+31) within Getopt::Long::Descriptive::Usage::BEGIN@6 which was called: # once (11µs+31µs) by Getopt::Long::Descriptive::BEGIN@14 at line 6 use List::Util qw(max); # spent 42µs making 1 call to Getopt::Long::Descriptive::Usage::BEGIN@6 # spent 8µs making 1 call to List::Util::import
7 |  |  |  |  |
8 |  |  |  |  | # =head1 SYNOPSIS
9 |  |  |  |  | #
10 |  |  |  |  | # use Getopt::Long::Descriptive;
11 |  |  |  |  | # my ($opt, $usage) = describe_options( ... );
12 |  |  |  |  | #
13 |  |  |  |  | # $usage->text; # complete usage message
14 |  |  |  |  | #
15 |  |  |  |  | # $usage->die; # die with usage message
16 |  |  |  |  | #
17 |  |  |  |  | # =head1 DESCRIPTION
18 |  |  |  |  | #
19 |  |  |  |  | # This document only describes the methods of the Usage object. For information
20 |  |  |  |  | # on how to use L<Getopt::Long::Descriptive>, consult its documentation.
21 |  |  |  |  | #
22 |  |  |  |  | # =head1 METHODS
23 |  |  |  |  | #
24 |  |  |  |  | # =head2 new
25 |  |  |  |  | #
26 |  |  |  |  | # my $usage = Getopt::Long::Descriptive::Usage->new(\%arg);
27 |  |  |  |  | #
28 |  |  |  |  | # You B<really> don't need to call this. GLD will do it for you.
29 |  |  |  |  | #
30 |  |  |  |  | # Valid arguments are:
31 |  |  |  |  | #
32 |  |  |  |  | # options - an arrayref of options
33 |  |  |  |  | # leader_text - the text that leads the usage; this may go away!
34 |  |  |  |  | #
35 |  |  |  |  | # =cut
36 |  |  |  |  |
37 |  |  |  |  | # spent 13µs within Getopt::Long::Descriptive::Usage::new which was called 2 times, avg 7µs/call: # 2 times (13µs+0s) by Getopt::Long::Descriptive::__ANON__[/usr/local/share/perl/5.18.2/Getopt/Long/Descriptive.pm:470] at line 421 of Getopt/Long/Descriptive.pm, avg 7µs/call sub new {
38 | 2 | 900ns |  |  | my ($class, $arg) = @_;
39 |  |  |  |  |
40 | 2 | 2µs |  |  | my @to_copy = qw(options leader_text show_defaults);
41 |  |  |  |  |
42 | 2 | 300ns |  |  | my %copy;
43 | 2 | 5µs |  |  | @copy{ @to_copy } = @$arg{ @to_copy };
44 |  |  |  |  |
45 | 2 | 9µs |  |  | bless \%copy => $class;
46 |  |  |  |  | }
47 |  |  |  |  |
48 |  |  |  |  | # =head2 text
49 |  |  |  |  | #
50 |  |  |  |  | # This returns the full text of the usage message.
51 |  |  |  |  | #
52 |  |  |  |  | # =cut
53 |  |  |  |  |
54 |  |  |  |  | sub text {
55 |  |  |  |  | my ($self) = @_;
56 |  |  |  |  |
57 |  |  |  |  | return join qq{\n}, $self->leader_text, $self->option_text;
58 |  |  |  |  | }
59 |  |  |  |  |
60 |  |  |  |  | # =head2 leader_text
61 |  |  |  |  | #
62 |  |  |  |  | # This returns the text that comes at the beginning of the usage message.
63 |  |  |  |  | #
64 |  |  |  |  | # =cut
65 |  |  |  |  |
66 |  |  |  |  | sub leader_text { $_[0]->{leader_text} }
67 |  |  |  |  |
68 |  |  |  |  | # =head2 option_text
69 |  |  |  |  | #
70 |  |  |  |  | # This returns the text describing the available options.
71 |  |  |  |  | #
72 |  |  |  |  | # =cut
73 |  |  |  |  |
74 |  |  |  |  | sub option_text {
75 |  |  |  |  | my ($self) = @_;
76 |  |  |  |  |
77 |  |  |  |  | my @options = @{ $self->{options} || [] };
78 |  |  |  |  | my $string = q{};
79 |  |  |  |  |
80 |  |  |  |  | # a spec can grow up to 4 characters in usage output:
81 |  |  |  |  | # '-' on short option, ' ' between short and long, '--' on long
82 |  |  |  |  | my @specs = map { $_->{spec} } grep { $_->{desc} ne 'spacer' } @options;
83 |  |  |  |  | my $length = (max(map { length } @specs) || 0) + 4;
84 |  |  |  |  | my $spec_fmt = "\t%-${length}s";
85 |  |  |  |  |
86 |  |  |  |  | while (@options) {
87 |  |  |  |  | my $opt = shift @options;
88 |  |  |  |  | my $spec = $opt->{spec};
89 |  |  |  |  | my $desc = $opt->{desc};
90 |  |  |  |  | if ($desc eq 'spacer') {
91 |  |  |  |  | $string .= sprintf "$spec_fmt\n", $opt->{spec};
92 |  |  |  |  | next;
93 |  |  |  |  | }
94 |  |  |  |  |
95 |  |  |  |  | $spec = Getopt::Long::Descriptive->_strip_assignment($spec);
96 |  |  |  |  | $spec = join " ", reverse map { length > 1 ? "--$_" : "-$_" }
97 |  |  |  |  | split /\|/, $spec;
98 |  |  |  |  |
99 |  |  |  |  | my @desc = $self->_split_description($length, $desc);
100 |  |  |  |  |
101 |  |  |  |  | # add default value if it exists
102 |  |  |  |  | if ( $opt->{constraint}->{default} and $self->{show_defaults}) {
103 |  |  |  |  | my $dflt = $opt->{constraint}->{default};
104 |  |  |  |  | push @desc, "(default value: $dflt)";
105 |  |  |  |  | }
106 |  |  |  |  |
107 |  |  |  |  | $string .= sprintf "$spec_fmt %s\n", $spec, shift @desc;
108 |  |  |  |  | for my $line (@desc) {
109 |  |  |  |  | $string .= "\t";
110 |  |  |  |  | $string .= q{ } x ( $length + 2 );
111 |  |  |  |  | $string .= "$line\n";
112 |  |  |  |  | }
113 |  |  |  |  | }
114 |  |  |  |  |
115 |  |  |  |  | return $string;
116 |  |  |  |  | }
117 |  |  |  |  |
118 |  |  |  |  | sub _split_description {
119 |  |  |  |  | my ($self, $length, $desc) = @_;
120 |  |  |  |  |
121 |  |  |  |  | # 8 for a tab, 2 for the space between option & desc;
122 |  |  |  |  | my $max_length = 78 - ( $length + 8 + 2 );
123 |  |  |  |  |
124 |  |  |  |  | return $desc if length $desc <= $max_length;
125 |  |  |  |  |
126 |  |  |  |  | my @lines;
127 |  |  |  |  | while (length $desc > $max_length) {
128 |  |  |  |  | my $idx = rindex( substr( $desc, 0, $max_length ), q{ }, );
129 |  |  |  |  | last unless $idx >= 0;
130 |  |  |  |  | push @lines, substr($desc, 0, $idx);
131 |  |  |  |  | substr($desc, 0, $idx + 1) = q{};
132 |  |  |  |  | }
133 |  |  |  |  | push @lines, $desc;
134 |  |  |  |  |
135 |  |  |  |  | return @lines;
136 |  |  |  |  | }
137 |  |  |  |  |
138 |  |  |  |  | # =head2 warn
139 |  |  |  |  | #
140 |  |  |  |  | # This warns with the usage message.
141 |  |  |  |  | #
142 |  |  |  |  | # =cut
143 |  |  |  |  |
144 |  |  |  |  | sub warn { warn shift->text }
145 |  |  |  |  |
146 |  |  |  |  | # =head2 die
147 |  |  |  |  | #
148 |  |  |  |  | # This throws the usage message as an exception.
149 |  |  |  |  | #
150 |  |  |  |  | # $usage_obj->die(\%arg);
151 |  |  |  |  | #
152 |  |  |  |  | # Some arguments can be provided
153 |  |  |  |  | #
154 |  |  |  |  | # pre_text - text to be prepended to the usage message
155 |  |  |  |  | # post_text - text to be appended to the usage message
156 |  |  |  |  | #
157 |  |  |  |  | # The C<pre_text> and C<post_text> arguments are concatenated with the usage
158 |  |  |  |  | # message with no line breaks, so supply this if you need them.
159 |  |  |  |  | #
160 |  |  |  |  | # =cut
161 |  |  |  |  |
162 |  |  |  |  | sub die {
163 |  |  |  |  | my $self = shift;
164 |  |  |  |  | my $arg = shift || {};
165 |  |  |  |  |
166 |  |  |  |  | die(
167 |  |  |  |  | join q{}, grep { defined } $arg->{pre_text}, $self->text, $arg->{post_text}
168 |  |  |  |  | );
169 |  |  |  |  | }
170 |  |  |  |  |
171 |  |  |  |  | # spent 43µs (12+31) within Getopt::Long::Descriptive::Usage::BEGIN@171 which was called: # once (12µs+31µs) by Getopt::Long::Descriptive::BEGIN@14 at line 181 use overload (
172 |  |  |  |  | q{""} => "text",
173 |  |  |  |  |
174 |  |  |  |  | # This is only needed because Usage used to be a blessed coderef that worked
175 |  |  |  |  | # this way. Later we can toss a warning in here. -- rjbs, 2009-08-19
176 |  |  |  |  | '&{}' => sub {
177 |  |  |  |  | my ($self) = @_;
178 |  |  |  |  | Carp::cluck("use of __PACKAGE__ objects as a code ref is deprecated");
179 |  |  |  |  | return sub { return $_[0] ? $self->text : $self->warn; };
180 |  |  |  |  | }
181 | 2 | 23µs | 2 | 74µs | ); # spent 43µs making 1 call to Getopt::Long::Descriptive::Usage::BEGIN@171 # spent 31µs making 1 call to overload::import
182 |  |  |  |  |
183 | 1 | 2µs |  |  | 1;
184 |  |  |  |  |
185 |  |  |  |  | __END__