Profile of Getopt/Long/Descriptive/Opts.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/Opts.pm
Statements | Executed 58 statements in 646µs

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
2 | 1 | 1 | 76µs | 89µs | Getopt::Long::Descriptive::Opts::::___class_for_optGetopt::Long::Descriptive::Opts::___class_for_opt
2 | 1 | 1 | 24µs | 113µs | Getopt::Long::Descriptive::Opts::::___new_opt_objGetopt::Long::Descriptive::Opts::___new_opt_obj
1 | 1 | 1 | 11µs | 22µs | Getopt::Long::Descriptive::::BEGIN@1 Getopt::Long::Descriptive::BEGIN@1
1 | 1 | 1 | 8µs | 37µs | Getopt::Long::Descriptive::Opts::::BEGIN@6Getopt::Long::Descriptive::Opts::BEGIN@6
1 | 1 | 1 | 7µs | 11µs | Getopt::Long::Descriptive::::BEGIN@2 Getopt::Long::Descriptive::BEGIN@2
1 | 1 | 1 | 7µs | 19µs | Getopt::Long::Descriptive::Opts::::BEGIN@99Getopt::Long::Descriptive::Opts::BEGIN@99
5 | 1 | 1 | 5µs | 5µs | Getopt::Long::Descriptive::Opts::::CORE:matchGetopt::Long::Descriptive::Opts::CORE:match (opcode)
0 | 0 | 0 | 0s | 0s | Getopt::Long::Descriptive::Opts::::__ANON__[:103]Getopt::Long::Descriptive::Opts::__ANON__[:103]
0 | 0 | 0 | 0s | 0s | Getopt::Long::Descriptive::Opts::::_complete_optsGetopt::Long::Descriptive::Opts::_complete_opts
0 | 0 | 0 | 0s | 0s | Getopt::Long::Descriptive::Opts::::_specifiedGetopt::Long::Descriptive::Opts::_specified
0 | 0 | 0 | 0s | 0s | Getopt::Long::Descriptive::Opts::::_specified_optsGetopt::Long::Descriptive::Opts::_specified_opts

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 | 34µs | # spent 22µs (11+12) within Getopt::Long::Descriptive::BEGIN@1 which was called: # once (11µs+12µs) by Getopt::Long::Descriptive::BEGIN@13 at line 1 use strict; # spent 22µs making 1 call to Getopt::Long::Descriptive::BEGIN@1 # spent 12µs making 1 call to strict::import
2 | 2 | 37µs | 2 | 15µs | # spent 11µs (7+4) within Getopt::Long::Descriptive::BEGIN@2 which was called: # once (7µs+4µs) by Getopt::Long::Descriptive::BEGIN@13 at line 2 use warnings; # spent 11µs making 1 call to Getopt::Long::Descriptive::BEGIN@2 # spent 4µs making 1 call to warnings::import
3 |  |  |  |  | package Getopt::Long::Descriptive::Opts;
4 |  |  |  |  | # ABSTRACT: object representing command line switches
5 | 1 | 400ns |  |  | $Getopt::Long::Descriptive::Opts::VERSION = '0.097';
6 | 2 | 294µs | 2 | 67µs | # spent 37µs (8+30) within Getopt::Long::Descriptive::Opts::BEGIN@6 which was called: # once (8µs+30µs) by Getopt::Long::Descriptive::BEGIN@13 at line 6 use Scalar::Util qw(blessed weaken); # spent 37µs making 1 call to Getopt::Long::Descriptive::Opts::BEGIN@6 # spent 30µs making 1 call to Exporter::import
7 |  |  |  |  |
8 |  |  |  |  | # =head1 DESCRIPTION
9 |  |  |  |  | #
10 |  |  |  |  | # This class is the base class of all C<$opt> objects returned by
11 |  |  |  |  | # L<Getopt::Long::Descriptive>. In general, you do not want to think about this
12 |  |  |  |  | # class, look at it, or alter it. Seriously, it's pretty dumb.
13 |  |  |  |  | #
14 |  |  |  |  | # Every call to C<describe_options> will return a object of a new subclass of
15 |  |  |  |  | # this class. It will have a method for the canonical name of each option
16 |  |  |  |  | # possible given the option specifications.
17 |  |  |  |  | #
18 |  |  |  |  | # Method names beginning with an single underscore are public, and are named that
19 |  |  |  |  | # way to avoid conflict with automatically generated methods. Methods with
20 |  |  |  |  | # multiple underscores (in case you're reading the source) are private.
21 |  |  |  |  | #
22 |  |  |  |  | # =head1 METHODS
23 |  |  |  |  | #
24 |  |  |  |  | # B<Achtung!> All methods beginning with an underscore are experimental as of
25 |  |  |  |  | # today, 2009-12-12. They are likely to be formally made permanent soon.
26 |  |  |  |  | #
27 |  |  |  |  | # =head2 _specified
28 |  |  |  |  | #
29 |  |  |  |  | # This method returns true if the given name was specified on the command line.
30 |  |  |  |  | #
31 |  |  |  |  | # For example, if C<@ARGS> was "C<< --foo --bar 10 >>" and C<baz> is defined by a
32 |  |  |  |  | # default, C<_specified> will return true for foo and bar, and false for baz.
33 |  |  |  |  | #
34 |  |  |  |  | # =cut
35 |  |  |  |  |
36 | 1 | 100ns |  |  | my %_CREATED_OPTS;
37 | 1 | 200ns |  |  | my $SERIAL_NUMBER = 1;
38 |  |  |  |  |
39 |  |  |  |  | sub _specified {
40 |  |  |  |  | my ($self, $name) = @_;
41 |  |  |  |  | my $meta = $_CREATED_OPTS{ blessed $self }{meta};
42 |  |  |  |  | return $meta->{given}{ $name };
43 |  |  |  |  | }
44 |  |  |  |  |
45 |  |  |  |  | # =head2 _specified_opts
46 |  |  |  |  | #
47 |  |  |  |  | # This method returns an opt object in which only explicitly specified values are
48 |  |  |  |  | # defined. Values which were set by defaults will appear undef.
49 |  |  |  |  | #
50 |  |  |  |  | # =cut
51 |  |  |  |  |
52 |  |  |  |  | sub _specified_opts {
53 |  |  |  |  | my ($self) = @_;
54 |  |  |  |  |
55 |  |  |  |  | my $class = blessed $self;
56 |  |  |  |  | my $meta = $_CREATED_OPTS{ $class }{meta};
57 |  |  |  |  |
58 |  |  |  |  | return $meta->{specified_opts} if $meta->{specified_opts};
59 |  |  |  |  |
60 |  |  |  |  | my @keys = grep { $meta->{given}{ $_ } } (keys %{ $meta->{given} });
61 |  |  |  |  |
62 |  |  |  |  | my %opts;
63 |  |  |  |  | @opts{ @keys } = @$self{ @keys };
64 |  |  |  |  |
65 |  |  |  |  | $meta->{specified_opts} = \%opts;
66 |  |  |  |  |
67 |  |  |  |  | bless $meta->{specified_opts} => $class;
68 |  |  |  |  | weaken $meta->{specified_opts};
69 |  |  |  |  |
70 |  |  |  |  | $meta->{specified_opts};
71 |  |  |  |  | }
72 |  |  |  |  |
73 |  |  |  |  | # =head2 _complete_opts
74 |  |  |  |  | #
75 |  |  |  |  | # This method returns the opts object with all values, including those set by
76 |  |  |  |  | # defaults. It is probably not going to be very often-used.
77 |  |  |  |  | #
78 |  |  |  |  | # =cut
79 |  |  |  |  |
80 |  |  |  |  | sub _complete_opts {
81 |  |  |  |  | my ($self) = @_;
82 |  |  |  |  |
83 |  |  |  |  | my $class = blessed $self;
84 |  |  |  |  | my $meta = $_CREATED_OPTS{ $class }{meta};
85 |  |  |  |  | return $meta->{complete_opts};
86 |  |  |  |  | }
87 |  |  |  |  |
88 |  |  |  |  | # spent 89µs (76+12) within Getopt::Long::Descriptive::Opts::___class_for_opt which was called 2 times, avg 44µs/call: # 2 times (76µs+12µs) by Getopt::Long::Descriptive::Opts::___new_opt_obj at line 115, avg 44µs/call sub ___class_for_opt {
89 | 2 | 600ns |  |  | my ($class, $arg) = @_;
90 |  |  |  |  |
91 | 2 | 800ns |  |  | my $values = $arg->{values};
92 | 7 | 20µs | 5 | 5µs | my @bad = grep { $_ !~ /^[a-z_]\w*$/ } keys %$values; # spent 5µs making 5 calls to Getopt::Long::Descriptive::Opts::CORE:match, avg 1µs/call
93 | 2 | 800ns |  |  | Carp::confess("perverse option names given: @bad") if @bad;
94 |  |  |  |  |
95 | 2 | 3µs |  |  | my $new_class = "$class\::__OPT__::" . $SERIAL_NUMBER++;
96 | 2 | 2µs |  |  | $_CREATED_OPTS{ $new_class } = { meta => $arg };
97 |  |  |  |  |
98 |  |  |  |  | {
99 | 4 | 175µs | 2 | 31µs | # spent 19µs (7+12) within Getopt::Long::Descriptive::Opts::BEGIN@99 which was called: # once (7µs+12µs) by Getopt::Long::Descriptive::BEGIN@13 at line 99 no strict 'refs'; # spent 19µs making 1 call to Getopt::Long::Descriptive::Opts::BEGIN@99 # spent 12µs making 1 call to strict::unimport
100 | 2 | 24µs | 2 | 7µs | ${"$new_class\::VERSION"} = $class->VERSION; # spent 7µs making 2 calls to UNIVERSAL::VERSION, avg 4µs/call
101 | 2 | 14µs |  |  | *{"$new_class\::ISA"} = [ 'Getopt::Long::Descriptive::Opts' ];
102 | 2 | 3µs |  |  | for my $opt (keys %$values) {
103 | 5 | 17µs |  |  | *{"$new_class\::$opt"} = sub { $_[0]->{ $opt } };
104 |  |  |  |  | }
105 |  |  |  |  | }
106 |  |  |  |  |
107 | 2 | 6µs |  |  | return $new_class;
108 |  |  |  |  | }
109 |  |  |  |  |
110 |  |  |  |  | # spent 113µs (24+89) within Getopt::Long::Descriptive::Opts::___new_opt_obj which was called 2 times, avg 56µs/call: # 2 times (24µs+89µs) by Getopt::Long::Descriptive::__ANON__[/usr/local/share/perl/5.18.2/Getopt/Long/Descriptive.pm:470] at line 466 of Getopt/Long/Descriptive.pm, avg 56µs/call sub ___new_opt_obj {
111 | 2 | 800ns |  |  | my ($class, $arg) = @_;
112 |  |  |  |  |
113 | 2 | 3µs |  |  | my $copy = { %{ $arg->{values} } };
114 |  |  |  |  |
115 | 2 | 4µs | 2 | 89µs | my $new_class = $class->___class_for_opt($arg); # spent 89µs making 2 calls to Getopt::Long::Descriptive::Opts::___class_for_opt, avg 44µs/call
116 |  |  |  |  |
117 |  |  |  |  | # This is stupid, but the traditional behavior was that if --foo was not
118 |  |  |  |  | # given, there is no $opt->{foo}; it started to show up when we "needed" all
119 |  |  |  |  | # the keys to generate a class, but was undef; this wasn't a problem, but
120 |  |  |  |  | # broke tests of things that were relying on not-exists like tests of %$opt
121 |  |  |  |  | # contents or MooseX::Getopt which wanted to use things as args for new --
122 |  |  |  |  | # undef would not pass an Int TC. Easier to just do this. -- rjbs,
123 |  |  |  |  | # 2009-11-27
124 | 2 | 7µs |  |  | delete $copy->{$_} for grep { ! defined $copy->{$_} } keys %$copy;
125 |  |  |  |  |
126 | 2 | 3µs |  |  | my $self = bless $copy => $new_class;
127 |  |  |  |  |
128 | 2 | 2µs |  |  | $_CREATED_OPTS{ $new_class }{meta}{complete_opts} = $self;
129 |  |  |  |  | # weaken $_CREATED_OPTS{ $new_class }{meta}{complete_opts};
130 |  |  |  |  |
131 | 2 | 6µs |  |  | return $self;
132 |  |  |  |  | }
133 |  |  |  |  |
134 | 1 | 3µs |  |  | 1;
135 |  |  |  |  |
136 |  |  |  |  | __END__
|  |  |  |  | # spent 5µs within Getopt::Long::Descriptive::Opts::CORE:match which was called 5 times, avg 1µs/call: # 5 times (5µs+0s) by Getopt::Long::Descriptive::Opts::___class_for_opt at line 92, avg 1µs/call sub Getopt::Long::Descriptive::Opts::CORE:match; # opcode