← 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
StatementsExecuted 20 statements in 675µs
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
21113µs13µsGetopt::Long::Descriptive::Usage::::newGetopt::Long::Descriptive::Usage::new
11112µs43µsGetopt::Long::Descriptive::Usage::::BEGIN@171Getopt::Long::Descriptive::Usage::BEGIN@171
11111µs42µsGetopt::Long::Descriptive::Usage::::BEGIN@6Getopt::Long::Descriptive::Usage::BEGIN@6
11110µs20µsGetopt::Long::Descriptive::::BEGIN@1.16 Getopt::Long::Descriptive::BEGIN@1.16
1117µs10µsGetopt::Long::Descriptive::::BEGIN@2.17 Getopt::Long::Descriptive::BEGIN@2.17
0000s0sGetopt::Long::Descriptive::Usage::::__ANON__[:179]Getopt::Long::Descriptive::Usage::__ANON__[:179]
0000s0sGetopt::Long::Descriptive::Usage::::__ANON__[:180]Getopt::Long::Descriptive::Usage::__ANON__[:180]
0000s0sGetopt::Long::Descriptive::Usage::::_split_descriptionGetopt::Long::Descriptive::Usage::_split_description
0000s0sGetopt::Long::Descriptive::Usage::::dieGetopt::Long::Descriptive::Usage::die
0000s0sGetopt::Long::Descriptive::Usage::::leader_textGetopt::Long::Descriptive::Usage::leader_text
0000s0sGetopt::Long::Descriptive::Usage::::option_textGetopt::Long::Descriptive::Usage::option_text
0000s0sGetopt::Long::Descriptive::Usage::::textGetopt::Long::Descriptive::Usage::text
0000s0sGetopt::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
1221µs231µ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
2240µs214µ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
3package Getopt::Long::Descriptive::Usage;
4# ABSTRACT: the usage description for GLD
51700ns$Getopt::Long::Descriptive::Usage::VERSION = '0.097';
62572µs250µ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 {
382900ns my ($class, $arg) = @_;
39
4022µs my @to_copy = qw(options leader_text show_defaults);
41
422300ns my %copy;
4325µs @copy{ @to_copy } = @$arg{ @to_copy };
44
4529µs bless \%copy => $class;
46}
47
48# =head2 text
49#
50# This returns the full text of the usage message.
51#
52# =cut
53
54sub 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
66sub leader_text { $_[0]->{leader_text} }
67
68# =head2 option_text
69#
70# This returns the text describing the available options.
71#
72# =cut
73
74sub 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
118sub _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
144sub 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
162sub 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 }
181223µs274µs);
# spent 43µs making 1 call to Getopt::Long::Descriptive::Usage::BEGIN@171 # spent 31µs making 1 call to overload::import
182
18312µs1;
184
185__END__