Filename | /usr/local/share/perl/5.18.2/Getopt/Long/Descriptive/Usage.pm |
Statements | Executed 20 statements in 675µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
2 | 1 | 1 | 13µs | 13µs | new | Getopt::Long::Descriptive::Usage::
1 | 1 | 1 | 12µs | 43µs | BEGIN@171 | Getopt::Long::Descriptive::Usage::
1 | 1 | 1 | 11µs | 42µs | BEGIN@6 | Getopt::Long::Descriptive::Usage::
1 | 1 | 1 | 10µs | 20µs | BEGIN@1.16 | Getopt::Long::Descriptive::
1 | 1 | 1 | 7µs | 10µs | BEGIN@2.17 | Getopt::Long::Descriptive::
0 | 0 | 0 | 0s | 0s | __ANON__[:179] | Getopt::Long::Descriptive::Usage::
0 | 0 | 0 | 0s | 0s | __ANON__[:180] | Getopt::Long::Descriptive::Usage::
0 | 0 | 0 | 0s | 0s | _split_description | Getopt::Long::Descriptive::Usage::
0 | 0 | 0 | 0s | 0s | die | Getopt::Long::Descriptive::Usage::
0 | 0 | 0 | 0s | 0s | leader_text | Getopt::Long::Descriptive::Usage::
0 | 0 | 0 | 0s | 0s | option_text | Getopt::Long::Descriptive::Usage::
0 | 0 | 0 | 0s | 0s | text | Getopt::Long::Descriptive::Usage::
0 | 0 | 0 | 0s | 0s | warn | Getopt::Long::Descriptive::Usage::
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 # 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 # 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 # 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 | ||||
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 | ||||
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__ |