File | /usr/local/share/perl/5.10.0/Data/OptList.pm |
Statements Executed | 3330 |
Total Time | 0.00584439999999998 seconds |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
164 | 5 | 4 | 4.12ms | 5.05ms | mkopt | Data::OptList::
80 | 2 | 1 | 576µs | 928µs | __is_a | Data::OptList::
18 | 2 | 1 | 278µs | 1.99ms | mkopt_hash | Data::OptList::
0 | 0 | 0 | 0s | 0s | BEGIN | Data::OptList::
0 | 0 | 0 | 0s | 0s | __ANON__[:143] | Data::OptList::
Line | Stmts. | Exclusive Time | Avg. | Code |
---|---|---|---|---|
1 | ||||
2 | package Data::OptList; | |||
3 | 3 | 26µs | 8µs | use strict; # spent 7µs making 1 call to strict::import |
4 | 3 | 27µs | 9µs | use warnings; # spent 24µs making 1 call to warnings::import |
5 | ||||
6 | 3 | 19µs | 6µs | use List::Util (); |
7 | 3 | 122µs | 41µs | use Params::Util (); |
8 | 3 | 216µs | 72µs | use Sub::Install 0.92 (); # spent 32µs making 1 call to UNIVERSAL::VERSION |
9 | ||||
10 | =head1 NAME | |||
11 | ||||
12 | Data::OptList - parse and validate simple name/value option pairs | |||
13 | ||||
14 | =head1 VERSION | |||
15 | ||||
16 | version 0.104 | |||
17 | ||||
18 | =cut | |||
19 | ||||
20 | 1 | 700ns | 700ns | our $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 | ||||
51 | Hashes are great for storing named data, but if you want more than one entry | |||
52 | for a name, you have to use a list of pairs. Even then, this is really boring | |||
53 | to write: | |||
54 | ||||
55 | $values = [ | |||
56 | foo => undef, | |||
57 | bar => undef, | |||
58 | baz => undef, | |||
59 | xyz => { ... }, | |||
60 | ]; | |||
61 | ||||
62 | Just 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 | ||||
69 | Aaaauuugh! We've saved a little typing, but now it requires thought to read, | |||
70 | and thinking is even worse than typing... and it's got a bug! It looked right, | |||
71 | didn't it? Well, the C<< xyz => { ... } >> gets consumed by the map, and we | |||
72 | don't get the data we wanted. | |||
73 | ||||
74 | With Data::OptList, you can do this instead: | |||
75 | ||||
76 | $values = Data::OptList::mkopt([ | |||
77 | qw(foo bar baz), | |||
78 | xyz => { ... }, | |||
79 | ]); | |||
80 | ||||
81 | This works by assuming that any defined scalar is a name and any reference | |||
82 | following 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 | ||||
95 | This produces an array of arrays; the inner arrays are name/value pairs. | |||
96 | Values will be either "undef" or a reference. | |||
97 | ||||
98 | Valid 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 | ||||
107 | C<$moniker> is a name describing the data, which will be used in error | |||
108 | messages. | |||
109 | ||||
110 | If C<$require_unique> is true, an error will be thrown if any name is given | |||
111 | more than once. | |||
112 | ||||
113 | C<$must_be> is either a scalar or array of scalars; it defines what kind(s) of | |||
114 | refs may be values. If an invalid value is found, an exception is thrown. If | |||
115 | no value is passed for this argument, any reference is valid. If C<$must_be> | |||
116 | specifies that values must be CODE, HASH, ARRAY, or SCALAR, then Params::Util | |||
117 | is used to check whether the given value can provide that interface. | |||
118 | Otherwise, it checks that the given value is an object of the kind. | |||
119 | ||||
120 | In other words: | |||
121 | ||||
122 | [ qw(SCALAR HASH Object::Known) ] | |||
123 | ||||
124 | Means: | |||
125 | ||||
126 | _SCALAR0($value) or _HASH($value) or _INSTANCE($value, 'Object::Known') | |||
127 | ||||
128 | =cut | |||
129 | ||||
130 | 1 | 200ns | 200ns | my %test_for; |
131 | BEGIN { | |||
132 | 1 | 12µs | 12µ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 | ); | |||
138 | 1 | 455µs | 455µs | } |
139 | ||||
140 | # spent 928µs (576+352) within Data::OptList::__is_a which was called 80 times, avg 12µs/call:
# 43 times (264µs+-264µs) by Data::OptList::__is_a or Data::OptList::__ANON__[/usr/local/share/perl/5.10.0/Data/OptList.pm:143] at line 143, avg 0s/call
# 37 times (312µs+616µs) by Data::OptList::mkopt at line 178, avg 25µs/call | |||
141 | 203 | 560µs | 3µs | my ($got, $expected) = @_; |
142 | ||||
143 | 43 | 279µs | 6µs | return List::Util::first { __is_a($got, $_) } @$expected if ref $expected; # spent 616µs making 37 calls to List::Util::first, avg 17µs/call
# spent 420µs making 43 calls to Data::OptList::__is_a, avg 0s/call, max recursion depth 1 |
144 | ||||
145 | return defined ( | |||
146 | exists($test_for{$expected}) # spent 96µs making 31 calls to Params::Util::_CODELIKE, avg 3µs/call
# spent 35µs making 6 calls to Params::Util::_HASHLIKE, avg 6µs/call
# spent 25µs making 6 calls to Params::Util::_ARRAYLIKE, avg 4µs/call | |||
147 | ? $test_for{$expected}->($got) | |||
148 | : Params::Util::_INSTANCE($got, $expected) ## no critic | |||
149 | ); | |||
150 | } | |||
151 | ||||
152 | # spent 5.05ms (4.12+928µs) within Data::OptList::mkopt which was called 164 times, avg 31µs/call:
# 71 times (1.46ms+0s) by Class::MOP::load_first_existing_class at line 81 of /usr/local/lib/perl/5.10.0/Class/MOP.pm, avg 21µs/call
# 37 times (465µs+0s) by Moose::Meta::Class::superclasses at line 279 of /usr/local/lib/perl/5.10.0/Moose/Meta/Class.pm, avg 13µs/call
# 22 times (1.12ms+0s) by Sub::Exporter::_expand_group at line 505 of /usr/local/share/perl/5.10.0/Sub/Exporter.pm, avg 51µs/call
# 21 times (295µs+0s) by Sub::Exporter::build_exporter or Sub::Exporter::__ANON__[/usr/local/share/perl/5.10.0/Sub/Exporter.pm:756] at line 735 of /usr/local/share/perl/5.10.0/Sub/Exporter.pm, avg 14µs/call
# 13 times (785µs+928µs) by Data::OptList::mkopt_hash at line 203, avg 132µs/call | |||
153 | 2987 | 3.84ms | 1µs | my ($opt_list, $moniker, $require_unique, $must_be) = @_; |
154 | ||||
155 | return [] unless $opt_list; | |||
156 | ||||
157 | $opt_list = [ | |||
158 | map { $_ => (ref $opt_list->{$_} ? $opt_list->{$_} : ()) } keys %$opt_list | |||
159 | ] if ref $opt_list eq 'HASH'; | |||
160 | ||||
161 | my @return; | |||
162 | my %seen; | |||
163 | ||||
164 | for (my $i = 0; $i < @$opt_list; $i++) { ## no critic | |||
165 | my $name = $opt_list->[$i]; | |||
166 | my $value; | |||
167 | ||||
168 | if ($require_unique) { | |||
169 | Carp::croak "multiple definitions provided for $name" if $seen{$name}++; | |||
170 | } | |||
171 | ||||
172 | 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] } | |||
175 | else { $value = undef; } | |||
176 | ||||
177 | if ($must_be and defined $value) { | |||
178 | unless (__is_a($value, $must_be)) { # spent 928µs making 37 calls to Data::OptList::__is_a, avg 25µs/call | |||
179 | my $ref = ref $value; | |||
180 | Carp::croak "$ref-ref values are not valid in $moniker opt list"; | |||
181 | } | |||
182 | } | |||
183 | ||||
184 | push @return, [ $name => $value ]; | |||
185 | } | |||
186 | ||||
187 | return \@return; | |||
188 | } | |||
189 | ||||
190 | =head2 mkopt_hash | |||
191 | ||||
192 | my $opt_hash = Data::OptList::mkopt_hash($input, $moniker, $must_be); | |||
193 | ||||
194 | Given valid C<L</mkopt>> input, this routine returns a reference to a hash. It | |||
195 | will throw an exception if any name has more than one value. | |||
196 | ||||
197 | =cut | |||
198 | ||||
199 | # spent 1.99ms (278µs+1.71) within Data::OptList::mkopt_hash which was called 18 times, avg 111µs/call:
# 12 times (198µs+1.28ms) by Sub::Exporter::_rewrite_build_config at line 672 of /usr/local/share/perl/5.10.0/Sub/Exporter.pm, avg 123µs/call
# 6 times (79µs+433µs) by Sub::Exporter::_rewrite_build_config at line 685 of /usr/local/share/perl/5.10.0/Sub/Exporter.pm, avg 85µs/call | |||
200 | 75 | 248µs | 3µs | my ($opt_list, $moniker, $must_be) = @_; |
201 | return {} unless $opt_list; | |||
202 | ||||
203 | $opt_list = mkopt($opt_list, $moniker, 1, $must_be); # spent 1.71ms making 13 calls to Data::OptList::mkopt, avg 132µs/call | |||
204 | my %hash = map { $_->[0] => $_->[1] } @$opt_list; | |||
205 | return \%hash; | |||
206 | } | |||
207 | ||||
208 | =head1 EXPORTS | |||
209 | ||||
210 | Both C<mkopt> and C<mkopt_hash> may be exported on request. | |||
211 | ||||
212 | =cut | |||
213 | ||||
214 | BEGIN { | |||
215 | 1 | 9µs | 9µs | *import = Sub::Install::exporter { # spent 15µs making 1 call to Sub::Install::exporter |
216 | exports => [qw(mkopt mkopt_hash)], | |||
217 | }; | |||
218 | 1 | 25µs | 25µs | } |
219 | ||||
220 | =head1 AUTHOR | |||
221 | ||||
222 | Ricardo SIGNES, C<< <rjbs@cpan.org> >> | |||
223 | ||||
224 | =head1 BUGS | |||
225 | ||||
226 | Please report any bugs or feature requests at L<http://rt.cpan.org>. I will be | |||
227 | notified, and then you'll automatically be notified of progress on your bug as | |||
228 | I make changes. | |||
229 | ||||
230 | =head1 COPYRIGHT | |||
231 | ||||
232 | Copyright 2006-2007, Ricardo SIGNES. This program is free software; you can | |||
233 | redistribute it and/or modify it under the same terms as Perl itself. | |||
234 | ||||
235 | =cut | |||
236 | ||||
237 | 1 | 6µs | 6µs | 1; |