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 | BEGIN@9 | Module::Implementation::
1 | 1 | 1 | 488µs | 669µs | BEGIN@10 | Module::Implementation::
2 | 1 | 1 | 53µs | 58µs | _copy_symbols | Module::Implementation::
2 | 1 | 1 | 40µs | 1.19ms | _load_implementation | Module::Implementation::
2 | 1 | 1 | 38µs | 47µs | _build_loader | Module::Implementation::
2 | 2 | 2 | 25µs | 1.27ms | __ANON__[:44] | Module::Implementation::
8 | 2 | 1 | 14µs | 14µs | CORE:subst (opcode) | Module::Implementation::
2 | 1 | 1 | 13µs | 1.08ms | __ANON__[:87] | Module::Implementation::
2 | 2 | 2 | 13µs | 60µs | build_loader_sub | Module::Implementation::
1 | 1 | 1 | 12µs | 15µs | BEGIN@6 | Module::Implementation::
1 | 1 | 1 | 8µs | 26µs | BEGIN@114 | Module::Implementation::
1 | 1 | 1 | 7µs | 24µs | BEGIN@7 | Module::Implementation::
1 | 1 | 1 | 7µs | 21µs | BEGIN@113 | Module::Implementation::
0 | 0 | 0 | 0s | 0s | __ANON__[:70] | Module::Implementation::
0 | 0 | 0 | 0s | 0s | __ANON__[:74] | Module::Implementation::
0 | 0 | 0 | 0s | 0s | __ANON__[:90] | Module::Implementation::
0 | 0 | 0 | 0s | 0s | implementation_for | Module::Implementation::
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 |