| Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/Module/Implementation.pm |
| Statements | Executed 114 statements in 1.02ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 1.17ms | 1.29ms | Module::Implementation::BEGIN@9 |
| 1 | 1 | 1 | 488µs | 669µs | Module::Implementation::BEGIN@10 |
| 2 | 1 | 1 | 53µs | 58µs | Module::Implementation::_copy_symbols |
| 2 | 1 | 1 | 40µs | 1.19ms | Module::Implementation::_load_implementation |
| 2 | 1 | 1 | 38µs | 47µs | Module::Implementation::_build_loader |
| 2 | 2 | 2 | 25µs | 1.27ms | Module::Implementation::__ANON__[:44] |
| 8 | 2 | 1 | 14µs | 14µs | Module::Implementation::CORE:subst (opcode) |
| 2 | 1 | 1 | 13µs | 1.08ms | Module::Implementation::__ANON__[:87] |
| 2 | 2 | 2 | 13µs | 60µs | Module::Implementation::build_loader_sub |
| 1 | 1 | 1 | 12µs | 15µs | Module::Implementation::BEGIN@6 |
| 1 | 1 | 1 | 8µs | 26µs | Module::Implementation::BEGIN@114 |
| 1 | 1 | 1 | 7µs | 24µs | Module::Implementation::BEGIN@7 |
| 1 | 1 | 1 | 7µs | 21µs | Module::Implementation::BEGIN@113 |
| 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__[:90] |
| 0 | 0 | 0 | 0s | 0s | Module::Implementation::implementation_for |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package Module::Implementation; | ||||
| 2 | { | ||||
| 3 | 2 | 1µs | $Module::Implementation::VERSION = '0.06'; | ||
| 4 | } | ||||
| 5 | |||||
| 6 | 3 | 17µs | 2 | 18µs | # spent 15µs (12+3) within Module::Implementation::BEGIN@6 which was called:
# once (12µs+3µs) by Class::Load::BEGIN@9 at line 6 # spent 15µs making 1 call to Module::Implementation::BEGIN@6
# spent 3µs making 1 call to strict::import |
| 7 | 3 | 23µs | 2 | 40µs | # spent 24µs (7+16) within Module::Implementation::BEGIN@7 which was called:
# once (7µs+16µs) by Class::Load::BEGIN@9 at line 7 # spent 24µs making 1 call to Module::Implementation::BEGIN@7
# spent 16µs making 1 call to warnings::import |
| 8 | |||||
| 9 | 3 | 140µs | 3 | 1.32ms | # spent 1.29ms (1.17+121µs) within Module::Implementation::BEGIN@9 which was called:
# once (1.17ms+121µs) by Class::Load::BEGIN@9 at line 9 # spent 1.29ms making 1 call to Module::Implementation::BEGIN@9
# spent 15µs making 1 call to Module::Runtime::import
# spent 12µs making 1 call to UNIVERSAL::VERSION |
| 10 | 3 | 487µs | 2 | 699µs | # spent 669µs (488+182) within Module::Implementation::BEGIN@10 which was called:
# once (488µs+182µs) by Class::Load::BEGIN@9 at line 10 # spent 669µs making 1 call to Module::Implementation::BEGIN@10
# spent 30µs making 1 call to Exporter::import |
| 11 | |||||
| 12 | 1 | 200ns | my %Implementation; | ||
| 13 | |||||
| 14 | # spent 60µs (13+47) within Module::Implementation::build_loader_sub which was called 2 times, avg 30µs/call:
# once (7µs+24µs) by Test::Fixture::DBIC::Schema::BEGIN@7 at line 51 of Params/Validate.pm
# once (6µs+23µs) by Moose::BEGIN@15 at line 19 of Class/Load.pm | ||||
| 15 | 2 | 2µs | my $caller = caller(); | ||
| 16 | |||||
| 17 | 2 | 11µs | 2 | 47µs | return _build_loader( $caller, @_ ); # spent 47µs making 2 calls to Module::Implementation::_build_loader, avg 24µs/call |
| 18 | } | ||||
| 19 | |||||
| 20 | # spent 47µs (38+9) within Module::Implementation::_build_loader which was called 2 times, avg 24µs/call:
# 2 times (38µs+9µs) by Module::Implementation::build_loader_sub at line 17, avg 24µs/call | ||||
| 21 | 2 | 1µs | my $package = shift; | ||
| 22 | 2 | 6µs | my %args = @_; | ||
| 23 | |||||
| 24 | 2 | 4µs | my @implementations = @{ $args{implementations} }; | ||
| 25 | 2 | 4µs | my @symbols = @{ $args{symbols} || [] }; | ||
| 26 | |||||
| 27 | 2 | 600ns | my $implementation; | ||
| 28 | 2 | 3µs | my $env_var = uc $package; | ||
| 29 | 2 | 18µs | 2 | 9µs | $env_var =~ s/::/_/g; # spent 9µs making 2 calls to Module::Implementation::CORE:subst, avg 5µs/call |
| 30 | 2 | 1µs | $env_var .= '_IMPLEMENTATION'; | ||
| 31 | |||||
| 32 | # spent 1.27ms (25µs+1.24) within Module::Implementation::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/Module/Implementation.pm:44] which was called 2 times, avg 634µs/call:
# once (12µs+687µs) by Test::Fixture::DBIC::Schema::BEGIN@7 at line 66 of Params/Validate.pm
# once (12µs+557µs) by Moose::BEGIN@15 at line 24 of Class/Load.pm | ||||
| 33 | 2 | 9µs | 2 | 1.19ms | my ( $implementation, $loaded ) = _load_implementation( # spent 1.19ms making 2 calls to Module::Implementation::_load_implementation, avg 593µs/call |
| 34 | $package, | ||||
| 35 | $ENV{$env_var}, | ||||
| 36 | \@implementations, | ||||
| 37 | ); | ||||
| 38 | |||||
| 39 | 2 | 2µs | $Implementation{$package} = $implementation; | ||
| 40 | |||||
| 41 | 2 | 4µs | 2 | 58µs | _copy_symbols( $loaded, $package, \@symbols ); # spent 58µs making 2 calls to Module::Implementation::_copy_symbols, avg 29µs/call |
| 42 | |||||
| 43 | 2 | 8µs | return $loaded; | ||
| 44 | 2 | 13µs | }; | ||
| 45 | } | ||||
| 46 | |||||
| 47 | sub implementation_for { | ||||
| 48 | my $package = shift; | ||||
| 49 | |||||
| 50 | return $Implementation{$package}; | ||||
| 51 | } | ||||
| 52 | |||||
| 53 | # spent 1.19ms (40µs+1.15) within Module::Implementation::_load_implementation which was called 2 times, avg 593µs/call:
# 2 times (40µs+1.15ms) by Module::Implementation::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/Module/Implementation.pm:44] at line 33, avg 593µs/call | ||||
| 54 | 2 | 1µs | my $package = shift; | ||
| 55 | 2 | 2µs | my $env_value = shift; | ||
| 56 | 2 | 700ns | my $implementations = shift; | ||
| 57 | |||||
| 58 | 2 | 800ns | 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 | 2 | 600ns | my $err; | ||
| 80 | 2 | 2µs | for my $possible ( @{$implementations} ) { | ||
| 81 | 2 | 2µs | my $load = "${package}::$possible"; | ||
| 82 | |||||
| 83 | 2 | 400ns | my $ok; | ||
| 84 | # spent 1.08ms (13µs+1.07) within Module::Implementation::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/Module/Implementation.pm:87] which was called 2 times, avg 542µs/call:
# 2 times (13µs+1.07ms) by Try::Tiny::try at line 76 of Try/Tiny.pm, avg 542µs/call | ||||
| 85 | 2 | 5µs | 2 | 1.07ms | require_module($load); # spent 1.07ms making 2 calls to Module::Runtime::require_module, avg 536µs/call |
| 86 | 2 | 6µs | $ok = 1; | ||
| 87 | } | ||||
| 88 | catch { | ||||
| 89 | $err .= $_; | ||||
| 90 | 2 | 18µs | 4 | 1.15ms | }; # spent 1.12ms making 2 calls to Try::Tiny::try, avg 562µs/call
# spent 22µs making 2 calls to Try::Tiny::catch, avg 11µs/call |
| 91 | |||||
| 92 | 2 | 9µs | 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 58µs (53+5) within Module::Implementation::_copy_symbols which was called 2 times, avg 29µs/call:
# 2 times (53µs+5µs) by Module::Implementation::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/Module/Implementation.pm:44] at line 41, avg 29µs/call | ||||
| 102 | 2 | 2µs | my $from_package = shift; | ||
| 103 | 2 | 1µs | my $to_package = shift; | ||
| 104 | 2 | 800ns | my $symbols = shift; | ||
| 105 | |||||
| 106 | 2 | 8µs | for my $sym ( @{$symbols} ) { | ||
| 107 | 6 | 17µs | 6 | 5µs | my $type = $sym =~ s/^([\$\@\%\&\*])// ? $1 : '&'; # spent 5µs making 6 calls to Module::Implementation::CORE:subst, avg 867ns/call |
| 108 | |||||
| 109 | 6 | 4µs | my $from = "${from_package}::$sym"; | ||
| 110 | 6 | 3µs | my $to = "${to_package}::$sym"; | ||
| 111 | |||||
| 112 | { | ||||
| 113 | 9 | 25µs | 2 | 35µs | # spent 21µs (7+14) within Module::Implementation::BEGIN@113 which was called:
# once (7µs+14µs) by Class::Load::BEGIN@9 at line 113 # spent 21µs making 1 call to Module::Implementation::BEGIN@113
# spent 14µs making 1 call to strict::unimport |
| 114 | 3 | 133µs | 2 | 45µs | # spent 26µs (8+19) within Module::Implementation::BEGIN@114 which was called:
# once (8µs+19µs) by Class::Load::BEGIN@9 at line 114 # spent 26µs making 1 call to Module::Implementation::BEGIN@114
# spent 19µ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 | 6 | 19µ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 | 3µ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 |