← Index
NYTProf Performance Profile   « block view • line view • sub view »
For bin/hailo
  Run on Thu Oct 21 22:50:37 2010
Reported on Thu Oct 21 22:52:05 2010

Filename/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/Getopt/Long/Descriptive.pm
StatementsExecuted 917 statements in 7.29ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1117.23ms13.3msGetopt::Long::Descriptive::::BEGIN@7Getopt::Long::Descriptive::BEGIN@7
1111.17ms1.37msGetopt::Long::Descriptive::::BEGIN@6Getopt::Long::Descriptive::BEGIN@6
1111.04ms48.1msGetopt::Long::Descriptive::::__ANON__[:430]Getopt::Long::Descriptive::__ANON__[:430]
1111.02ms14.1msGetopt::Long::Descriptive::::BEGIN@259Getopt::Long::Descriptive::BEGIN@259
2211791µs1.98msGetopt::Long::Descriptive::::_validate_withGetopt::Long::Descriptive::_validate_with
111682µs845µsGetopt::Long::Descriptive::::BEGIN@12Getopt::Long::Descriptive::BEGIN@12
6622677µs1.01msGetopt::Long::Descriptive::::_strip_assignmentGetopt::Long::Descriptive::_strip_assignment
111594µs794µsGetopt::Long::Descriptive::::BEGIN@13Getopt::Long::Descriptive::BEGIN@13
111321µs1.78msGetopt::Long::Descriptive::::BEGIN@9Getopt::Long::Descriptive::BEGIN@9
6831243µs243µsGetopt::Long::Descriptive::::CORE:substGetopt::Long::Descriptive::CORE:subst (opcode)
111211µs369µsGetopt::Long::Descriptive::::_expandGetopt::Long::Descriptive::_expand
2421179µs179µsGetopt::Long::Descriptive::::_mungeGetopt::Long::Descriptive::_munge
661196µs96µsGetopt::Long::Descriptive::::CORE:regcompGetopt::Long::Descriptive::CORE:regcomp (opcode)
613178µs78µsGetopt::Long::Descriptive::::CORE:matchGetopt::Long::Descriptive::CORE:match (opcode)
11155µs48.2msGetopt::Long::Descriptive::::describe_optionsGetopt::Long::Descriptive::describe_options
22229µs29µsGetopt::Long::Descriptive::::_build_describe_optionsGetopt::Long::Descriptive::_build_describe_options
11126µs792µsGetopt::Long::Descriptive::::BEGIN@260Getopt::Long::Descriptive::BEGIN@260
11124µs30µsMouseX::Getopt::GLD::::BEGIN@1 MouseX::Getopt::GLD::BEGIN@1
22118µs18µsGetopt::Long::Descriptive::::_nohiddenGetopt::Long::Descriptive::_nohidden
11116µs104µsGetopt::Long::Descriptive::::BEGIN@8Getopt::Long::Descriptive::BEGIN@8
11115µs115µsGetopt::Long::Descriptive::::BEGIN@254Getopt::Long::Descriptive::BEGIN@254
11113µs13µsGetopt::Long::Descriptive::::CORE:sortGetopt::Long::Descriptive::CORE:sort (opcode)
11111µs66µsGetopt::Long::Descriptive::::BEGIN@5Getopt::Long::Descriptive::BEGIN@5
11111µs20µsMouseX::Getopt::GLD::::BEGIN@2.3 MouseX::Getopt::GLD::BEGIN@2.3
2218µs8µsGetopt::Long::Descriptive::::prog_nameGetopt::Long::Descriptive::prog_name
1116µs6µsGetopt::Long::Descriptive::::BEGIN@10Getopt::Long::Descriptive::BEGIN@10
3116µs6µsGetopt::Long::Descriptive::::CORE:substcontGetopt::Long::Descriptive::CORE:substcont (opcode)
1113µs3µsGetopt::Long::Descriptive::::usage_classGetopt::Long::Descriptive::usage_class
1113µs3µsGetopt::Long::Descriptive::::CORE:qrGetopt::Long::Descriptive::CORE:qr (opcode)
0000s0sGetopt::Long::Descriptive::::__ANON__[:528]Getopt::Long::Descriptive::__ANON__[:528]
0000s0sGetopt::Long::Descriptive::::__ANON__[:550]Getopt::Long::Descriptive::__ANON__[:550]
0000s0sGetopt::Long::Descriptive::::_mk_impliesGetopt::Long::Descriptive::_mk_implies
0000s0sGetopt::Long::Descriptive::::_mk_only_oneGetopt::Long::Descriptive::_mk_only_one
0000s0sGetopt::Long::Descriptive::::_norm_implyGetopt::Long::Descriptive::_norm_imply
0000s0sMouseX::Getopt::::describe_options MouseX::Getopt::describe_options
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1226µs235µs
# spent 30µs (24+5) within MouseX::Getopt::GLD::BEGIN@1 which was called: # once (24µs+5µs) by MouseX::Getopt::GLD::BEGIN@12 at line 1
use strict;
# spent 30µs making 1 call to MouseX::Getopt::GLD::BEGIN@1 # spent 5µs making 1 call to strict::import
2242µs229µs
# spent 20µs (11+9) within MouseX::Getopt::GLD::BEGIN@2.3 which was called: # once (11µs+9µs) by MouseX::Getopt::GLD::BEGIN@12 at line 2
use warnings;
# spent 20µs making 1 call to MouseX::Getopt::GLD::BEGIN@2.3 # spent 9µs making 1 call to warnings::import
3package Getopt::Long::Descriptive;
4
5226µs2121µs
# spent 66µs (11+55) within Getopt::Long::Descriptive::BEGIN@5 which was called: # once (11µs+55µs) by MouseX::Getopt::GLD::BEGIN@12 at line 5
use Carp qw(carp croak);
# spent 66µs making 1 call to Getopt::Long::Descriptive::BEGIN@5 # spent 55µs making 1 call to Exporter::import
62204µs11.37ms
# spent 1.37ms (1.17+205µs) within Getopt::Long::Descriptive::BEGIN@6 which was called: # once (1.17ms+205µs) by MouseX::Getopt::GLD::BEGIN@12 at line 6
use File::Basename ();
# spent 1.37ms making 1 call to Getopt::Long::Descriptive::BEGIN@6
73176µs315.0ms
# spent 13.3ms (7.23+6.08) within Getopt::Long::Descriptive::BEGIN@7 which was called: # once (7.23ms+6.08ms) by MouseX::Getopt::GLD::BEGIN@12 at line 7
use Getopt::Long 2.33;
# spent 13.3ms making 1 call to Getopt::Long::Descriptive::BEGIN@7 # spent 1.67ms making 1 call to Getopt::Long::import # spent 64µs making 1 call to Getopt::Long::VERSION
8233µs2191µs
# spent 104µs (16+88) within Getopt::Long::Descriptive::BEGIN@8 which was called: # once (16µs+88µs) by MouseX::Getopt::GLD::BEGIN@12 at line 8
use List::Util qw(first);
# spent 104µs making 1 call to Getopt::Long::Descriptive::BEGIN@8 # spent 87µs making 1 call to Exporter::import
92136µs22.18ms
# spent 1.78ms (321µs+1.46) within Getopt::Long::Descriptive::BEGIN@9 which was called: # once (321µs+1.46ms) by MouseX::Getopt::GLD::BEGIN@12 at line 9
use Params::Validate qw(:all);
# spent 1.78ms making 1 call to Getopt::Long::Descriptive::BEGIN@9 # spent 405µs making 1 call to Exporter::import
10224µs16µs
# spent 6µs within Getopt::Long::Descriptive::BEGIN@10 which was called: # once (6µs+0s) by MouseX::Getopt::GLD::BEGIN@12 at line 10
use Scalar::Util ();
# spent 6µs making 1 call to Getopt::Long::Descriptive::BEGIN@10
11
122142µs1845µs
# spent 845µs (682+163) within Getopt::Long::Descriptive::BEGIN@12 which was called: # once (682µs+163µs) by MouseX::Getopt::GLD::BEGIN@12 at line 12
use Getopt::Long::Descriptive::Opts;
# spent 845µs making 1 call to Getopt::Long::Descriptive::BEGIN@12
132261µs1794µs
# spent 794µs (594+200) within Getopt::Long::Descriptive::BEGIN@13 which was called: # once (594µs+200µs) by MouseX::Getopt::GLD::BEGIN@12 at line 13
use Getopt::Long::Descriptive::Usage;
# spent 794µs making 1 call to Getopt::Long::Descriptive::BEGIN@13
14
15=head1 NAME
16
17Getopt::Long::Descriptive - Getopt::Long, but simpler and more powerful
18
19=head1 VERSION
20
21Version 0.086
22
23=cut
24
2512µsour $VERSION = '0.086';
26
27=head1 SYNOPSIS
28
29 use Getopt::Long::Descriptive;
30
31 my ($opt, $usage) = describe_options(
32 'my-program %o <some-arg>',
33 [ 'server|s=s', "the server to connect to" ],
34 [ 'port|p=i', "the port to connect to", { default => 79 } ],
35 [],
36 [ 'verbose|v', "print extra stuff" ],
37 [ 'help', "print usage message and exit" ],
38 );
39
40 print($usage->text), exit if $opt->help;
41
42 Client->connect( $opt->server, $opt->port );
43
44 print "Connected!\n" if $opt->verbose;
45
46...and running C<my-program --help> will produce:
47
48 my-program [-psv] [long options...] <some-arg>
49 -s --server the server to connect to
50 -p --port the port to connect to
51
52 -v --verbose print extra stuff
53 --help print usage message and exit
54
55=head1 DESCRIPTION
56
57Getopt::Long::Descriptive is yet another Getopt library. It's built atop
58Getopt::Long, and gets a lot of its features, but tries to avoid making you
59think about its huge array of options.
60
61It also provides usage (help) messages, data validation, and a few other useful
62features.
63
64=head1 FUNCTIONS
65
66Getopt::Long::Descriptive only exports one routine by default:
67C<describe_options>. All GLD's exports are exported by L<Sub::Exporter>.
68
69=head2 describe_options
70
71 my ($opt, $usage) = describe_options($usage_desc, @opt_spec, \%arg);
72
73This routine inspects C<@ARGV> returns the options given and a object
74for generating usage messages.
75
76The C<$opt> object will be a dynamically-generated subclass of
77L<Getopt::Long::Descriptive::Opts>. In brief, each of the options in
78C<@opt_spec> becomes an accessor method on the object, using the first-given
79name, with dashes converted to underscores. For more information, see the
80documentation for the Opts class.
81
82The C<$usage> object will be a L<Getopt::Long::Descriptive::Usage> object,
83which provides a C<text> method to get the text of the usage message and C<die>
84to die with it. For more methods and options, consults the documentation for
85the Usage class.
86
87=head3 $usage_desc
88
89The C<$usage_desc> parameter to C<describe_options> is a C<sprintf>-like string
90that is used in generating the first line of the usage message. It's a
91one-line summary of how the command is to be invoked. A typical usage
92description might be:
93
94 $usage_desc = "%c %o <source> <desc>";
95
96C<%c> will be replaced with what Getopt::Long::Descriptive thinks is the
97program name (it's computed from C<$0>, see L</prog_name>).
98
99C<%o> will be replaced with a list of the short options, as well as the text
100"[long options...]" if any have been defined.
101
102The rest of the usage description can be used to summarize what arguments are
103expected to follow the program's options, and is entirely free-form.
104
105Literal C<%> characters will need to be written as C<%%>, just like with
106C<sprintf>.
107
108=head3 @opt_spec
109
110The C<@opt_spec> part of the args to C<describe_options> is used to configure
111option parsing and to produce the usage message. Each entry in the list is an
112arrayref describing one option, like this:
113
114 @opt_spec = (
115 [ "verbose|V" => "be noisy" ],
116 [ "logfile=s" => "file to log to" ],
117 );
118
119The first value in the arrayref is a Getopt::Long-style option specification.
120In brief, they work like this: each one is a pipe-delimited list of names,
121optionally followed by a type declaration. Type declarations are '=x' or ':x',
122where C<=> means a value is required and C<:> means it is optional. I<x> may
123be 's' to indicate a string is required, 'i' for an integer, or 'f' for a
124number with a fractional part. The type spec may end in C<@> to indicate that
125the option may appear multiple times.
126
127For more information on how these work, see the L<Getopt::Long> documentation.
128
129The first name given should be the canonical name, as it will be used as the
130accessor method on the C<$opt> object. Dashes in the name will be converted to
131underscores, and all letters will be lowercased. For this reason, all options
132should generally have a long-form name.
133
134The second value in the arrayref is a description of the option, for use in the
135usage message.
136
137=head4 Special Option Specifications
138
139If the option specification (arrayref) is empty, it will have no effect other
140than causing a blank line to appear in the usage message.
141
142If the option specification contains only one element, it will be printed in
143the usage message with no other effect.
144
145If the option specification contains a third element, it adds extra constraints
146or modifiers to the interpretation and validation of the value. These are the
147keys that may be present in that hashref, and how they behave:
148
149=over 4
150
151=item implies
152
153 implies => 'bar'
154 implies => [qw(foo bar)]
155 implies => { foo => 1, bar => 2 }
156
157If option I<A> has an "implies" entry, then if I<A> is given, other options
158will be enabled. The value may be a single option to set, an arrayref of
159options to set, or a hashref of options to set to specific values.
160
161=item required
162
163 required => 1
164
165If an option is required, failure to provide the option will result in
166C<describe_options> printing the usage message and exiting.
167
168=item hidden
169
170 hidden => 1
171
172This option will not show up in the usage text.
173
174You can achieve the same behavior by using the string "hidden" for the option's
175description.
176
177=item one_of
178
179 one_of => \@subopt_specs
180
181This is useful for a group of options that are related. Each option
182spec is added to the list for normal parsing and validation.
183
184Your option name will end up with a value of the name of the
185option that was chosen. For example, given the following spec:
186
187 [ "mode" => hidden => { one_of => [
188 [ "get|g" => "get the value" ],
189 [ "set|s" => "set the value" ],
190 [ "delete" => "delete it" ],
191 ] } ],
192
193No usage text for 'mode' will be displayed, but text for get, set, and delete
194will be displayed.
195
196If more than one of get, set, or delete is given, an error will be thrown.
197
198So, given the C<@opt_spec> above, and an C<@ARGV> of C<('--get')>, the
199following would be true:
200
201 $opt->get == 1;
202
203 $opt->mode eq 'get';
204
205B<Note>: C<get> would not be set if C<mode> defaulted to 'get' and no arguments
206were passed in.
207
208Even though the option sub-specs for C<one_of> are meant to be 'first
209class' specs, some options don't make sense with them, e.g. C<required>.
210
211As a further shorthand, you may specify C<one_of> options using this form:
212
213 [ mode => \@option_specs, \%constraints ]
214
215=item Params::Validate
216
217In addition, any constraint understood by Params::Validate may be used.
218
219(Internally, all constraints are translated into Params::Validate options or
220callbacks.)
221
222=back
223
224=head3 %arg
225
226The C<%arg> to C<describe_options> is optional. If the last parameter is a
227hashref, it contains extra arguments to modify the way C<describe_options>
228works. Valid arguments are:
229
230 getopt_conf - an arrayref of strings, passed to Getopt::Long::Configure
231
232=head2 prog_name
233
234This routine, exported on demand, returns the basename of C<$0>, grabbed at
235compile-time. You can override this guess by calling C<prog_name($string)>
236yourself.
237
238=head1 OTHER EXPORTS
239
240=head2 C<-types>
241
242Any of the Params::Validate type constants (C<SCALAR>, etc.) can be imported as
243well. You can get all of them at once by importing C<-types>.
244
245=head2 C<-all>
246
247This import group will import C<-type>, C<describe_options>, and C<prog_name>.
248
249=cut
250
25111µsmy $prog_name;
252211µs
# spent 8µs within Getopt::Long::Descriptive::prog_name which was called 2 times, avg 4µs/call: # once (5µs+0s) by Getopt::Long::Descriptive::__ANON__[/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/Getopt/Long/Descriptive.pm:430] at line 381 # once (3µs+0s) by Getopt::Long::Descriptive::BEGIN@254 at line 256
sub prog_name { @_ ? ($prog_name = shift) : $prog_name }
253
254
# spent 115µs (15+100) within Getopt::Long::Descriptive::BEGIN@254 which was called: # once (15µs+100µs) by MouseX::Getopt::GLD::BEGIN@12 at line 257
BEGIN {
255 # grab this before someone decides to change it
256110µs2100µs prog_name(File::Basename::basename($0));
# spent 97µs making 1 call to File::Basename::basename # spent 3µs making 1 call to Getopt::Long::Descriptive::prog_name
257119µs1115µs}
# spent 115µs making 1 call to Getopt::Long::Descriptive::BEGIN@254
258
2592169µs114.1ms
# spent 14.1ms (1.02+13.1) within Getopt::Long::Descriptive::BEGIN@259 which was called: # once (1.02ms+13.1ms) by MouseX::Getopt::GLD::BEGIN@12 at line 259
use Sub::Exporter::Util ();
# spent 14.1ms making 1 call to Getopt::Long::Descriptive::BEGIN@259
260
# spent 792µs (26+766) within Getopt::Long::Descriptive::BEGIN@260 which was called: # once (26µs+766µs) by MouseX::Getopt::GLD::BEGIN@12 at line 270
use Sub::Exporter 0.972 -setup => {
261 exports => [
262 describe_options => \'_build_describe_options',
263 q(prog_name),
2641753µs @{ $Params::Validate::EXPORT_TAGS{types} }
# spent 753µs making 1 call to Sub::Exporter::__ANON__[Sub/Exporter.pm:756]
265 ],
266 groups => [
267 default => [ qw(describe_options) ],
268 types => $Params::Validate::EXPORT_TAGS{types},
269 ],
27031.47ms2806µs};
# spent 792µs making 1 call to Getopt::Long::Descriptive::BEGIN@260 # spent 14µs making 1 call to UNIVERSAL::VERSION
271
27214µsmy %CONSTRAINT = (
273 implies => \&_mk_implies,
274 required => { optional => 0 },
275 only_one => \&_mk_only_one,
276);
277
27811µsour $MungeOptions = 1;
279
280
# spent 18µs within Getopt::Long::Descriptive::_nohidden which was called 2 times, avg 9µs/call: # once (10µs+0s) by Getopt::Long::Descriptive::__ANON__[/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/Getopt/Long/Descriptive.pm:430] at line 369 # once (8µs+0s) by Getopt::Long::Descriptive::__ANON__[/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/Getopt/Long/Descriptive.pm:430] at line 393
sub _nohidden {
281222µs return grep { ! $_->{constraint}->{hidden} } @_;
282}
283
284
# spent 369µs (211+158) within Getopt::Long::Descriptive::_expand which was called: # once (211µs+158µs) by Getopt::Long::Descriptive::__ANON__[/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/Getopt/Long/Descriptive.pm:430] at line 328
sub _expand {
28523187µs22158µs return map { {(
# spent 158µs making 22 calls to Getopt::Long::Descriptive::_munge, avg 7µs/call
286 spec => $_->[0] || '',
287 desc => @$_ > 1 ? $_->[1] : 'spacer',
288 constraint => $_->[2] || {},
289
290 # if @$_ is 0 then we got [], a spacer
291 name => @$_ ? _munge((split /[:=|!+]/, $_->[0] || '')[0]) : '',
292 )} } @_;
293}
294
29512µsmy %HIDDEN = (
296 hidden => 1,
297);
298
299111µs13µsmy $SPEC_RE = qr{(?:[:=][\d\w\+]+[%@]?({\d*,\d*})?|[!+])$};
# spent 3µs making 1 call to Getopt::Long::Descriptive::CORE:qr
300
# spent 1.01ms (677µs+333µs) within Getopt::Long::Descriptive::_strip_assignment which was called 66 times, avg 15µs/call: # 44 times (447µs+220µs) by Getopt::Long::Descriptive::Usage::option_text at line 100 of Getopt/Long/Descriptive/Usage.pm, avg 15µs/call # 22 times (230µs+113µs) by Getopt::Long::Descriptive::__ANON__[/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/Getopt/Long/Descriptive.pm:430] at line 375, avg 16µs/call
sub _strip_assignment {
3011981.07ms my ($self, $str) = @_;
302
303132333µs (my $copy = $str) =~ s{$SPEC_RE}{};
# spent 237µs making 66 calls to Getopt::Long::Descriptive::CORE:subst, avg 4µs/call # spent 96µs making 66 calls to Getopt::Long::Descriptive::CORE:regcomp, avg 1µs/call
304
305 return $copy;
306}
307
308# This is here only to deal with people who were calling this fully-qualified
309# without importing. Sucks to them! -- rjbs, 2009-08-21
310
# spent 48.2ms (55µs+48.1) within Getopt::Long::Descriptive::describe_options which was called: # once (55µs+48.1ms) by MouseX::Getopt::GLD::__ANON__[/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/MouseX/Getopt/GLD.pm:39] at line 38 of MouseX/Getopt/GLD.pm
sub describe_options {
311252µs117µs my $sub = __PACKAGE__->_build_describe_options(describe_options => {} => {});
312148.1ms $sub->(@_);
313}
314
31516µs
# spent 3µs within Getopt::Long::Descriptive::usage_class which was called: # once (3µs+0s) by Getopt::Long::Descriptive::__ANON__[/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/Getopt/Long/Descriptive.pm:430] at line 393
sub usage_class { 'Getopt::Long::Descriptive::Usage' }
316
317
# spent 29µs within Getopt::Long::Descriptive::_build_describe_options which was called 2 times, avg 14µs/call: # once (17µs+0s) by Getopt::Long::Descriptive::describe_options at line 311 # once (12µs+0s) by Sub::Exporter::default_generator at line 861 of Sub/Exporter.pm
sub _build_describe_options {
318434µs my ($class) = @_;
319
320
# spent 48.1ms (1.04+47.1) within Getopt::Long::Descriptive::__ANON__[/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/Getopt/Long/Descriptive.pm:430] which was called: # once (1.04ms+47.1ms) by Getopt::Long::Descriptive::describe_options at line 312
sub {
3213111.05ms my $format = shift;
322 my $arg = (ref $_[-1] and ref $_[-1] eq 'HASH') ? pop @_ : {};
323 my @opts;
324
325 # special casing
326 # wish we had real loop objects
327 my %method_map;
3281369µs for my $opt (_expand(@_)) {
# spent 369µs making 1 call to Getopt::Long::Descriptive::_expand
329 $method_map{ $opt->{name} } = undef unless $opt->{desc} eq 'spacer';
330
331 if (ref($opt->{desc}) eq 'ARRAY') {
332 $opt->{constraint}->{one_of} = delete $opt->{desc};
333 $opt->{desc} = 'hidden';
334 }
335 if ($HIDDEN{$opt->{desc}}) {
336 $opt->{constraint}->{hidden}++;
337 }
338 if ($opt->{constraint}->{one_of}) {
339 for my $one_opt (_expand(
340 @{delete $opt->{constraint}->{one_of}}
341 )) {
342 $one_opt->{constraint}->{implies}
343 ->{$opt->{name}} = $one_opt->{name};
344 for my $wipe (qw(required default)) {
345 if ($one_opt->{constraint}->{$wipe}) {
346 carp "'$wipe' constraint does not make sense in sub-option";
347 delete $one_opt->{constraint}->{$wipe};
348 }
349 }
350 $one_opt->{constraint}->{one_of} = $opt->{name};
351 push @opts, $one_opt;
352 }
353 }
354 push @opts, $opt;
355 }
356
357 my @go_conf = @{ $arg->{getopt_conf} || $arg->{getopt} || [] };
358 if ($arg->{getopt}) {
359 warn "describe_options: 'getopt' is deprecated, please use 'getopt_conf' instead\n";
360 }
361
362 push @go_conf, "bundling" unless grep { /bundling/i } @go_conf;
36311µs push @go_conf, "no_auto_help" unless grep { /no_auto_help/i } @go_conf;
# spent 1µs making 1 call to Getopt::Long::Descriptive::CORE:match
364
365 # not entirely sure that all of this (until the Usage->new) shouldn't be
366 # moved into Usage -- rjbs, 2009-08-19
367 my @specs =
368 map { $_->{spec} }
369110µs grep { $_->{desc} ne 'spacer' }
# spent 10µs making 1 call to Getopt::Long::Descriptive::_nohidden
370 _nohidden(@opts);
371
372 my $short = join q{},
3733845µs sort { lc $a cmp lc $b or $a cmp $b }
# spent 45µs making 38 calls to Getopt::Long::Descriptive::CORE:match, avg 1µs/call
374 grep { /^.$/ }
37522343µs map { split /\|/ }
# spent 343µs making 22 calls to Getopt::Long::Descriptive::_strip_assignment, avg 16µs/call
376113µs map { __PACKAGE__->_strip_assignment($_) }
# spent 13µs making 1 call to Getopt::Long::Descriptive::CORE:sort
377 @specs;
378
3792232µs my $long = grep /\b[^|]{2,}/, @specs;
# spent 32µs making 22 calls to Getopt::Long::Descriptive::CORE:match, avg 1µs/call
380
38115µs my %replace = (
# spent 5µs making 1 call to Getopt::Long::Descriptive::prog_name
382 "%" => "%",
383 "c" => prog_name,
384 "o" => join(q{ },
385 ($short ? "[-$short]" : ()),
386 ($long ? "[long options...]" : ())
387 ),
388 );
389
39049µs (my $str = $format) =~ s/%(.)/$replace{$1}/ge;
# spent 6µs making 3 calls to Getopt::Long::Descriptive::CORE:substcont, avg 2µs/call # spent 3µs making 1 call to Getopt::Long::Descriptive::CORE:subst
39113µs $str =~ s/\s{2,}/ /g;
# spent 3µs making 1 call to Getopt::Long::Descriptive::CORE:subst
392
393358µs my $usage = $class->usage_class->new({
# spent 46µs making 1 call to Getopt::Long::Descriptive::Usage::new # spent 8µs making 1 call to Getopt::Long::Descriptive::_nohidden # spent 3µs making 1 call to Getopt::Long::Descriptive::usage_class
394 options => [ _nohidden(@opts) ],
395 leader_text => $str,
396 });
397
398168µs Getopt::Long::Configure(@go_conf);
# spent 68µs making 1 call to Getopt::Long::Configure
399
400 my %return;
40118µs $usage->die unless GetOptions(\%return, grep { length } @specs);
# spent 8µs making 1 call to Getopt::Long::GetOptions
402 my @given_keys = keys %return;
403
404 for my $opt (keys %return) {
405220µs my $newopt = _munge($opt);
# spent 20µs making 2 calls to Getopt::Long::Descriptive::_munge, avg 10µs/call
406 next if $newopt eq $opt;
407 $return{$newopt} = delete $return{$opt};
408 }
409
410 for my $copt (grep { $_->{constraint} } @opts) {
411 delete $copt->{constraint}->{hidden};
412 my $name = $copt->{name};
413221.98ms my $new = _validate_with(
# spent 1.98ms making 22 calls to Getopt::Long::Descriptive::_validate_with, avg 90µs/call
414 name => $name,
415 params => \%return,
416 spec => $copt->{constraint},
417 opts => \@opts,
418 usage => $usage,
419 );
420 next unless (defined($new) || exists($return{$name}));
421 $return{$name} = $new;
422 }
423
424 my $opt_obj = Getopt::Long::Descriptive::Opts->___new_opt_obj({
425 values => { %method_map, %return },
4261390µs given => { map {; $_ => 1 } @given_keys },
# spent 390µs making 1 call to Getopt::Long::Descriptive::Opts::___new_opt_obj
427 });
428
429 return($opt_obj, $usage);
430 }
431}
432
433
# spent 179µs within Getopt::Long::Descriptive::_munge which was called 24 times, avg 7µs/call: # 22 times (158µs+0s) by Getopt::Long::Descriptive::_expand at line 285, avg 7µs/call # 2 times (20µs+0s) by Getopt::Long::Descriptive::__ANON__[/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/Getopt/Long/Descriptive.pm:430] at line 405, avg 10µs/call
sub _munge {
434120207µs my ($opt) = @_;
435 return $opt unless $MungeOptions;
436 $opt = lc($opt);
437 $opt =~ tr/-/_/;
438 return $opt;
439}
440
441
# spent 1.98ms (791µs+1.19) within Getopt::Long::Descriptive::_validate_with which was called 22 times, avg 90µs/call: # 22 times (791µs+1.19ms) by Getopt::Long::Descriptive::__ANON__[/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/Getopt/Long/Descriptive.pm:430] at line 413, avg 90µs/call
sub _validate_with {
4422201.63ms22629µs my (%arg) = validate(@_, {
# spent 629µs making 22 calls to Params::Validate::_validate, avg 29µs/call
# spent 64µs executing statements in 22 string evals (merged)
443 name => 1,
444 params => 1,
445 spec => 1,
446 opts => 1,
447 usage => 1,
448 });
449 my $spec = $arg{spec};
450 my %pvspec;
451 for my $ct (keys %{$spec}) {
452 if ($CONSTRAINT{$ct} and ref $CONSTRAINT{$ct} eq 'CODE') {
453 $pvspec{callbacks} ||= {};
454 $pvspec{callbacks} = {
455 %{$pvspec{callbacks}},
456 $CONSTRAINT{$ct}->(
457 $arg{name},
458 $spec->{$ct},
459 $arg{params},
460 $arg{opts},
461 ),
462 };
463 } else {
464 %pvspec = (
465 %pvspec,
466 $CONSTRAINT{$ct} ? %{$CONSTRAINT{$ct}} : ($ct => $spec->{$ct}),
467 );
468 }
469 }
470
471 $pvspec{optional} = 1 unless exists $pvspec{optional};
472
473 # we need to implement 'default' by ourselves sometimes
474 # because otherwise the implies won't be checked/executed
475 # XXX this should be more generic -- we'll probably want
476 # other callbacks to always run, too
477 if (!defined($arg{params}{$arg{name}})
478 && $pvspec{default}
479 && $spec->{implies}) {
480
481 $arg{params}{$arg{name}} = delete $pvspec{default};
482 }
483
484 my %p = eval {
485 validate_with(
4861259µs22565µs params => [ %{$arg{params}} ],
# spent 565µs making 22 calls to Params::Validate::_validate_with, avg 26µs/call
# spent 61µs executing statements in 22 string evals (merged)
487 spec => { $arg{name} => \%pvspec },
488 allow_extra => 1,
489 );
490 };
491
492 if ($@) {
493 if ($@ =~ /^Mandatory parameter '([^']+)' missing/) {
494 my $missing = $1;
495 $arg{usage}->die({
496 pre_text => "Required option missing: $1\n",
497 });
498 }
499
500 die $@;
501 }
502
503 return $p{$arg{name}};
504}
505
506# scalar: single option = true
507# arrayref: multiple options = true
508# hashref: single/multiple options = given values
509sub _norm_imply {
510 my ($what) = @_;
511
512 return { $what => 1 } unless my $ref = ref $what;
513
514 return $what if $ref eq 'HASH';
515 return { map { $_ => 1 } @$what } if $ref eq 'ARRAY';
516
517 die "can't imply: $what";
518}
519
520sub _mk_implies {
521 my $name = shift;
522 my $what = _norm_imply(shift);
523 my $param = shift;
524 my $opts = shift;
525
526 for my $implied (keys %$what) {
527 die("option specification for $name implies nonexistent option $implied\n")
528 unless first { $_->{name} eq $implied } @$opts
529 }
530
531 my $whatstr = join(q{, }, map { "$_=$what->{$_}" } keys %$what);
532
533 return "$name implies $whatstr" => sub {
534 my ($pv_val) = shift;
535
536 # negatable options will be 0 here, which is ok.
537 return 1 unless defined $pv_val;
538
539 while (my ($key, $val) = each %$what) {
540 if (exists $param->{$key} and $param->{$key} ne $val) {
541 die(
542 "option specification for $name implies that $key should be "
543 . "set to '$val', but it is '$param->{$key}' already\n"
544 );
545 }
546 $param->{$key} = $val;
547 }
548
549 return 1;
550 };
551}
552
553sub _mk_only_one {
554 die "unimplemented";
555}
556
557=head1 CUSTOMIZING
558
559Getopt::Long::Descriptive uses L<Sub::Exporter|Sub::Exporter> to build and
560export the C<describe_options> routine. By writing a new class that extends
561Getopt::Long::Descriptive, the behavior of the constructed C<describe_options>
562routine can be changed.
563
564The following methods can be overridden:
565
566=head2 usage_class
567
568 my $class = Getopt::Long::Descriptive->usage_class;
569
570This returns the class to be used for constructing a Usage object, and defaults
571to Getopt::Long::Descriptive::Usage.
572
573=head1 SEE ALSO
574
575L<Getopt::Long>
576L<Params::Validate>
577
578=head1 AUTHORS
579
580Hans Dieter Pearcey, C<< <hdp@cpan.org> >>
581
582Ricardo Signes, C<< <rjbs@cpan.org> >>
583
584=head1 BUGS
585
586Please report any bugs or feature requests to
587C<bug-getopt-long-descriptive@rt.cpan.org>, or through the web interface at
588L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Getopt-Long-Descriptive>.
589I will be notified, and then you'll automatically be notified of progress on
590your bug as I make changes.
591
592=head1 COPYRIGHT & LICENSE
593
594Copyright 2005 Hans Dieter Pearcey, all rights reserved.
595
596This program is free software; you can redistribute it and/or modify it
597under the same terms as Perl itself.
598
599=cut
600
60117µs1; # End of Getopt::Long::Descriptive
 
