Filename | /usr/local/share/perl/5.18.2/Getopt/Long/Descriptive/Opts.pm |
Statements | Executed 58 statements in 646µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
2 | 1 | 1 | 76µs | 89µs | ___class_for_opt | Getopt::Long::Descriptive::Opts::
2 | 1 | 1 | 24µs | 113µs | ___new_opt_obj | Getopt::Long::Descriptive::Opts::
1 | 1 | 1 | 11µs | 22µs | BEGIN@1 | Getopt::Long::Descriptive::
1 | 1 | 1 | 8µs | 37µs | BEGIN@6 | Getopt::Long::Descriptive::Opts::
1 | 1 | 1 | 7µs | 11µs | BEGIN@2 | Getopt::Long::Descriptive::
1 | 1 | 1 | 7µs | 19µs | BEGIN@99 | Getopt::Long::Descriptive::Opts::
5 | 1 | 1 | 5µs | 5µs | CORE:match (opcode) | Getopt::Long::Descriptive::Opts::
0 | 0 | 0 | 0s | 0s | __ANON__[:103] | Getopt::Long::Descriptive::Opts::
0 | 0 | 0 | 0s | 0s | _complete_opts | Getopt::Long::Descriptive::Opts::
0 | 0 | 0 | 0s | 0s | _specified | Getopt::Long::Descriptive::Opts::
0 | 0 | 0 | 0s | 0s | _specified_opts | Getopt::Long::Descriptive::Opts::
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 # 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 # 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 # 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 | ||||
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 # 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 | ||||
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 |