← Index
NYTProf Performance Profile   « line view »
For svc/members/upsert
  Run on Tue Jan 13 11:50:22 2015
Reported on Tue Jan 13 12:09:47 2015

Filename/usr/share/perl/5.20/Module/Load/Conditional.pm
StatementsExecuted 38 statements in 5.88ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1114.34ms15.7msModule::Load::Conditional::::BEGIN@14Module::Load::Conditional::BEGIN@14
1112.17ms2.48msModule::Load::Conditional::::BEGIN@12Module::Load::Conditional::BEGIN@12
1111.99ms7.60msModule::Load::Conditional::::BEGIN@6Module::Load::Conditional::BEGIN@6
1111.86ms1.96msModule::Load::Conditional::::BEGIN@5Module::Load::Conditional::BEGIN@5
1111.12ms1.27msModule::Load::Conditional::::BEGIN@11Module::Load::Conditional::BEGIN@11
11114µs28µsModule::Load::Conditional::::BEGIN@3Module::Load::Conditional::BEGIN@3
11113µs51µsModule::Load::Conditional::::BEGIN@16Module::Load::Conditional::BEGIN@16
1118µs8µsModule::Load::Conditional::::BEGIN@20Module::Load::Conditional::BEGIN@20
1117µs653µsModule::Load::Conditional::::BEGIN@7Module::Load::Conditional::BEGIN@7
1117µs20µsModule::Load::Conditional::::BEGIN@23Module::Load::Conditional::BEGIN@23
1117µs29µsModule::Load::Conditional::::BEGIN@17Module::Load::Conditional::BEGIN@17
1116µs16µsModule::Load::Conditional::::BEGIN@195Module::Load::Conditional::BEGIN@195
1116µs80µsModule::Load::Conditional::::BEGIN@21Module::Load::Conditional::BEGIN@21
1116µs28µsModule::Load::Conditional::::BEGIN@18Module::Load::Conditional::BEGIN@18
1114µs4µsModule::Load::Conditional::::BEGIN@9Module::Load::Conditional::BEGIN@9
1113µs3µsModule::Load::Conditional::::BEGIN@10Module::Load::Conditional::BEGIN@10
0000s0sModule::Load::Conditional::::can_loadModule::Load::Conditional::can_load
0000s0sModule::Load::Conditional::::check_installModule::Load::Conditional::check_install
0000s0sModule::Load::Conditional::::requiresModule::Load::Conditional::requires
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package Module::Load::Conditional;
2
3231µs242µs
# spent 28µs (14+14) within Module::Load::Conditional::BEGIN@3 which was called: # once (14µs+14µs) by C4::Context::BEGIN@107 at line 3
use strict;
# spent 28µs making 1 call to Module::Load::Conditional::BEGIN@3 # spent 14µs making 1 call to strict::import
4
521.24ms21.97ms
# spent 1.96ms (1.86+91µs) within Module::Load::Conditional::BEGIN@5 which was called: # once (1.86ms+91µs) by C4::Context::BEGIN@107 at line 5
use Module::Load qw/load autoload_remote/;
# spent 1.96ms making 1 call to Module::Load::Conditional::BEGIN@5 # spent 18µs making 1 call to Module::Load::import
621.04ms27.64ms
# spent 7.60ms (1.99+5.61) within Module::Load::Conditional::BEGIN@6 which was called: # once (1.99ms+5.61ms) by C4::Context::BEGIN@107 at line 6
use Params::Check qw[check];
# spent 7.60ms making 1 call to Module::Load::Conditional::BEGIN@6 # spent 37µs making 1 call to Exporter::import
7228µs21.30ms
# spent 653µs (7+646) within Module::Load::Conditional::BEGIN@7 which was called: # once (7µs+646µs) by C4::Context::BEGIN@107 at line 7
use Locale::Maketext::Simple Style => 'gettext';
# spent 653µs making 1 call to Module::Load::Conditional::BEGIN@7 # spent 646µs making 1 call to Locale::Maketext::Simple::import
8
9219µs14µs
# spent 4µs within Module::Load::Conditional::BEGIN@9 which was called: # once (4µs+0s) by C4::Context::BEGIN@107 at line 9
use Carp ();
# spent 4µs making 1 call to Module::Load::Conditional::BEGIN@9
10216µs13µs
# spent 3µs within Module::Load::Conditional::BEGIN@10 which was called: # once (3µs+0s) by C4::Context::BEGIN@107 at line 10
use File::Spec ();
# spent 3µs making 1 call to Module::Load::Conditional::BEGIN@10
112675µs11.27ms
# spent 1.27ms (1.12+154µs) within Module::Load::Conditional::BEGIN@11 which was called: # once (1.12ms+154µs) by C4::Context::BEGIN@107 at line 11
use FileHandle ();
# spent 1.27ms making 1 call to Module::Load::Conditional::BEGIN@11
122870µs22.50ms
# spent 2.48ms (2.17+310µs) within Module::Load::Conditional::BEGIN@12 which was called: # once (2.17ms+310µs) by C4::Context::BEGIN@107 at line 12
use version;
# spent 2.48ms making 1 call to Module::Load::Conditional::BEGIN@12 # spent 18µs making 1 call to version::import
13
142688µs115.7ms
# spent 15.7ms (4.34+11.3) within Module::Load::Conditional::BEGIN@14 which was called: # once (4.34ms+11.3ms) by C4::Context::BEGIN@107 at line 14
use Module::Metadata ();
# spent 15.7ms making 1 call to Module::Load::Conditional::BEGIN@14
15
16234µs290µs
# spent 51µs (13+38) within Module::Load::Conditional::BEGIN@16 which was called: # once (13µs+38µs) by C4::Context::BEGIN@107 at line 16
use constant ON_VMS => $^O eq 'VMS';
# spent 51µs making 1 call to Module::Load::Conditional::BEGIN@16 # spent 38µs making 1 call to constant::import
17235µs251µs
# spent 29µs (7+22) within Module::Load::Conditional::BEGIN@17 which was called: # once (7µs+22µs) by C4::Context::BEGIN@107 at line 17
use constant ON_WIN32 => $^O eq 'MSWin32' ? 1 : 0;
# spent 29µs making 1 call to Module::Load::Conditional::BEGIN@17 # spent 22µs making 1 call to constant::import
18231µs249µs
# spent 28µs (6+22) within Module::Load::Conditional::BEGIN@18 which was called: # once (6µs+22µs) by C4::Context::BEGIN@107 at line 18
use constant QUOTE => do { ON_WIN32 ? q["] : q['] };
# spent 28µs making 1 call to Module::Load::Conditional::BEGIN@18 # spent 22µs making 1 call to constant::import
19
20
# spent 8µs within Module::Load::Conditional::BEGIN@20 which was called: # once (8µs+0s) by C4::Context::BEGIN@107 at line 31
BEGIN {
2114µs174µs
# spent 80µs (6+74) within Module::Load::Conditional::BEGIN@21 which was called: # once (6µs+74µs) by C4::Context::BEGIN@107 at line 22
use vars qw[ $VERSION @ISA $VERBOSE $CACHE @EXPORT_OK $DEPRECATED
# spent 74µs making 1 call to vars::import
22119µs180µs $FIND_VERSION $ERROR $CHECK_INC_HASH];
# spent 80µs making 1 call to Module::Load::Conditional::BEGIN@21
23245µs233µs
# spent 20µs (7+13) within Module::Load::Conditional::BEGIN@23 which was called: # once (7µs+13µs) by C4::Context::BEGIN@107 at line 23
use Exporter;
# spent 20µs making 1 call to Module::Load::Conditional::BEGIN@23 # spent 13µs making 1 call to Exporter::import
2415µs @ISA = qw[Exporter];
251200ns $VERSION = '0.62';
261100ns $VERBOSE = 0;
271100ns $DEPRECATED = 0;
281100ns $FIND_VERSION = 1;
2910s $CHECK_INC_HASH = 0;
3014µs @EXPORT_OK = qw[check_install can_load requires];
311186µs18µs}
# spent 8µs making 1 call to Module::Load::Conditional::BEGIN@20
32
33=pod
34
35=head1 NAME
36
37Module::Load::Conditional - Looking up module information / loading at runtime
38
39=head1 SYNOPSIS
40
41 use Module::Load::Conditional qw[can_load check_install requires];
42
43
44 my $use_list = {
45 CPANPLUS => 0.05,
46 LWP => 5.60,
47 'Test::More' => undef,
48 };
49
50 print can_load( modules => $use_list )
51 ? 'all modules loaded successfully'
52 : 'failed to load required modules';
53
54
55 my $rv = check_install( module => 'LWP', version => 5.60 )
56 or print 'LWP is not installed!';
57
58 print 'LWP up to date' if $rv->{uptodate};
59 print "LWP version is $rv->{version}\n";
60 print "LWP is installed as file $rv->{file}\n";
61
62
63 print "LWP requires the following modules to be installed:\n";
64 print join "\n", requires('LWP');
65
66 ### allow M::L::C to peek in your %INC rather than just
67 ### scanning @INC
68 $Module::Load::Conditional::CHECK_INC_HASH = 1;
69
70 ### reset the 'can_load' cache
71 undef $Module::Load::Conditional::CACHE;
72
73 ### don't have Module::Load::Conditional issue warnings --
74 ### default is '1'
75 $Module::Load::Conditional::VERBOSE = 0;
76
77 ### The last error that happened during a call to 'can_load'
78 my $err = $Module::Load::Conditional::ERROR;
79
80
81=head1 DESCRIPTION
82
83Module::Load::Conditional provides simple ways to query and possibly load any of
84the modules you have installed on your system during runtime.
85
86It is able to load multiple modules at once or none at all if one of
87them was not able to load. It also takes care of any error checking
88and so forth.
89
90=head1 Methods
91
92=head2 $href = check_install( module => NAME [, version => VERSION, verbose => BOOL ] );
93
94C<check_install> allows you to verify if a certain module is installed
95or not. You may call it with the following arguments:
96
97=over 4
98
99=item module
100
101The name of the module you wish to verify -- this is a required key
102
103=item version
104
105The version this module needs to be -- this is optional
106
107=item verbose
108
109Whether or not to be verbose about what it is doing -- it will default
110to $Module::Load::Conditional::VERBOSE
111
112=back
113
114It will return undef if it was not able to find where the module was
115installed, or a hash reference with the following keys if it was able
116to find the file:
117
118=over 4
119
120=item file
121
122Full path to the file that contains the module
123
124=item dir
125
126Directory, or more exact the C<@INC> entry, where the module was
127loaded from.
128
129=item version
130
131The version number of the installed module - this will be C<undef> if
132the module had no (or unparsable) version number, or if the variable
133C<$Module::Load::Conditional::FIND_VERSION> was set to true.
134(See the C<GLOBAL VARIABLES> section below for details)
135
136=item uptodate
137
138A boolean value indicating whether or not the module was found to be
139at least the version you specified. If you did not specify a version,
140uptodate will always be true if the module was found.
141If no parsable version was found in the module, uptodate will also be
142true, since C<check_install> had no way to verify clearly.
143
144See also C<$Module::Load::Conditional::DEPRECATED>, which affects
145the outcome of this value.
146
147=back
148
149=cut
150
151### this checks if a certain module is installed already ###
152### if it returns true, the module in question is already installed
153### or we found the file, but couldn't open it, OR there was no version
154### to be found in the module
155### it will return 0 if the version in the module is LOWER then the one
156### we are looking for, or if we couldn't find the desired module to begin with
157### if the installed version is higher or equal to the one we want, it will return
158### a hashref with he module name and version in it.. so 'true' as well.
159sub check_install {
160 my %hash = @_;
161
162 my $tmpl = {
163 version => { default => '0.0' },
164 module => { required => 1 },
165 verbose => { default => $VERBOSE },
166 };
167
168 my $args;
169 unless( $args = check( $tmpl, \%hash, $VERBOSE ) ) {
170 warn loc( q[A problem occurred checking arguments] ) if $VERBOSE;
171 return;
172 }
173
174 my $file = File::Spec->catfile( split /::/, $args->{module} ) . '.pm';
175 my $file_inc = File::Spec::Unix->catfile(
176 split /::/, $args->{module}
177 ) . '.pm';
178
179 ### where we store the return value ###
180 my $href = {
181 file => undef,
182 version => undef,
183 uptodate => undef,
184 };
185
186 my $filename;
187
188 ### check the inc hash if we're allowed to
189 if( $CHECK_INC_HASH ) {
190 $filename = $href->{'file'} =
191 $INC{ $file_inc } if defined $INC{ $file_inc };
192
193 ### find the version by inspecting the package
194 if( defined $filename && $FIND_VERSION ) {
1952898µs224µs
# spent 16µs (6+9) within Module::Load::Conditional::BEGIN@195 which was called: # once (6µs+9µs) by C4::Context::BEGIN@107 at line 195
no strict 'refs';
# spent 16µs making 1 call to Module::Load::Conditional::BEGIN@195 # spent 9µs making 1 call to strict::unimport
196 $href->{version} = ${ "$args->{module}"."::VERSION" };
197 }
198 }
199
200 ### we didn't find the filename yet by looking in %INC,
201 ### so scan the dirs
202 unless( $filename ) {
203
204 DIR: for my $dir ( @INC ) {
205
206 my $fh;
207
208 if ( ref $dir ) {
209 ### @INC hook -- we invoke it and get the filehandle back
210 ### this is actually documented behaviour as of 5.8 ;)
211
212 my $existed_in_inc = $INC{$file_inc};
213
214 if (UNIVERSAL::isa($dir, 'CODE')) {
215 ($fh) = $dir->($dir, $file);
216
217 } elsif (UNIVERSAL::isa($dir, 'ARRAY')) {
218 ($fh) = $dir->[0]->($dir, $file, @{$dir}{1..$#{$dir}})
219
220 } elsif (UNIVERSAL::can($dir, 'INC')) {
221 ($fh) = $dir->INC($file);
222 }
223
224 if (!UNIVERSAL::isa($fh, 'GLOB')) {
225 warn loc(q[Cannot open file '%1': %2], $file, $!)
226 if $args->{verbose};
227 next;
228 }
229
230 $filename = $INC{$file_inc} || $file;
231
232 delete $INC{$file_inc} if not $existed_in_inc;
233
234 } else {
235 $filename = File::Spec->catfile($dir, $file);
236 next unless -e $filename;
237
238 $fh = new FileHandle;
239 if (!$fh->open($filename)) {
240 warn loc(q[Cannot open file '%1': %2], $file, $!)
241 if $args->{verbose};
242 next;
243 }
244 }
245
246 ### store the directory we found the file in
247 $href->{dir} = $dir;
248
249 ### files need to be in unix format under vms,
250 ### or they might be loaded twice
251 $href->{file} = ON_VMS
252 ? VMS::Filespec::unixify( $filename )
253 : $filename;
254
255 ### if we don't need the version, we're done
256 last DIR unless $FIND_VERSION;
257
258 ### otherwise, the user wants us to find the version from files
259 my $mod_info = Module::Metadata->new_from_handle( $fh, $filename );
260 my $ver = $mod_info->version( $args->{module} );
261
262 if( defined $ver ) {
263 $href->{version} = $ver;
264
265 last DIR;
266 }
267 }
268 }
269
270 ### if we couldn't find the file, return undef ###
271 return unless defined $href->{file};
272
273 ### only complain if we're expected to find a version higher than 0.0 anyway
274 if( $FIND_VERSION and not defined $href->{version} ) {
275 { ### don't warn about the 'not numeric' stuff ###
276 local $^W;
277
278 ### if we got here, we didn't find the version
279 warn loc(q[Could not check version on '%1'], $args->{module} )
280 if $args->{verbose} and $args->{version} > 0;
281 }
282 $href->{uptodate} = 1;
283
284 } else {
285 ### don't warn about the 'not numeric' stuff ###
286 local $^W;
287
288 ### use qv(), as it will deal with developer release number
289 ### ie ones containing _ as well. This addresses bug report
290 ### #29348: Version compare logic doesn't handle alphas?
291 ###
292 ### Update from JPeacock: apparently qv() and version->new
293 ### are different things, and we *must* use version->new
294 ### here, or things like #30056 might start happening
295
296 ### We have to wrap this in an eval as version-0.82 raises
297 ### exceptions and not warnings now *sigh*
298
299 eval {
300
301 $href->{uptodate} =
302 version->new( $args->{version} ) <= version->new( $href->{version} )
303 ? 1
304 : 0;
305
306 };
307 }
308
309 if ( $DEPRECATED and "$]" >= 5.011 ) {
310 require Module::CoreList;
311 require Config;
312
313 $href->{uptodate} = 0 if
314 exists $Module::CoreList::version{ 0+$] }{ $args->{module} } and
315 Module::CoreList::is_deprecated( $args->{module} ) and
316 $Config::Config{privlibexp} eq $href->{dir};
317 }
318
319 return $href;
320}
321
322=head2 $bool = can_load( modules => { NAME => VERSION [,NAME => VERSION] }, [verbose => BOOL, nocache => BOOL, autoload => BOOL] )
323
324C<can_load> will take a list of modules, optionally with version
325numbers and determine if it is able to load them. If it can load *ALL*
326of them, it will. If one or more are unloadable, none will be loaded.
327
328This is particularly useful if you have More Than One Way (tm) to
329solve a problem in a program, and only wish to continue down a path
330if all modules could be loaded, and not load them if they couldn't.
331
332This function uses the C<load> function or the C<autoload_remote> function
333from Module::Load under the hood.
334
335C<can_load> takes the following arguments:
336
337=over 4
338
339=item modules
340
341This is a hashref of module/version pairs. The version indicates the
342minimum version to load. If no version is provided, any version is
343assumed to be good enough.
344
345=item verbose
346
347This controls whether warnings should be printed if a module failed
348to load.
349The default is to use the value of $Module::Load::Conditional::VERBOSE.
350
351=item nocache
352
353C<can_load> keeps its results in a cache, so it will not load the
354same module twice, nor will it attempt to load a module that has
355already failed to load before. By default, C<can_load> will check its
356cache, but you can override that by setting C<nocache> to true.
357
358=item autoload
359
360This controls whether imports the functions of a loaded modules to the caller package. The default is no importing any functions.
361
362See the C<autoload> function and the C<autoload_remote> function from L<Module::Load> for details.
363
364=cut
365
366sub can_load {
367 my %hash = @_;
368
369 my $tmpl = {
370 modules => { default => {}, strict_type => 1 },
371 verbose => { default => $VERBOSE },
372 nocache => { default => 0 },
373 autoload => { default => 0 },
374 };
375
376 my $args;
377
378 unless( $args = check( $tmpl, \%hash, $VERBOSE ) ) {
379 $ERROR = loc(q[Problem validating arguments!]);
380 warn $ERROR if $VERBOSE;
381 return;
382 }
383
384 ### layout of $CACHE:
385 ### $CACHE = {
386 ### $ module => {
387 ### usable => BOOL,
388 ### version => \d,
389 ### file => /path/to/file,
390 ### },
391 ### };
392
393 $CACHE ||= {}; # in case it was undef'd
394
395 my $error;
396 BLOCK: {
397 my $href = $args->{modules};
398
399 my @load;
400 for my $mod ( keys %$href ) {
401
402 next if $CACHE->{$mod}->{usable} && !$args->{nocache};
403
404 ### else, check if the hash key is defined already,
405 ### meaning $mod => 0,
406 ### indicating UNSUCCESSFUL prior attempt of usage
407
408 ### use qv(), as it will deal with developer release number
409 ### ie ones containing _ as well. This addresses bug report
410 ### #29348: Version compare logic doesn't handle alphas?
411 ###
412 ### Update from JPeacock: apparently qv() and version->new
413 ### are different things, and we *must* use version->new
414 ### here, or things like #30056 might start happening
415 if ( !$args->{nocache}
416 && defined $CACHE->{$mod}->{usable}
417 && (version->new( $CACHE->{$mod}->{version}||0 )
418 >= version->new( $href->{$mod} ) )
419 ) {
420 $error = loc( q[Already tried to use '%1', which was unsuccessful], $mod);
421 last BLOCK;
422 }
423
424 my $mod_data = check_install(
425 module => $mod,
426 version => $href->{$mod}
427 );
428
429 if( !$mod_data or !defined $mod_data->{file} ) {
430 $error = loc(q[Could not find or check module '%1'], $mod);
431 $CACHE->{$mod}->{usable} = 0;
432 last BLOCK;
433 }
434
435 map {
436 $CACHE->{$mod}->{$_} = $mod_data->{$_}
437 } qw[version file uptodate];
438
439 push @load, $mod;
440 }
441
442 for my $mod ( @load ) {
443
444 if ( $CACHE->{$mod}->{uptodate} ) {
445
446 if ( $args->{autoload} ) {
447 my $who = (caller())[0];
448 eval { autoload_remote $who, $mod };
449 } else {
450 eval { load $mod };
451 }
452
453 ### in case anything goes wrong, log the error, the fact
454 ### we tried to use this module and return 0;
455 if( $@ ) {
456 $error = $@;
457 $CACHE->{$mod}->{usable} = 0;
458 last BLOCK;
459 } else {
460 $CACHE->{$mod}->{usable} = 1;
461 }
462
463 ### module not found in @INC, store the result in
464 ### $CACHE and return 0
465 } else {
466
467 $error = loc(q[Module '%1' is not uptodate!], $mod);
468 $CACHE->{$mod}->{usable} = 0;
469 last BLOCK;
470 }
471 }
472
473 } # BLOCK
474
475 if( defined $error ) {
476 $ERROR = $error;
477 Carp::carp( loc(q|%1 [THIS MAY BE A PROBLEM!]|,$error) ) if $args->{verbose};
478 return;
479 } else {
480 return 1;
481 }
482}
483
484=back
485
486=head2 @list = requires( MODULE );
487
488C<requires> can tell you what other modules a particular module
489requires. This is particularly useful when you're intending to write
490a module for public release and are listing its prerequisites.
491
492C<requires> takes but one argument: the name of a module.
493It will then first check if it can actually load this module, and
494return undef if it can't.
495Otherwise, it will return a list of modules and pragmas that would
496have been loaded on the module's behalf.
497
498Note: The list C<require> returns has originated from your current
499perl and your current install.
500
501=cut
502
503sub requires {
504 my $who = shift;
505
506 unless( check_install( module => $who ) ) {
507 warn loc(q[You do not have module '%1' installed], $who) if $VERBOSE;
508 return undef;
509 }
510
511 my $lib = join " ", map { qq["-I$_"] } @INC;
512 my $oneliner = 'print(join(qq[\n],map{qq[BONG=$_]}keys(%INC)),qq[\n])';
513 my $cmd = join '', qq["$^X" $lib -M$who -e], QUOTE, $oneliner, QUOTE;
514
515 return sort
516 grep { !/^$who$/ }
517 map { chomp; s|/|::|g; $_ }
518 grep { s|\.pm$||i; }
519 map { s!^BONG\=!!; $_ }
520 grep { m!^BONG\=! }
521 `$cmd`;
522}
523
52412µs1;
525
526__END__
Report produced by the NYTProf 5.06 Perl profiler, developed by Tim Bunce and Adam Kaplan.