| Filename | /usr/local/share/perl/5.18.2/Sub/Exporter/Util.pm |
| Statements | Executed 16 statements in 859µs |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 14µs | 348µs | Sub::Exporter::Util::BEGIN@198 |
| 1 | 1 | 1 | 12µs | 24µs | Getopt::Long::Descriptive::BEGIN@1.18 |
| 1 | 1 | 1 | 7µs | 11µs | Getopt::Long::Descriptive::BEGIN@2.19 |
| 1 | 1 | 1 | 6µs | 16µs | Sub::Exporter::Util::BEGIN@139 |
| 1 | 1 | 1 | 3µs | 3µs | Sub::Exporter::Util::BEGIN@9 |
| 1 | 1 | 1 | 3µs | 3µs | Sub::Exporter::Util::BEGIN@22 |
| 1 | 1 | 1 | 2µs | 2µs | Sub::Exporter::Util::BEGIN@10 |
| 0 | 0 | 0 | 0s | 0s | Sub::Exporter::Util::__ANON__[:123] |
| 0 | 0 | 0 | 0s | 0s | Sub::Exporter::Util::__ANON__[:159] |
| 0 | 0 | 0 | 0s | 0s | Sub::Exporter::Util::__ANON__[:18] |
| 0 | 0 | 0 | 0s | 0s | Sub::Exporter::Util::__ANON__[:195] |
| 0 | 0 | 0 | 0s | 0s | Sub::Exporter::Util::__ANON__[:19] |
| 0 | 0 | 0 | 0s | 0s | Sub::Exporter::Util::__ANON__[:54] |
| 0 | 0 | 0 | 0s | 0s | Sub::Exporter::Util::__ANON__[:55] |
| 0 | 0 | 0 | 0s | 0s | Sub::Exporter::Util::__mixin_class_for |
| 0 | 0 | 0 | 0s | 0s | Sub::Exporter::Util::curry_chain |
| 0 | 0 | 0 | 0s | 0s | Sub::Exporter::Util::curry_method |
| 0 | 0 | 0 | 0s | 0s | Sub::Exporter::Util::like |
| 0 | 0 | 0 | 0s | 0s | Sub::Exporter::Util::merge_col |
| 0 | 0 | 0 | 0s | 0s | Sub::Exporter::Util::mixin_exporter |
| 0 | 0 | 0 | 0s | 0s | Sub::Exporter::Util::mixin_installer |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | 2 | 21µs | 2 | 36µs | # spent 24µs (12+12) within Getopt::Long::Descriptive::BEGIN@1.18 which was called:
# once (12µs+12µs) by Getopt::Long::Descriptive::BEGIN@267 at line 1 # spent 24µs making 1 call to Getopt::Long::Descriptive::BEGIN@1.18
# spent 12µs making 1 call to strict::import |
| 2 | 2 | 38µs | 2 | 14µs | # spent 11µs (7+4) within Getopt::Long::Descriptive::BEGIN@2.19 which was called:
# once (7µs+4µs) by Getopt::Long::Descriptive::BEGIN@267 at line 2 # spent 11µs making 1 call to Getopt::Long::Descriptive::BEGIN@2.19
# spent 4µs making 1 call to warnings::import |
| 3 | package Sub::Exporter::Util; | ||||
| 4 | { | ||||
| 5 | 2 | 900ns | $Sub::Exporter::Util::VERSION = '0.987'; | ||
| 6 | } | ||||
| 7 | # ABSTRACT: utilities to make Sub::Exporter easier | ||||
| 8 | |||||
| 9 | 2 | 18µs | 1 | 3µs | # spent 3µs within Sub::Exporter::Util::BEGIN@9 which was called:
# once (3µs+0s) by Getopt::Long::Descriptive::BEGIN@267 at line 9 # spent 3µs making 1 call to Sub::Exporter::Util::BEGIN@9 |
| 10 | 2 | 83µs | 1 | 2µs | # spent 2µs within Sub::Exporter::Util::BEGIN@10 which was called:
# once (2µs+0s) by Getopt::Long::Descriptive::BEGIN@267 at line 10 # spent 2µs making 1 call to Sub::Exporter::Util::BEGIN@10 |
| 11 | |||||
| 12 | |||||
| 13 | sub curry_method { | ||||
| 14 | my $override_name = shift; | ||||
| 15 | sub { | ||||
| 16 | my ($class, $name) = @_; | ||||
| 17 | $name = $override_name if defined $override_name; | ||||
| 18 | sub { $class->$name(@_); }; | ||||
| 19 | } | ||||
| 20 | } | ||||
| 21 | |||||
| 22 | 1 | 351µs | 1 | 3µs | # spent 3µs within Sub::Exporter::Util::BEGIN@22 which was called:
# once (3µs+0s) by Getopt::Long::Descriptive::BEGIN@267 at line 22 # spent 3µs making 1 call to Sub::Exporter::Util::BEGIN@22 |
| 23 | |||||
| 24 | |||||
| 25 | sub curry_chain { | ||||
| 26 | # In the future, we can make \%arg an optional prepend, like the "special" | ||||
| 27 | # args to the default Sub::Exporter-generated import routine. | ||||
| 28 | my (@opt_list) = @_; | ||||
| 29 | |||||
| 30 | my $pairs = Data::OptList::mkopt(\@opt_list, 'args', 'ARRAY'); | ||||
| 31 | |||||
| 32 | sub { | ||||
| 33 | my ($class) = @_; | ||||
| 34 | |||||
| 35 | sub { | ||||
| 36 | my $next = $class; | ||||
| 37 | |||||
| 38 | for my $i (0 .. $#$pairs) { | ||||
| 39 | my $pair = $pairs->[ $i ]; | ||||
| 40 | |||||
| 41 | unless (Params::Util::_INVOCANT($next)) { ## no critic Private | ||||
| 42 | my $str = defined $next ? "'$next'" : 'undef'; | ||||
| 43 | Carp::croak("can't call $pair->[0] on non-invocant $str") | ||||
| 44 | } | ||||
| 45 | |||||
| 46 | my ($method, $args) = @$pair; | ||||
| 47 | |||||
| 48 | if ($i == $#$pairs) { | ||||
| 49 | return $next->$method($args ? @$args : ()); | ||||
| 50 | } else { | ||||
| 51 | $next = $next->$method($args ? @$args : ()); | ||||
| 52 | } | ||||
| 53 | } | ||||
| 54 | }; | ||||
| 55 | } | ||||
| 56 | } | ||||
| 57 | |||||
| 58 | # =head2 name_map | ||||
| 59 | # | ||||
| 60 | # This utility returns an list to be used in specify export generators. For | ||||
| 61 | # example, the following: | ||||
| 62 | # | ||||
| 63 | # exports => { | ||||
| 64 | # name_map( | ||||
| 65 | # '_?_gen' => [ qw(fee fie) ], | ||||
| 66 | # '_make_?' => [ qw(foo bar) ], | ||||
| 67 | # ), | ||||
| 68 | # } | ||||
| 69 | # | ||||
| 70 | # is equivalent to: | ||||
| 71 | # | ||||
| 72 | # exports => { | ||||
| 73 | # name_map( | ||||
| 74 | # fee => \'_fee_gen', | ||||
| 75 | # fie => \'_fie_gen', | ||||
| 76 | # foo => \'_make_foo', | ||||
| 77 | # bar => \'_make_bar', | ||||
| 78 | # ), | ||||
| 79 | # } | ||||
| 80 | # | ||||
| 81 | # This can save a lot of typing, when providing many exports with similarly-named | ||||
| 82 | # generators. | ||||
| 83 | # | ||||
| 84 | # =cut | ||||
| 85 | # | ||||
| 86 | # sub name_map { | ||||
| 87 | # my (%groups) = @_; | ||||
| 88 | # | ||||
| 89 | # my %map; | ||||
| 90 | # | ||||
| 91 | # while (my ($template, $names) = each %groups) { | ||||
| 92 | # for my $name (@$names) { | ||||
| 93 | # (my $export = $template) =~ s/\?/$name/ | ||||
| 94 | # or Carp::croak 'no ? found in name_map template'; | ||||
| 95 | # | ||||
| 96 | # $map{ $name } = \$export; | ||||
| 97 | # } | ||||
| 98 | # } | ||||
| 99 | # | ||||
| 100 | # return %map; | ||||
| 101 | # } | ||||
| 102 | |||||
| 103 | |||||
| 104 | sub merge_col { | ||||
| 105 | my (%groups) = @_; | ||||
| 106 | |||||
| 107 | my %merged; | ||||
| 108 | |||||
| 109 | while (my ($default_name, $group) = each %groups) { | ||||
| 110 | while (my ($export_name, $gen) = each %$group) { | ||||
| 111 | $merged{$export_name} = sub { | ||||
| 112 | my ($class, $name, $arg, $col) = @_; | ||||
| 113 | |||||
| 114 | my $merged_arg = exists $col->{$default_name} | ||||
| 115 | ? { %{ $col->{$default_name} }, %$arg } | ||||
| 116 | : $arg; | ||||
| 117 | |||||
| 118 | if (Params::Util::_CODELIKE($gen)) { ## no critic Private | ||||
| 119 | $gen->($class, $name, $merged_arg, $col); | ||||
| 120 | } else { | ||||
| 121 | $class->$$gen($name, $merged_arg, $col); | ||||
| 122 | } | ||||
| 123 | } | ||||
| 124 | } | ||||
| 125 | } | ||||
| 126 | |||||
| 127 | return %merged; | ||||
| 128 | } | ||||
| 129 | |||||
| 130 | |||||
| 131 | sub __mixin_class_for { | ||||
| 132 | my ($class, $mix_into) = @_; | ||||
| 133 | require Package::Generator; | ||||
| 134 | my $mixin_class = Package::Generator->new_package({ | ||||
| 135 | base => "$class\:\:__mixin__", | ||||
| 136 | }); | ||||
| 137 | |||||
| 138 | ## no critic (ProhibitNoStrict) | ||||
| 139 | 2 | 316µs | 2 | 26µs | # spent 16µs (6+10) within Sub::Exporter::Util::BEGIN@139 which was called:
# once (6µs+10µs) by Getopt::Long::Descriptive::BEGIN@267 at line 139 # spent 16µs making 1 call to Sub::Exporter::Util::BEGIN@139
# spent 10µs making 1 call to strict::unimport |
| 140 | if (ref $mix_into) { | ||||
| 141 | unshift @{"$mixin_class" . "::ISA"}, ref $mix_into; | ||||
| 142 | } else { | ||||
| 143 | unshift @{"$mix_into" . "::ISA"}, $mixin_class; | ||||
| 144 | } | ||||
| 145 | return $mixin_class; | ||||
| 146 | } | ||||
| 147 | |||||
| 148 | sub mixin_installer { | ||||
| 149 | sub { | ||||
| 150 | my ($arg, $to_export) = @_; | ||||
| 151 | |||||
| 152 | my $mixin_class = __mixin_class_for($arg->{class}, $arg->{into}); | ||||
| 153 | bless $arg->{into} => $mixin_class if ref $arg->{into}; | ||||
| 154 | |||||
| 155 | Sub::Exporter::default_installer( | ||||
| 156 | { %$arg, into => $mixin_class }, | ||||
| 157 | $to_export, | ||||
| 158 | ); | ||||
| 159 | }; | ||||
| 160 | } | ||||
| 161 | |||||
| 162 | sub mixin_exporter { | ||||
| 163 | Carp::cluck "mixin_exporter is deprecated; use mixin_installer instead; it behaves identically"; | ||||
| 164 | return mixin_installer; | ||||
| 165 | } | ||||
| 166 | |||||
| 167 | |||||
| 168 | sub like { | ||||
| 169 | sub { | ||||
| 170 | my ($value, $arg) = @_; | ||||
| 171 | Carp::croak "no regex supplied to regex group generator" unless $value; | ||||
| 172 | |||||
| 173 | # Oh, qr//, how you bother me! See the p5p thread from around now about | ||||
| 174 | # fixing this problem... too bad it won't help me. -- rjbs, 2006-04-25 | ||||
| 175 | my @values = eval { $value->isa('Regexp') } ? ($value, undef) | ||||
| 176 | : @$value; | ||||
| 177 | |||||
| 178 | while (my ($re, $opt) = splice @values, 0, 2) { | ||||
| 179 | Carp::croak "given pattern for regex group generater is not a Regexp" | ||||
| 180 | unless eval { $re->isa('Regexp') }; | ||||
| 181 | my @exports = keys %{ $arg->{config}->{exports} }; | ||||
| 182 | my @matching = grep { $_ =~ $re } @exports; | ||||
| 183 | |||||
| 184 | my %merge = $opt ? %$opt : (); | ||||
| 185 | my $prefix = (delete $merge{-prefix}) || ''; | ||||
| 186 | my $suffix = (delete $merge{-suffix}) || ''; | ||||
| 187 | |||||
| 188 | for my $name (@matching) { | ||||
| 189 | my $as = $prefix . $name . $suffix; | ||||
| 190 | push @{ $arg->{import_args} }, [ $name => { %merge, -as => $as } ]; | ||||
| 191 | } | ||||
| 192 | } | ||||
| 193 | |||||
| 194 | 1; | ||||
| 195 | } | ||||
| 196 | } | ||||
| 197 | |||||
| 198 | 1 | 8µs | 1 | 334µs | # spent 348µs (14+334) within Sub::Exporter::Util::BEGIN@198 which was called:
# once (14µs+334µs) by Getopt::Long::Descriptive::BEGIN@267 at line 207 # spent 334µs making 1 call to Sub::Exporter::__ANON__[Sub/Exporter.pm:337] |
| 199 | exports => [ qw( | ||||
| 200 | like | ||||
| 201 | name_map | ||||
| 202 | merge_col | ||||
| 203 | curry_method curry_class | ||||
| 204 | curry_chain | ||||
| 205 | mixin_installer mixin_exporter | ||||
| 206 | ) ] | ||||
| 207 | 1 | 21µs | 1 | 348µs | }; # spent 348µs making 1 call to Sub::Exporter::Util::BEGIN@198 |
| 208 | |||||
| 209 | 1 | 2µs | 1; | ||
| 210 | |||||
| 211 | __END__ |