← Index
NYTProf Performance Profile   « block view • line view • sub view »
For 05.Domain_and_Item.t
  Run on Tue May 4 17:21:41 2010
Reported on Tue May 4 17:23:04 2010

File /usr/local/lib/perl5/site_perl/5.10.1/Data/OptList.pm
Statements Executed 11560
Statement Execution Time 7.82ms
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
250435.81ms7.93msData::OptList::::mkoptData::OptList::mkopt
407211.50ms2.13msData::OptList::::__is_aData::OptList::__is_a
1111.17ms1.48msData::OptList::::BEGIN@7Data::OptList::BEGIN@7
1111.06ms1.32msData::OptList::::BEGIN@8Data::OptList::BEGIN@8
3921415µs4.20msData::OptList::::mkopt_hashData::OptList::mkopt_hash
11113µs21µsData::OptList::::BEGIN@4Data::OptList::BEGIN@4
11113µs16µsData::OptList::::BEGIN@3Data::OptList::BEGIN@3
11110µs17µsData::OptList::::BEGIN@214Data::OptList::BEGIN@214
1117µs7µsData::OptList::::BEGIN@131Data::OptList::BEGIN@131
1113µs3µsData::OptList::::BEGIN@6Data::OptList::BEGIN@6
0000s0sData::OptList::::__ANON__[:143]Data::OptList::__ANON__[:143]
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1
2package Data::OptList;
3319µs218µs
# spent 16µs (13+3) within Data::OptList::BEGIN@3 which was called # once (13µs+3µs) by Sub::Exporter::BEGIN@7 at line 3
use strict;
# spent 16µs making 1 call to Data::OptList::BEGIN@3 # spent 3µs making 1 call to strict::import
4319µs230µs
# spent 21µs (13+8) within Data::OptList::BEGIN@4 which was called # once (13µs+8µs) by Sub::Exporter::BEGIN@7 at line 4
use warnings;
# spent 21µs making 1 call to Data::OptList::BEGIN@4 # spent 8µs making 1 call to warnings::import
5
6314µs13µs
# spent 3µs within Data::OptList::BEGIN@6 which was called # once (3µs+0s) by Sub::Exporter::BEGIN@7 at line 6
use List::Util ();
# spent 3µs making 1 call to Data::OptList::BEGIN@6
73110µs11.48ms
# spent 1.48ms (1.17+316µs) within Data::OptList::BEGIN@7 which was called # once (1.17ms+316µs) by Sub::Exporter::BEGIN@7 at line 7
use Params::Util ();
# spent 1.48ms making 1 call to Data::OptList::BEGIN@7
83163µs21.33ms
# spent 1.32ms (1.06+262µs) within Data::OptList::BEGIN@8 which was called # once (1.06ms+262µs) by Sub::Exporter::BEGIN@7 at line 8
use Sub::Install 0.92 ();
# spent 1.32ms making 1 call to Data::OptList::BEGIN@8 # spent 15µs making 1 call to UNIVERSAL::VERSION
9
10=head1 NAME
11
12Data::OptList - parse and validate simple name/value option pairs
13
14=head1 VERSION
15
16version 0.104
17
18=cut
19
201500nsour $VERSION = '0.104';
21
22=head1 SYNOPSIS
23
24 use Data::OptList;
25
26 my $options = Data::Optlist::mkopt([
27 qw(key1 key2 key3 key4),
28 key5 => { ... },
29 key6 => [ ... ],
30 key7 => sub { ... },
31 key8 => { ... },
32 key8 => [ ... ],
33 ]);
34
35...is the same thing, more or less, as:
36
37 my $options = [
38 [ key1 => undef, ],
39 [ key2 => undef, ],
40 [ key3 => undef, ],
41 [ key4 => undef, ],
42 [ key5 => { ... }, ],
43 [ key6 => [ ... ], ],
44 [ key7 => sub { ... }, ],
45 [ key8 => { ... }, ],
46 [ key8 => [ ... ], ],
47 ]);
48
49=head1 DESCRIPTION
50
51Hashes are great for storing named data, but if you want more than one entry
52for a name, you have to use a list of pairs. Even then, this is really boring
53to write:
54
55 $values = [
56 foo => undef,
57 bar => undef,
58 baz => undef,
59 xyz => { ... },
60 ];
61
62Just look at all those undefs! Don't worry, we can get rid of those:
63
64 $values = [
65 map { $_ => undef } qw(foo bar baz),
66 xyz => { ... },
67 ];
68
69Aaaauuugh! We've saved a little typing, but now it requires thought to read,
70and thinking is even worse than typing... and it's got a bug! It looked right,
71didn't it? Well, the C<< xyz => { ... } >> gets consumed by the map, and we
72don't get the data we wanted.
73
74With Data::OptList, you can do this instead:
75
76 $values = Data::OptList::mkopt([
77 qw(foo bar baz),
78 xyz => { ... },
79 ]);
80
81This works by assuming that any defined scalar is a name and any reference
82following a name is its value.
83
84=head1 FUNCTIONS
85
86=head2 mkopt
87
88 my $opt_list = Data::OptList::mkopt(
89 $input,
90 $moniker,
91 $require_unique,
92 $must_be,
93 );
94
95This produces an array of arrays; the inner arrays are name/value pairs.
96Values will be either "undef" or a reference.
97
98Valid values for C<$input>:
99
100 undef -> []
101 hashref -> [ [ key1 => value1 ] ... ] # non-ref values become undef
102 arrayref -> every value followed by a ref becomes a pair: [ value => ref ]
103 every value followed by undef becomes a pair: [ value => undef ]
104 otherwise, it becomes [ value => undef ] like so:
105 [ "a", "b", [ 1, 2 ] ] -> [ [ a => undef ], [ b => [ 1, 2 ] ] ]
106
107C<$moniker> is a name describing the data, which will be used in error
108messages.
109
110If C<$require_unique> is true, an error will be thrown if any name is given
111more than once.
112
113C<$must_be> is either a scalar or array of scalars; it defines what kind(s) of
114refs may be values. If an invalid value is found, an exception is thrown. If
115no value is passed for this argument, any reference is valid. If C<$must_be>
116specifies that values must be CODE, HASH, ARRAY, or SCALAR, then Params::Util
117is used to check whether the given value can provide that interface.
118Otherwise, it checks that the given value is an object of the kind.
119
120In other words:
121
122 [ qw(SCALAR HASH Object::Known) ]
123
124Means:
125
126 _SCALAR0($value) or _HASH($value) or _INSTANCE($value, 'Object::Known')
127
128=cut
129
1301100nsmy %test_for;
131
# spent 7µs within Data::OptList::BEGIN@131 which was called # once (7µs+0s) by Sub::Exporter::BEGIN@7 at line 138
BEGIN {
13218µs %test_for = (
133 CODE => \&Params::Util::_CODELIKE, ## no critic
134 HASH => \&Params::Util::_HASHLIKE, ## no critic
135 ARRAY => \&Params::Util::_ARRAYLIKE, ## no critic
136 SCALAR => \&Params::Util::_SCALAR0, ## no critic
137 );
1381300µs17µs}
# spent 7µs making 1 call to Data::OptList::BEGIN@131
139
140
# spent 2.13ms (1.50+629µs) within Data::OptList::__is_a which was called 407 times, avg 5µs/call: # 208 times (707µs+-707µs) by List::Util::first at line 143, avg 0s/call # 199 times (792µs+1.34ms) by Data::OptList::mkopt at line 178, avg 11µs/call
sub __is_a {
141407123µs my ($got, $expected) = @_;
142
1436151.11ms4071.34ms return List::Util::first { __is_a($got, $_) } @$expected if ref $expected;
# spent 1.34ms making 199 calls to List::Util::first, avg 7µs/call # spent 808µs making 208 calls to Data::OptList::__is_a, avg 4µs/call, recursion: max depth 1, time 808µs
144
145 return defined (
146208825µs208100µs exists($test_for{$expected})
# spent 79µs making 190 calls to Params::Util::_CODELIKE, avg 414ns/call # spent 13µs making 9 calls to Params::Util::_HASHLIKE, avg 1µs/call # spent 9µs making 9 calls to Params::Util::_ARRAYLIKE, avg 978ns/call
147 ? $test_for{$expected}->($got)
148 : Params::Util::_INSTANCE($got, $expected) ## no critic
149 );
150}
151
152
# spent 7.93ms (5.81+2.13) within Data::OptList::mkopt which was called 250 times, avg 32µs/call: # 125 times (3.32ms+0s) by Sub::Exporter::_expand_group at line 505 of Sub/Exporter.pm, avg 27µs/call # 76 times (554µs+0s) by Sub::Exporter::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/Sub/Exporter.pm:756] at line 735 of Sub/Exporter.pm, avg 7µs/call # 26 times (274µs+0s) by Moose::Util::_apply_all_roles at line 98 of Moose/Util.pm, avg 11µs/call # 23 times (1.66ms+2.13ms) by Data::OptList::mkopt_hash at line 203, avg 165µs/call
sub mkopt {
153250131µs my ($opt_list, $moniker, $require_unique, $must_be) = @_;
154
15525025µs return [] unless $opt_list;
156
157 $opt_list = [
158250166µs map { $_ => (ref $opt_list->{$_} ? $opt_list->{$_} : ()) } keys %$opt_list
159 ] if ref $opt_list eq 'HASH';
160
16125019µs my @return;
16225026µs my %seen;
163
164250531µs for (my $i = 0; $i < @$opt_list; $i++) { ## no critic
1651189390µs my $name = $opt_list->[$i];
166118912µs my $value;
167
1681189145µs if ($require_unique) {
169 Carp::croak "multiple definitions provided for $name" if $seen{$name}++;
170 }
171
1721189897µs if ($i == $#$opt_list) { $value = undef; }
173 elsif (not defined $opt_list->[$i+1]) { $value = undef; $i++ }
174 elsif (ref $opt_list->[$i+1]) { $value = $opt_list->[++$i] }
17582892µs else { $value = undef; }
176
1771189360µs if ($must_be and defined $value) {
178199180µs1992.13ms unless (__is_a($value, $must_be)) {
# spent 2.13ms making 199 calls to Data::OptList::__is_a, avg 11µs/call
179 my $ref = ref $value;
180 Carp::croak "$ref-ref values are not valid in $moniker opt list";
181 }
182 }
183
1841189906µs push @return, [ $name => $value ];
18525039µs }
186
187250756µs return \@return;
188}
189
190=head2 mkopt_hash
191
192 my $opt_hash = Data::OptList::mkopt_hash($input, $moniker, $must_be);
193
194Given valid C<L</mkopt>> input, this routine returns a reference to a hash. It
195will throw an exception if any name has more than one value.
196
197=cut
198
199
# spent 4.20ms (415µs+3.79) within Data::OptList::mkopt_hash which was called 39 times, avg 108µs/call: # 26 times (357µs+3.44ms) by Sub::Exporter::_rewrite_build_config at line 672 of Sub/Exporter.pm, avg 146µs/call # 13 times (57µs+343µs) by Sub::Exporter::_rewrite_build_config at line 685 of Sub/Exporter.pm, avg 31µs/call
sub mkopt_hash {
2003932µs my ($opt_list, $moniker, $must_be) = @_;
2013939µs return {} unless $opt_list;
202
2032328µs233.79ms $opt_list = mkopt($opt_list, $moniker, 1, $must_be);
# spent 3.79ms making 23 calls to Data::OptList::mkopt, avg 165µs/call
20423192µs my %hash = map { $_->[0] => $_->[1] } @$opt_list;
20523121µs return \%hash;
206}
207
208=head1 EXPORTS
209
210Both C<mkopt> and C<mkopt_hash> may be exported on request.
211
212=cut
213
214
# spent 17µs (10+7) within Data::OptList::BEGIN@214 which was called # once (10µs+7µs) by Sub::Exporter::BEGIN@7 at line 218
BEGIN {
21516µs17µs *import = Sub::Install::exporter {
# spent 7µs making 1 call to Sub::Install::exporter
216 exports => [qw(mkopt mkopt_hash)],
217 };
218135µs117µs}
# spent 17µs making 1 call to Data::OptList::BEGIN@214
219
220=head1 AUTHOR
221
222Ricardo SIGNES, C<< <rjbs@cpan.org> >>
223
224=head1 BUGS
225
226Please report any bugs or feature requests at L<http://rt.cpan.org>. I will be
227notified, and then you'll automatically be notified of progress on your bug as
228I make changes.
229
230=head1 COPYRIGHT
231
232Copyright 2006-2007, Ricardo SIGNES. This program is free software; you can
233redistribute it and/or modify it under the same terms as Perl itself.
234
235=cut
236
23713µs1;