| Filename | /Users/ap13/perl5/lib/perl5/Module/Implementation.pm |
| Statements | Executed 86 statements in 1.67ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 1.31ms | 26.6ms | Module::Implementation::BEGIN@10 |
| 2 | 1 | 1 | 65µs | 2.07ms | Module::Implementation::_load_implementation |
| 2 | 1 | 1 | 54µs | 64µs | Module::Implementation::_build_loader |
| 2 | 2 | 2 | 40µs | 2.15ms | Module::Implementation::__ANON__[:44] |
| 2 | 1 | 1 | 33µs | 35µs | Module::Implementation::_copy_symbols |
| 1 | 1 | 1 | 28µs | 59µs | Module::Implementation::BEGIN@6 |
| 1 | 1 | 1 | 28µs | 76µs | Module::Implementation::BEGIN@9 |
| 2 | 2 | 2 | 20µs | 84µs | Module::Implementation::build_loader_sub |
| 1 | 1 | 1 | 17µs | 28µs | Module::Implementation::BEGIN@7 |
| 1 | 1 | 1 | 14µs | 36µs | Module::Implementation::BEGIN@114 |
| 1 | 1 | 1 | 13µs | 32µs | Module::Implementation::BEGIN@113 |
| 3 | 2 | 1 | 12µs | 12µs | Module::Implementation::CORE:subst (opcode) |
| 1 | 1 | 1 | 5µs | 5µs | Module::Implementation::implementation_for |
| 0 | 0 | 0 | 0s | 0s | Module::Implementation::__ANON__[:70] |
| 0 | 0 | 0 | 0s | 0s | Module::Implementation::__ANON__[:74] |
| 0 | 0 | 0 | 0s | 0s | Module::Implementation::__ANON__[:87] |
| 0 | 0 | 0 | 0s | 0s | Module::Implementation::__ANON__[:90] |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package Module::Implementation; | ||||
| 2 | { | ||||
| 3 | 2 | 2µs | $Module::Implementation::VERSION = '0.06'; | ||
| 4 | } | ||||
| 5 | |||||
| 6 | 2 | 44µs | 2 | 89µs | # spent 59µs (28+31) within Module::Implementation::BEGIN@6 which was called:
# once (28µs+31µs) by Class::Load::BEGIN@9 at line 6 # spent 59µs making 1 call to Module::Implementation::BEGIN@6
# spent 31µs making 1 call to strict::import |
| 7 | 2 | 51µs | 2 | 39µs | # spent 28µs (17+11) within Module::Implementation::BEGIN@7 which was called:
# once (17µs+11µs) by Class::Load::BEGIN@9 at line 7 # spent 28µs making 1 call to Module::Implementation::BEGIN@7
# spent 11µs making 1 call to warnings::import |
| 8 | |||||
| 9 | 3 | 84µs | 3 | 123µs | # spent 76µs (28+48) within Module::Implementation::BEGIN@9 which was called:
# once (28µs+48µs) by Class::Load::BEGIN@9 at line 9 # spent 76µs making 1 call to Module::Implementation::BEGIN@9
# spent 29µs making 1 call to Module::Runtime::import
# spent 18µs making 1 call to UNIVERSAL::VERSION |
| 10 | 2 | 965µs | 2 | 26.6ms | # spent 26.6ms (1.31+25.2) within Module::Implementation::BEGIN@10 which was called:
# once (1.31ms+25.2ms) by Class::Load::BEGIN@9 at line 10 # spent 26.6ms making 1 call to Module::Implementation::BEGIN@10
# spent 45µs making 1 call to Exporter::import |
| 11 | |||||
| 12 | 1 | 200ns | my %Implementation; | ||
| 13 | |||||
| 14 | # spent 84µs (20+64) within Module::Implementation::build_loader_sub which was called 2 times, avg 42µs/call:
# once (11µs+33µs) by Moose::BEGIN@12 at line 19 of Class/Load.pm
# once (9µs+31µs) by Package::Stash::BEGIN@17 at line 21 of Package/Stash.pm | ||||
| 15 | 4 | 19µs | my $caller = caller(); | ||
| 16 | |||||
| 17 | 2 | 64µs | return _build_loader( $caller, @_ ); # spent 64µs making 2 calls to Module::Implementation::_build_loader, avg 32µs/call | ||
| 18 | } | ||||
| 19 | |||||
| 20 | # spent 64µs (54+11) within Module::Implementation::_build_loader which was called 2 times, avg 32µs/call:
# 2 times (54µs+11µs) by Module::Implementation::build_loader_sub at line 17, avg 32µs/call | ||||
| 21 | 18 | 66µs | my $package = shift; | ||
| 22 | my %args = @_; | ||||
| 23 | |||||
| 24 | my @implementations = @{ $args{implementations} }; | ||||
| 25 | my @symbols = @{ $args{symbols} || [] }; | ||||
| 26 | |||||
| 27 | my $implementation; | ||||
| 28 | my $env_var = uc $package; | ||||
| 29 | 2 | 10µs | $env_var =~ s/::/_/g; # spent 10µs making 2 calls to Module::Implementation::CORE:subst, avg 5µs/call | ||
| 30 | $env_var .= '_IMPLEMENTATION'; | ||||
| 31 | |||||
| 32 | # spent 2.15ms (40µs+2.11) within Module::Implementation::__ANON__[/Users/ap13/perl5/lib/perl5/Module/Implementation.pm:44] which was called 2 times, avg 1.07ms/call:
# once (21µs+1.09ms) by Moose::BEGIN@12 at line 24 of Class/Load.pm
# once (19µs+1.02ms) by Package::Stash::BEGIN@17 at line 21 of Package/Stash.pm | ||||
| 33 | 8 | 35µs | 2 | 2.07ms | my ( $implementation, $loaded ) = _load_implementation( # spent 2.07ms making 2 calls to Module::Implementation::_load_implementation, avg 1.04ms/call |
| 34 | $package, | ||||
| 35 | $ENV{$env_var}, | ||||
| 36 | \@implementations, | ||||
| 37 | ); | ||||
| 38 | |||||
| 39 | $Implementation{$package} = $implementation; | ||||
| 40 | |||||
| 41 | 2 | 35µs | _copy_symbols( $loaded, $package, \@symbols ); # spent 35µs making 2 calls to Module::Implementation::_copy_symbols, avg 17µs/call | ||
| 42 | |||||
| 43 | return $loaded; | ||||
| 44 | }; | ||||
| 45 | } | ||||
| 46 | |||||
| 47 | # spent 5µs within Module::Implementation::implementation_for which was called:
# once (5µs+0s) by Package::Stash::BEGIN@17 at line 24 of Package/Stash.pm | ||||
| 48 | 2 | 7µs | my $package = shift; | ||
| 49 | |||||
| 50 | return $Implementation{$package}; | ||||
| 51 | } | ||||
| 52 | |||||
| 53 | # spent 2.07ms (65µs+2.01) within Module::Implementation::_load_implementation which was called 2 times, avg 1.04ms/call:
# 2 times (65µs+2.01ms) by Module::Implementation::__ANON__[/Users/ap13/perl5/lib/perl5/Module/Implementation.pm:44] at line 33, avg 1.04ms/call | ||||
| 54 | 8 | 7µs | my $package = shift; | ||
| 55 | my $env_value = shift; | ||||
| 56 | my $implementations = shift; | ||||
| 57 | |||||
| 58 | 4 | 3µs | if ($env_value) { | ||
| 59 | die "$env_value is not a valid implementation for $package" | ||||
| 60 | unless grep { $_ eq $env_value } @{$implementations}; | ||||
| 61 | |||||
| 62 | my $loaded = "${package}::$env_value"; | ||||
| 63 | |||||
| 64 | # Values from the %ENV hash are tainted. We know it's safe to untaint | ||||
| 65 | # this value because the value was one of our known implementations. | ||||
| 66 | ($loaded) = $loaded =~ /^(.+)$/; | ||||
| 67 | |||||
| 68 | try { | ||||
| 69 | require_module($loaded); | ||||
| 70 | } | ||||
| 71 | catch { | ||||
| 72 | require Carp; | ||||
| 73 | Carp::croak("Could not load $loaded: $_"); | ||||
| 74 | }; | ||||
| 75 | |||||
| 76 | return ( $env_value, $loaded ); | ||||
| 77 | } | ||||
| 78 | else { | ||||
| 79 | my $err; | ||||
| 80 | for my $possible ( @{$implementations} ) { | ||||
| 81 | 8 | 49µs | my $load = "${package}::$possible"; | ||
| 82 | |||||
| 83 | my $ok; | ||||
| 84 | try { | ||||
| 85 | 4 | 26µs | 2 | 1.84ms | require_module($load); # spent 1.84ms making 2 calls to Module::Runtime::require_module, avg 920µs/call |
| 86 | $ok = 1; | ||||
| 87 | } | ||||
| 88 | catch { | ||||
| 89 | $err .= $_; | ||||
| 90 | 4 | 2.01ms | }; # spent 1.98ms making 2 calls to Try::Tiny::try, avg 989µs/call
# spent 30µs making 2 calls to Try::Tiny::catch, avg 15µs/call | ||
| 91 | |||||
| 92 | return ( $possible, $load ) if $ok; | ||||
| 93 | } | ||||
| 94 | |||||
| 95 | require Carp; | ||||
| 96 | Carp::croak( | ||||
| 97 | "Could not find a suitable $package implementation: $err"); | ||||
| 98 | } | ||||
| 99 | } | ||||
| 100 | |||||
| 101 | # spent 35µs (33+2) within Module::Implementation::_copy_symbols which was called 2 times, avg 17µs/call:
# 2 times (33µs+2µs) by Module::Implementation::__ANON__[/Users/ap13/perl5/lib/perl5/Module/Implementation.pm:44] at line 41, avg 17µs/call | ||||
| 102 | 8 | 20µs | my $from_package = shift; | ||
| 103 | my $to_package = shift; | ||||
| 104 | my $symbols = shift; | ||||
| 105 | |||||
| 106 | for my $sym ( @{$symbols} ) { | ||||
| 107 | 4 | 14µs | 1 | 2µs | my $type = $sym =~ s/^([\$\@\%\&\*])// ? $1 : '&'; # spent 2µs making 1 call to Module::Implementation::CORE:subst |
| 108 | |||||
| 109 | my $from = "${from_package}::$sym"; | ||||
| 110 | my $to = "${to_package}::$sym"; | ||||
| 111 | |||||
| 112 | { | ||||
| 113 | 2 | 40µs | 2 | 52µs | # spent 32µs (13+19) within Module::Implementation::BEGIN@113 which was called:
# once (13µs+19µs) by Class::Load::BEGIN@9 at line 113 # spent 32µs making 1 call to Module::Implementation::BEGIN@113
# spent 19µs making 1 call to strict::unimport |
| 114 | 2 | 225µs | 2 | 59µs | # spent 36µs (14+23) within Module::Implementation::BEGIN@114 which was called:
# once (14µs+23µs) by Class::Load::BEGIN@9 at line 114 # spent 36µs making 1 call to Module::Implementation::BEGIN@114
# spent 23µs making 1 call to warnings::unimport |
| 115 | |||||
| 116 | # Copied from Exporter | ||||
| 117 | *{$to} | ||||
| 118 | = $type eq '&' ? \&{$from} | ||||
| 119 | : $type eq '$' ? \${$from} | ||||
| 120 | : $type eq '@' ? \@{$from} | ||||
| 121 | : $type eq '%' ? \%{$from} | ||||
| 122 | 1 | 4µs | : $type eq '*' ? *{$from} | ||
| 123 | : die | ||||
| 124 | "Can't copy symbol from $from_package to $to_package: $type$sym"; | ||||
| 125 | } | ||||
| 126 | } | ||||
| 127 | } | ||||
| 128 | |||||
| 129 | 1 | 6µs | 1; | ||
| 130 | |||||
| 131 | # ABSTRACT: Loads one of several alternate underlying implementations for a module | ||||
| 132 | |||||
| - - | |||||
| 135 | =pod | ||||
| 136 | |||||
| 137 | =head1 NAME | ||||
| 138 | |||||
| 139 | Module::Implementation - Loads one of several alternate underlying implementations for a module | ||||
| 140 | |||||
| 141 | =head1 VERSION | ||||
| 142 | |||||
| 143 | version 0.06 | ||||
| 144 | |||||
| 145 | =head1 SYNOPSIS | ||||
| 146 | |||||
| 147 | package Foo::Bar; | ||||
| 148 | |||||
| 149 | use Module::Implementation; | ||||
| 150 | |||||
| 151 | BEGIN { | ||||
| 152 | my $loader = Module::Implementation::build_loader_sub( | ||||
| 153 | implementations => [ 'XS', 'PurePerl' ], | ||||
| 154 | symbols => [ 'run', 'check' ], | ||||
| 155 | ); | ||||
| 156 | |||||
| 157 | $loader->(); | ||||
| 158 | } | ||||
| 159 | |||||
| 160 | package Consumer; | ||||
| 161 | |||||
| 162 | # loads the first viable implementation | ||||
| 163 | use Foo::Bar; | ||||
| 164 | |||||
| 165 | =head1 DESCRIPTION | ||||
| 166 | |||||
| 167 | This module abstracts out the process of choosing one of several underlying | ||||
| 168 | implementations for a module. This can be used to provide XS and pure Perl | ||||
| 169 | implementations of a module, or it could be used to load an implementation for | ||||
| 170 | a given OS or any other case of needing to provide multiple implementations. | ||||
| 171 | |||||
| 172 | This module is only useful when you know all the implementations ahead of | ||||
| 173 | time. If you want to load arbitrary implementations then you probably want | ||||
| 174 | something like a plugin system, not this module. | ||||
| 175 | |||||
| 176 | =head1 API | ||||
| 177 | |||||
| 178 | This module provides two subroutines, neither of which are exported. | ||||
| 179 | |||||
| 180 | =head2 Module::Implementation::<build_loader_sub(...) | ||||
| 181 | |||||
| 182 | This subroutine takes the following arguments. | ||||
| 183 | |||||
| 184 | =over 4 | ||||
| 185 | |||||
| 186 | =item * implementations | ||||
| 187 | |||||
| 188 | This should be an array reference of implementation names. Each name should | ||||
| 189 | correspond to a module in the caller's namespace. | ||||
| 190 | |||||
| 191 | In other words, using the example in the L</SYNOPSIS>, this module will look | ||||
| 192 | for the C<Foo::Bar::XS> and C<Foo::Bar::PurePerl> modules will be installed | ||||
| 193 | |||||
| 194 | This argument is required. | ||||
| 195 | |||||
| 196 | =item * symbols | ||||
| 197 | |||||
| 198 | A list of symbols to copy from the implementation package to the calling | ||||
| 199 | package. | ||||
| 200 | |||||
| 201 | These can be prefixed with a variable type: C<$>, C<@>, C<%>, C<&>, or | ||||
| 202 | C<*)>. If no prefix is given, the symbol is assumed to be a subroutine. | ||||
| 203 | |||||
| 204 | This argument is optional. | ||||
| 205 | |||||
| 206 | =back | ||||
| 207 | |||||
| 208 | This subroutine I<returns> the implementation loader as a sub reference. | ||||
| 209 | |||||
| 210 | It is up to you to call this loader sub in your code. | ||||
| 211 | |||||
| 212 | I recommend that you I<do not> call this loader in an C<import()> sub. If a | ||||
| 213 | caller explicitly requests no imports, your C<import()> sub will not be run at | ||||
| 214 | all, which can cause weird breakage. | ||||
| 215 | |||||
| 216 | =head2 Module::Implementation::implementation_for($package) | ||||
| 217 | |||||
| 218 | Given a package name, this subroutine returns the implementation that was | ||||
| 219 | loaded for the package. This is not a full package name, just the suffix that | ||||
| 220 | identifies the implementation. For the L</SYNOPSIS> example, this subroutine | ||||
| 221 | would be called as C<Module::Implementation::implementation_for('Foo::Bar')>, | ||||
| 222 | and it would return "XS" or "PurePerl". | ||||
| 223 | |||||
| 224 | =head1 HOW THE IMPLEMENTATION LOADER WORKS | ||||
| 225 | |||||
| 226 | The implementation loader works like this ... | ||||
| 227 | |||||
| 228 | First, it checks for an C<%ENV> var specifying the implementation to load. The | ||||
| 229 | env var is based on the package name which loads the implementations. The | ||||
| 230 | C<::> package separator is replaced with C<_>, and made entirely | ||||
| 231 | upper-case. Finally, we append "_IMPLEMENTATION" to this name. | ||||
| 232 | |||||
| 233 | So in our L</SYNOPSIS> example, the corresponding C<%ENV> key would be | ||||
| 234 | C<FOO_BAR_IMPLEMENTATION>. | ||||
| 235 | |||||
| 236 | If this is set, then the loader will B<only> try to load this one | ||||
| 237 | implementation. | ||||
| 238 | |||||
| 239 | If the env var requests an implementation which doesn't match one of the | ||||
| 240 | implementations specified when the loader was created, an error is thrown. | ||||
| 241 | |||||
| 242 | If this one implementation fails to load then loader throws an error. This is | ||||
| 243 | useful for testing. You can request a specific implementation in a test file | ||||
| 244 | by writing something like this: | ||||
| 245 | |||||
| 246 | BEGIN { $ENV{FOO_BAR_IMPLEMENTATION} = 'XS' } | ||||
| 247 | use Foo::Bar; | ||||
| 248 | |||||
| 249 | If the environment variable is I<not> set, then the loader simply tries the | ||||
| 250 | implementations originally passed to C<Module::Implementation>. The | ||||
| 251 | implementations are tried in the order in which they were originally passed. | ||||
| 252 | |||||
| 253 | The loader will use the first implementation that loads without an error. It | ||||
| 254 | will copy any requested symbols from this implementation. | ||||
| 255 | |||||
| 256 | If none of the implementations can be loaded, then the loader throws an | ||||
| 257 | exception. | ||||
| 258 | |||||
| 259 | The loader returns the name of the package it loaded. | ||||
| 260 | |||||
| 261 | =head1 AUTHOR | ||||
| 262 | |||||
| 263 | Dave Rolsky <autarch@urth.org> | ||||
| 264 | |||||
| 265 | =head1 COPYRIGHT AND LICENSE | ||||
| 266 | |||||
| 267 | This software is Copyright (c) 2012 by Dave Rolsky. | ||||
| 268 | |||||
| 269 | This is free software, licensed under: | ||||
| 270 | |||||
| 271 | The Artistic License 2.0 (GPL Compatible) | ||||
| 272 | |||||
| 273 | =cut | ||||
| 274 | |||||
| 275 | |||||
| 276 | __END__ | ||||
sub Module::Implementation::CORE:subst; # opcode |