← Index
NYTProf Performance Profile   « block view • line view • sub view »
For xt/tapper-mcp-scheduler-with-db-longrun.t
  Run on Tue May 22 17:18:39 2012
Reported on Tue May 22 17:22:34 2012

Filename/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/Module/Implementation.pm
StatementsExecuted 114 statements in 1.02ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1111.17ms1.29msModule::Implementation::::BEGIN@9Module::Implementation::BEGIN@9
111488µs669µsModule::Implementation::::BEGIN@10Module::Implementation::BEGIN@10
21153µs58µsModule::Implementation::::_copy_symbolsModule::Implementation::_copy_symbols
21140µs1.19msModule::Implementation::::_load_implementationModule::Implementation::_load_implementation
21138µs47µsModule::Implementation::::_build_loaderModule::Implementation::_build_loader
22225µs1.27msModule::Implementation::::__ANON__[:44]Module::Implementation::__ANON__[:44]
82114µs14µsModule::Implementation::::CORE:substModule::Implementation::CORE:subst (opcode)
21113µs1.08msModule::Implementation::::__ANON__[:87]Module::Implementation::__ANON__[:87]
22213µs60µsModule::Implementation::::build_loader_subModule::Implementation::build_loader_sub
11112µs15µsModule::Implementation::::BEGIN@6Module::Implementation::BEGIN@6
1118µs26µsModule::Implementation::::BEGIN@114Module::Implementation::BEGIN@114
1117µs24µsModule::Implementation::::BEGIN@7Module::Implementation::BEGIN@7
1117µs21µsModule::Implementation::::BEGIN@113Module::Implementation::BEGIN@113
0000s0sModule::Implementation::::__ANON__[:70]Module::Implementation::__ANON__[:70]
0000s0sModule::Implementation::::__ANON__[:74]Module::Implementation::__ANON__[:74]
0000s0sModule::Implementation::::__ANON__[:90]Module::Implementation::__ANON__[:90]
0000s0sModule::Implementation::::implementation_forModule::Implementation::implementation_for
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Module::Implementation;
2{
321µs $Module::Implementation::VERSION = '0.06';
4}
5
6317µs218µ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
use strict;
# spent 15µs making 1 call to Module::Implementation::BEGIN@6 # spent 3µs making 1 call to strict::import
7323µs240µ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
use warnings;
# spent 24µs making 1 call to Module::Implementation::BEGIN@7 # spent 16µs making 1 call to warnings::import
8
93140µs31.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
use Module::Runtime 0.012 qw( require_module );
# 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
103487µs2699µ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
use Try::Tiny;
# spent 669µs making 1 call to Module::Implementation::BEGIN@10 # spent 30µs making 1 call to Exporter::import
11
121200nsmy %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
sub build_loader_sub {
15413µs my $caller = caller();
16
17247µ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
sub _build_loader {
211850µ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;
2929µs $env_var =~ s/::/_/g;
# spent 9µs making 2 calls to Module::Implementation::CORE:subst, avg 5µs/call
30 $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
return sub {
33823µs21.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 $Implementation{$package} = $implementation;
40
41258µs _copy_symbols( $loaded, $package, \@symbols );
# spent 58µs making 2 calls to Module::Implementation::_copy_symbols, avg 29µs/call
42
43 return $loaded;
44 };
45}
46
47sub 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
sub _load_implementation {
542036µs my $package = shift;
55 my $env_value = shift;
56 my $implementations = shift;
57
58 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 my $load = "${package}::$possible";
82
83 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
try {
85411µs21.07ms require_module($load);
# spent 1.07ms making 2 calls to Module::Runtime::require_module, avg 536µs/call
86 $ok = 1;
87 }
88 catch {
89 $err .= $_;
9041.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 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
sub _copy_symbols {
1023860µs my $from_package = shift;
103 my $to_package = shift;
104 my $symbols = shift;
105
106 for my $sym ( @{$symbols} ) {
10765µs my $type = $sym =~ s/^([\$\@\%\&\*])// ? $1 : '&';
# spent 5µs making 6 calls to Module::Implementation::CORE:subst, avg 867ns/call
108
109 my $from = "${from_package}::$sym";
110 my $to = "${to_package}::$sym";
111
112 {
113320µs235µ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
no strict 'refs';
# spent 21µs making 1 call to Module::Implementation::BEGIN@113 # spent 14µs making 1 call to strict::unimport
1143133µs245µ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
no warnings 'once';
# 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 : $type eq '*' ? *{$from}
123 : die
124 "Can't copy symbol from $from_package to $to_package: $type$sym";
125 }
126 }
127}
128
12913µs1;
130
131# ABSTRACT: Loads one of several alternate underlying implementations for a module
132
- -
135=pod
136
137=head1 NAME
138
139Module::Implementation - Loads one of several alternate underlying implementations for a module
140
141=head1 VERSION
142
143version 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
167This module abstracts out the process of choosing one of several underlying
168implementations for a module. This can be used to provide XS and pure Perl
169implementations of a module, or it could be used to load an implementation for
170a given OS or any other case of needing to provide multiple implementations.
171
172This module is only useful when you know all the implementations ahead of
173time. If you want to load arbitrary implementations then you probably want
174something like a plugin system, not this module.
175
176=head1 API
177
178This module provides two subroutines, neither of which are exported.
179
180=head2 Module::Implementation::<build_loader_sub(...)
181
182This subroutine takes the following arguments.
183
184=over 4
185
186=item * implementations
187
188This should be an array reference of implementation names. Each name should
189correspond to a module in the caller's namespace.
190
191In other words, using the example in the L</SYNOPSIS>, this module will look
192for the C<Foo::Bar::XS> and C<Foo::Bar::PurePerl> modules will be installed
193
194This argument is required.
195
196=item * symbols
197
198A list of symbols to copy from the implementation package to the calling
199package.
200
201These can be prefixed with a variable type: C<$>, C<@>, C<%>, C<&>, or
202C<*)>. If no prefix is given, the symbol is assumed to be a subroutine.
203
204This argument is optional.
205
206=back
207
208This subroutine I<returns> the implementation loader as a sub reference.
209
210It is up to you to call this loader sub in your code.
211
212I recommend that you I<do not> call this loader in an C<import()> sub. If a
213caller explicitly requests no imports, your C<import()> sub will not be run at
214all, which can cause weird breakage.
215
216=head2 Module::Implementation::implementation_for($package)
217
218Given a package name, this subroutine returns the implementation that was
219loaded for the package. This is not a full package name, just the suffix that
220identifies the implementation. For the L</SYNOPSIS> example, this subroutine
221would be called as C<Module::Implementation::implementation_for('Foo::Bar')>,
222and it would return "XS" or "PurePerl".
223
224=head1 HOW THE IMPLEMENTATION LOADER WORKS
225
226The implementation loader works like this ...
227
228First, it checks for an C<%ENV> var specifying the implementation to load. The
229env var is based on the package name which loads the implementations. The
230C<::> package separator is replaced with C<_>, and made entirely
231upper-case. Finally, we append "_IMPLEMENTATION" to this name.
232
233So in our L</SYNOPSIS> example, the corresponding C<%ENV> key would be
234C<FOO_BAR_IMPLEMENTATION>.
235
236If this is set, then the loader will B<only> try to load this one
237implementation.
238
239If the env var requests an implementation which doesn't match one of the
240implementations specified when the loader was created, an error is thrown.
241
242If this one implementation fails to load then loader throws an error. This is
243useful for testing. You can request a specific implementation in a test file
244by writing something like this:
245
246 BEGIN { $ENV{FOO_BAR_IMPLEMENTATION} = 'XS' }
247 use Foo::Bar;
248
249If the environment variable is I<not> set, then the loader simply tries the
250implementations originally passed to C<Module::Implementation>. The
251implementations are tried in the order in which they were originally passed.
252
253The loader will use the first implementation that loads without an error. It
254will copy any requested symbols from this implementation.
255
256If none of the implementations can be loaded, then the loader throws an
257exception.
258
259The loader returns the name of the package it loaded.
260
261=head1 AUTHOR
262
263Dave Rolsky <autarch@urth.org>
264
265=head1 COPYRIGHT AND LICENSE
266
267This software is Copyright (c) 2012 by Dave Rolsky.
268
269This is free software, licensed under:
270
271 The Artistic License 2.0 (GPL Compatible)
272
273=cut
274
275
276__END__
 
# spent 14µs within Module::Implementation::CORE:subst which was called 8 times, avg 2µs/call: # 6 times (5µs+0s) by Module::Implementation::_copy_symbols at line 107, avg 867ns/call # 2 times (9µs+0s) by Module::Implementation::_build_loader at line 29, avg 5µs/call
sub Module::Implementation::CORE:subst; # opcode