← Index
NYTProf Performance Profile   « line view »
For split.pl
  Run on Thu Apr 20 02:05:47 2023
Reported on Thu Apr 20 18:31:09 2023

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