| 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 | Data::OptList::mkopt |
| 80 | 2 | 1 | 576µs | 928µs | Data::OptList::__is_a |
| 18 | 2 | 1 | 278µs | 1.99ms | Data::OptList::mkopt_hash |
| 0 | 0 | 0 | 0s | 0s | Data::OptList::BEGIN |
| 0 | 0 | 0 | 0s | 0s | Data::OptList::__ANON__[:143] |
| 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; |