← 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
StatementsExecuted 58 statements in 646µs
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
21176µs89µsGetopt::Long::Descriptive::Opts::::___class_for_optGetopt::Long::Descriptive::Opts::___class_for_opt
21124µs113µsGetopt::Long::Descriptive::Opts::::___new_opt_objGetopt::Long::Descriptive::Opts::___new_opt_obj
11111µs22µsGetopt::Long::Descriptive::::BEGIN@1 Getopt::Long::Descriptive::BEGIN@1
1118µs37µsGetopt::Long::Descriptive::Opts::::BEGIN@6Getopt::Long::Descriptive::Opts::BEGIN@6
1117µs11µsGetopt::Long::Descriptive::::BEGIN@2 Getopt::Long::Descriptive::BEGIN@2
1117µs19µsGetopt::Long::Descriptive::Opts::::BEGIN@99Getopt::Long::Descriptive::Opts::BEGIN@99
5115µs5µsGetopt::Long::Descriptive::Opts::::CORE:matchGetopt::Long::Descriptive::Opts::CORE:match (opcode)
0000s0sGetopt::Long::Descriptive::Opts::::__ANON__[:103]Getopt::Long::Descriptive::Opts::__ANON__[:103]
0000s0sGetopt::Long::Descriptive::Opts::::_complete_optsGetopt::Long::Descriptive::Opts::_complete_opts
0000s0sGetopt::Long::Descriptive::Opts::::_specifiedGetopt::Long::Descriptive::Opts::_specified
0000s0sGetopt::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
1221µs234µ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
2237µs215µ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
3package Getopt::Long::Descriptive::Opts;
4# ABSTRACT: object representing command line switches
51400ns$Getopt::Long::Descriptive::Opts::VERSION = '0.097';
62294µs267µ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
361100nsmy %_CREATED_OPTS;
371200nsmy $SERIAL_NUMBER = 1;
38
39sub _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
52sub _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
80sub _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 {
892600ns my ($class, $arg) = @_;
90
912800ns my $values = $arg->{values};
92720µs55µ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
932800ns Carp::confess("perverse option names given: @bad") if @bad;
94
9523µs my $new_class = "$class\::__OPT__::" . $SERIAL_NUMBER++;
9622µs $_CREATED_OPTS{ $new_class } = { meta => $arg };
97
98 {
994175µs231µ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
100224µs27µs ${"$new_class\::VERSION"} = $class->VERSION;
# spent 7µs making 2 calls to UNIVERSAL::VERSION, avg 4µs/call
101214µs *{"$new_class\::ISA"} = [ 'Getopt::Long::Descriptive::Opts' ];
10223µs for my $opt (keys %$values) {
103517µs *{"$new_class\::$opt"} = sub { $_[0]->{ $opt } };
104 }
105 }
106
10726µ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 {
1112800ns my ($class, $arg) = @_;
112
11323µs my $copy = { %{ $arg->{values} } };
114
11524µs289µ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
12427µs delete $copy->{$_} for grep { ! defined $copy->{$_} } keys %$copy;
125
12623µs my $self = bless $copy => $new_class;
127
12822µs $_CREATED_OPTS{ $new_class }{meta}{complete_opts} = $self;
129 # weaken $_CREATED_OPTS{ $new_class }{meta}{complete_opts};
130
13126µs return $self;
132}
133
13413µs1;
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