# spent 78µs within Getopt::Long::Descriptive::CORE:match which was called 61 times, avg 1µs/call: # 38 times (45µs+0s) by Getopt::Long::Descriptive::__ANON__[/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/Getopt/Long/Descriptive.pm:430] at line 373, avg 1µs/call # 22 times (32µs+0s) by Getopt::Long::Descriptive::__ANON__[/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/Getopt/Long/Descriptive.pm:430] at line 379, avg 1µs/call # once (1µs+0s) by Getopt::Long::Descriptive::__ANON__[/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/Getopt/Long/Descriptive.pm:430] at line 363
sub Getopt::Long::Descriptive::CORE:match; # opcode
# spent 3µs within Getopt::Long::Descriptive::CORE:qr which was called: # once (3µs+0s) by MouseX::Getopt::GLD::BEGIN@12 at line 299
sub Getopt::Long::Descriptive::CORE:qr; # opcode
# spent 96µs within Getopt::Long::Descriptive::CORE:regcomp which was called 66 times, avg 1µs/call: # 66 times (96µs+0s) by Getopt::Long::Descriptive::_strip_assignment at line 303, avg 1µs/call
sub Getopt::Long::Descriptive::CORE:regcomp; # opcode
# spent 13µs within Getopt::Long::Descriptive::CORE:sort which was called: # once (13µs+0s) by Getopt::Long::Descriptive::__ANON__[/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/Getopt/Long/Descriptive.pm:430] at line 376
sub Getopt::Long::Descriptive::CORE:sort; # opcode
# spent 243µs within Getopt::Long::Descriptive::CORE:subst which was called 68 times, avg 4µs/call: # 66 times (237µs+0s) by Getopt::Long::Descriptive::_strip_assignment at line 303, avg 4µs/call # once (3µs+0s) by Getopt::Long::Descriptive::__ANON__[/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/Getopt/Long/Descriptive.pm:430] at line 390 # once (3µs+0s) by Getopt::Long::Descriptive::__ANON__[/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/Getopt/Long/Descriptive.pm:430] at line 391
sub Getopt::Long::Descriptive::CORE:subst; # opcode
# spent 6µs within Getopt::Long::Descriptive::CORE:substcont which was called 3 times, avg 2µs/call: # 3 times (6µs+0s) by Getopt::Long::Descriptive::__ANON__[/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/Getopt/Long/Descriptive.pm:430] at line 390, avg 2µs/call
sub Getopt::Long::Descriptive::CORE:substcont; # opcode