← 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:08 2010

Filename/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/Getopt/Long/Descriptive/Opts.pm
StatementsExecuted 74 statements in 1.00ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
111281µs326µsGetopt::Long::Descriptive::Opts::::___class_for_optGetopt::Long::Descriptive::Opts::___class_for_opt
11163µs390µsGetopt::Long::Descriptive::Opts::::___new_opt_objGetopt::Long::Descriptive::Opts::___new_opt_obj
221136µs36µsGetopt::Long::Descriptive::Opts::::CORE:matchGetopt::Long::Descriptive::Opts::CORE:match (opcode)
11126µs32µsGetopt::Long::Descriptive::::BEGIN@1 Getopt::Long::Descriptive::BEGIN@1
11112µs75µsGetopt::Long::Descriptive::Opts::::BEGIN@5Getopt::Long::Descriptive::Opts::BEGIN@5
11112µs36µsGetopt::Long::Descriptive::Opts::::BEGIN@110Getopt::Long::Descriptive::Opts::BEGIN@110
11111µs21µsGetopt::Long::Descriptive::::BEGIN@2 Getopt::Long::Descriptive::BEGIN@2
0000s0sGetopt::Long::Descriptive::Opts::::__ANON__[:114]Getopt::Long::Descriptive::Opts::__ANON__[:114]
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
1227µs237µs
# spent 32µs (26+5) within Getopt::Long::Descriptive::BEGIN@1 which was called: # once (26µs+5µs) by Getopt::Long::Descriptive::BEGIN@12 at line 1
use strict;
# spent 32µs making 1 call to Getopt::Long::Descriptive::BEGIN@1 # spent 5µs making 1 call to strict::import
2241µs231µs
# spent 21µs (11+10) within Getopt::Long::Descriptive::BEGIN@2 which was called: # once (11µs+10µs) by Getopt::Long::Descriptive::BEGIN@12 at line 2
use warnings;
# spent 21µs making 1 call to Getopt::Long::Descriptive::BEGIN@2 # spent 10µs making 1 call to warnings::import
3package Getopt::Long::Descriptive::Opts;
4
52342µs2138µs
# spent 75µs (12+63) within Getopt::Long::Descriptive::Opts::BEGIN@5 which was called: # once (12µs+63µs) by Getopt::Long::Descriptive::BEGIN@12 at line 5
use Scalar::Util qw(blessed weaken);
# spent 75µs making 1 call to Getopt::Long::Descriptive::Opts::BEGIN@5 # spent 63µs making 1 call to Exporter::import
6
7=head1 NAME
8
9Getopt::Long::Descriptive::Opts - object representing command line switches
10
11=head1 VERSION
12
13Version 0.086
14
15=cut
16
1712µsour $VERSION = '0.086';
18
19=head1 DESCRIPTION
20
21This class is the base class of all C<$opt> objects returned by
22L<Getopt::Long::Descriptive>. In general, you do not want to think about this
23class, look at it, or alter it. Seriously, it's pretty dumb.
24
25Every call to C<describe_options> will return a object of a new subclass of
26this class. It will have a method for the canonical name of each option
27possible given the option specifications.
28
29Method names beginning with an single underscore are public, and are named that
30way to avoid conflict with automatically generated methods. Methods with
31multiple underscores (in case you're reading the source) are private.
32
33=head1 METHODS
34
35B<Achtung!> All methods beginning with an underscore are experimental as of
36today, 2009-12-12. They are likely to be formally made permanent soon.
37
38=head2 _specified
39
40This method returns true if the given name was specified on the command line.
41
42For example, if C<@ARGS> was "C<< --foo --bar 10 >>" and C<baz> is defined by a
43default, C<_specified> will return true for foo and bar, and false for baz.
44
45=cut
46
4711µsmy %_CREATED_OPTS;
4811µsmy $SERIAL_NUMBER = 1;
49
50sub _specified {
51 my ($self, $name) = @_;
52 my $meta = $_CREATED_OPTS{ blessed $self }{meta};
53 return $meta->{given}{ $name };
54}
55
56=head2 _specified_opts
57
58This method returns an opt object in which only explicitly specified values are
59defined. Values which were set by defaults will appear undef.
60
61=cut
62
63sub _specified_opts {
64 my ($self) = @_;
65
66 my $class = blessed $self;
67 my $meta = $_CREATED_OPTS{ $class }{meta};
68
69 return $meta->{specified_opts} if $meta->{specified_opts};
70
71 my @keys = grep { $meta->{given}{ $_ } } (keys %{ $meta->{given} });
72
73 my %opts;
74 @opts{ @keys } = @$self{ @keys };
75
76 $meta->{specified_opts} = \%opts;
77
78 bless $meta->{specified_opts} => $class;
79 weaken $meta->{specified_opts};
80
81 $meta->{specified_opts};
82}
83
84=head2 _complete_opts
85
86This method returns the opts object with all values, including those set by
87defaults. It is probably not going to be very often-used.
88
89=cut
90
91sub _complete_opts {
92 my ($self) = @_;
93
94 my $class = blessed $self;
95 my $meta = $_CREATED_OPTS{ $class }{meta};
96 return $meta->{complete_opts};
97}
98
99
# spent 326µs (281+46) within Getopt::Long::Descriptive::Opts::___class_for_opt which was called: # once (281µs+46µs) by Getopt::Long::Descriptive::Opts::___new_opt_obj at line 126
sub ___class_for_opt {
100847µs my ($class, $arg) = @_;
101
102 my $values = $arg->{values};
10322114µs2236µs my @bad = grep { $_ !~ /^[a-z_]\w*$/ } keys %$values;
# spent 36µs making 22 calls to Getopt::Long::Descriptive::Opts::CORE:match, avg 2µs/call
104 Carp::confess("perverse option names given: @bad") if @bad;
105
106 my $new_class = "$class\::__OPT__::" . $SERIAL_NUMBER++;
107 $_CREATED_OPTS{ $new_class } = { meta => $arg };
108
109 {
1102195µs260µs
# spent 36µs (12+24) within Getopt::Long::Descriptive::Opts::BEGIN@110 which was called: # once (12µs+24µs) by Getopt::Long::Descriptive::BEGIN@12 at line 110
no strict 'refs';
# spent 36µs making 1 call to Getopt::Long::Descriptive::Opts::BEGIN@110 # spent 24µs making 1 call to strict::unimport
111342µs110µs ${"$new_class\::VERSION"} = $class->VERSION;
# spent 10µs making 1 call to UNIVERSAL::VERSION
112 *{"$new_class\::ISA"} = [ 'Getopt::Long::Descriptive::Opts' ];
113 for my $opt (keys %$values) {
11422126µs *{"$new_class\::$opt"} = sub { $_[0]->{ $opt } };
115 }
116 }
117
118 return $new_class;
119}
120
121
# spent 390µs (63+326) within Getopt::Long::Descriptive::Opts::___new_opt_obj which was called: # once (63µs+326µ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 426 of Getopt/Long/Descriptive.pm
sub ___new_opt_obj {
122764µs my ($class, $arg) = @_;
123
124 my $copy = { %{ $arg->{values} } };
125
1261326µs my $new_class = $class->___class_for_opt($arg);
# spent 326µs making 1 call to Getopt::Long::Descriptive::Opts::___class_for_opt
127
128 # This is stupid, but the traditional behavior was that if --foo was not
129 # given, there is no $opt->{foo}; it started to show up when we "needed" all
130 # the keys to generate a class, but was undef; this wasn't a problem, but
131 # broke tests of things that were relying on not-exists like tests of %$opt
132 # contents or MooseX::Getopt which wanted to use things as args for new --
133 # undef would not pass an Int TC. Easier to just do this. -- rjbs,
134 # 2009-11-27
135 delete $copy->{$_} for grep { ! defined $copy->{$_} } keys %$copy;
136
137 my $self = bless $copy => $new_class;
138
139 $_CREATED_OPTS{ $new_class }{meta}{complete_opts} = $self;
140 # weaken $_CREATED_OPTS{ $new_class }{meta}{complete_opts};
141
142 return $self;
143}
144
145=head1 AUTHOR
146
147Hans Dieter Pearcey, C<< <hdp@cpan.org> >>
148
149=head1 BUGS
150
151Please report any bugs or feature requests to
152C<bug-getopt-long-descriptive@rt.cpan.org>, or through the web interface at
153L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Getopt-Long-Descriptive>.
154I will be notified, and then you'll automatically be notified of progress on
155your bug as I make changes.
156
157=head1 COPYRIGHT & LICENSE
158
159Copyright 2005 Hans Dieter Pearcey, all rights reserved.
160
161This program is free software; you can redistribute it and/or modify it
162under the same terms as Perl itself.
163
164=cut
165
16613µs1;
 
# spent 36µs within Getopt::Long::Descriptive::Opts::CORE:match which was called 22 times, avg 2µs/call: # 22 times (36µs+0s) by Getopt::Long::Descriptive::Opts::___class_for_opt at line 103, avg 2µs/call
sub Getopt::Long::Descriptive::Opts::CORE:match; # opcode