This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update Module-Load-Conditional to CPAN version 0.42
[perl5.git] / cpan / Module-Load-Conditional / lib / Module / Load / Conditional.pm
CommitLineData
0dc418cb
JB
1package Module::Load::Conditional;
2
3use strict;
4
5use Module::Load;
3fa779ab
JB
6use Params::Check qw[check];
7use Locale::Maketext::Simple Style => 'gettext';
0dc418cb
JB
8
9use Carp ();
10use File::Spec ();
11use FileHandle ();
aacdad3c 12use version;
0dc418cb 13
3fa779ab
JB
14use constant ON_VMS => $^O eq 'VMS';
15
0dc418cb 16BEGIN {
1823d11b 17 use vars qw[ $VERSION @ISA $VERBOSE $CACHE @EXPORT_OK $DEPRECATED
0dc418cb
JB
18 $FIND_VERSION $ERROR $CHECK_INC_HASH];
19 use Exporter;
20 @ISA = qw[Exporter];
a4031803 21 $VERSION = '0.42';
0dc418cb 22 $VERBOSE = 0;
1823d11b 23 $DEPRECATED = 0;
0dc418cb
JB
24 $FIND_VERSION = 1;
25 $CHECK_INC_HASH = 0;
26 @EXPORT_OK = qw[check_install can_load requires];
27}
28
29=pod
30
31=head1 NAME
32
33Module::Load::Conditional - Looking up module information / loading at runtime
34
35=head1 SYNOPSIS
36
37 use Module::Load::Conditional qw[can_load check_install requires];
38
39
40 my $use_list = {
41 CPANPLUS => 0.05,
42 LWP => 5.60,
43 'Test::More' => undef,
44 };
45
46 print can_load( modules => $use_list )
47 ? 'all modules loaded successfully'
48 : 'failed to load required modules';
49
50
51 my $rv = check_install( module => 'LWP', version => 5.60 )
52 or print 'LWP is not installed!';
53
54 print 'LWP up to date' if $rv->{uptodate};
55 print "LWP version is $rv->{version}\n";
56 print "LWP is installed as file $rv->{file}\n";
57
58
59 print "LWP requires the following modules to be installed:\n";
60 print join "\n", requires('LWP');
61
62 ### allow M::L::C to peek in your %INC rather than just
63 ### scanning @INC
64 $Module::Load::Conditional::CHECK_INC_HASH = 1;
65
66 ### reset the 'can_load' cache
67 undef $Module::Load::Conditional::CACHE;
68
69 ### don't have Module::Load::Conditional issue warnings --
70 ### default is '1'
71 $Module::Load::Conditional::VERBOSE = 0;
72
73 ### The last error that happened during a call to 'can_load'
74 my $err = $Module::Load::Conditional::ERROR;
75
76
77=head1 DESCRIPTION
78
79Module::Load::Conditional provides simple ways to query and possibly load any of
80the modules you have installed on your system during runtime.
81
82It is able to load multiple modules at once or none at all if one of
83them was not able to load. It also takes care of any error checking
84and so forth.
85
86=head1 Methods
87
88=head1 $href = check_install( module => NAME [, version => VERSION, verbose => BOOL ] );
89
90C<check_install> allows you to verify if a certain module is installed
91or not. You may call it with the following arguments:
92
93=over 4
94
95=item module
96
97The name of the module you wish to verify -- this is a required key
98
99=item version
100
101The version this module needs to be -- this is optional
102
103=item verbose
104
105Whether or not to be verbose about what it is doing -- it will default
106to $Module::Load::Conditional::VERBOSE
107
108=back
109
110It will return undef if it was not able to find where the module was
111installed, or a hash reference with the following keys if it was able
112to find the file:
113
114=over 4
115
116=item file
117
118Full path to the file that contains the module
119
9b31c40c
SH
120=item dir
121
122Directory, or more exact the C<@INC> entry, where the module was
123loaded from.
124
0dc418cb
JB
125=item version
126
127The version number of the installed module - this will be C<undef> if
128the module had no (or unparsable) version number, or if the variable
129C<$Module::Load::Conditional::FIND_VERSION> was set to true.
130(See the C<GLOBAL VARIABLES> section below for details)
131
132=item uptodate
133
134A boolean value indicating whether or not the module was found to be
135at least the version you specified. If you did not specify a version,
136uptodate will always be true if the module was found.
137If no parsable version was found in the module, uptodate will also be
138true, since C<check_install> had no way to verify clearly.
139
1823d11b
CBW
140See also C<$Module::Load::Conditional::DEPRECATED>, which affects
141the outcome of this value.
142
0dc418cb
JB
143=back
144
145=cut
146
147### this checks if a certain module is installed already ###
148### if it returns true, the module in question is already installed
149### or we found the file, but couldn't open it, OR there was no version
150### to be found in the module
151### it will return 0 if the version in the module is LOWER then the one
152### we are looking for, or if we couldn't find the desired module to begin with
153### if the installed version is higher or equal to the one we want, it will return
154### a hashref with he module name and version in it.. so 'true' as well.
155sub check_install {
156 my %hash = @_;
157
158 my $tmpl = {
159 version => { default => '0.0' },
160 module => { required => 1 },
161 verbose => { default => $VERBOSE },
162 };
163
164 my $args;
165 unless( $args = check( $tmpl, \%hash, $VERBOSE ) ) {
166 warn loc( q[A problem occurred checking arguments] ) if $VERBOSE;
167 return;
168 }
169
170 my $file = File::Spec->catfile( split /::/, $args->{module} ) . '.pm';
171 my $file_inc = File::Spec::Unix->catfile(
172 split /::/, $args->{module}
173 ) . '.pm';
174
175 ### where we store the return value ###
176 my $href = {
177 file => undef,
178 version => undef,
179 uptodate => undef,
180 };
181
182 my $filename;
183
184 ### check the inc hash if we're allowed to
185 if( $CHECK_INC_HASH ) {
186 $filename = $href->{'file'} =
187 $INC{ $file_inc } if defined $INC{ $file_inc };
188
189 ### find the version by inspecting the package
190 if( defined $filename && $FIND_VERSION ) {
191 no strict 'refs';
192 $href->{version} = ${ "$args->{module}"."::VERSION" };
193 }
194 }
195
196 ### we didnt find the filename yet by looking in %INC,
197 ### so scan the dirs
198 unless( $filename ) {
199
200 DIR: for my $dir ( @INC ) {
201
202 my $fh;
203
204 if ( ref $dir ) {
205 ### @INC hook -- we invoke it and get the filehandle back
206 ### this is actually documented behaviour as of 5.8 ;)
a4031803
CBW
207
208 my $existed_in_inc = $INC{$file_inc};
0dc418cb
JB
209
210 if (UNIVERSAL::isa($dir, 'CODE')) {
211 ($fh) = $dir->($dir, $file);
212
213 } elsif (UNIVERSAL::isa($dir, 'ARRAY')) {
214 ($fh) = $dir->[0]->($dir, $file, @{$dir}{1..$#{$dir}})
215
216 } elsif (UNIVERSAL::can($dir, 'INC')) {
1823d11b 217 ($fh) = $dir->INC($file);
0dc418cb
JB
218 }
219
220 if (!UNIVERSAL::isa($fh, 'GLOB')) {
221 warn loc(q[Cannot open file '%1': %2], $file, $!)
222 if $args->{verbose};
223 next;
224 }
225
226 $filename = $INC{$file_inc} || $file;
a4031803
CBW
227
228 delete $INC{$file_inc} if not $existed_in_inc;
0dc418cb
JB
229
230 } else {
231 $filename = File::Spec->catfile($dir, $file);
232 next unless -e $filename;
233
234 $fh = new FileHandle;
235 if (!$fh->open($filename)) {
236 warn loc(q[Cannot open file '%1': %2], $file, $!)
237 if $args->{verbose};
238 next;
239 }
240 }
241
9b31c40c
SH
242 ### store the directory we found the file in
243 $href->{dir} = $dir;
244
3fa779ab
JB
245 ### files need to be in unix format under vms,
246 ### or they might be loaded twice
247 $href->{file} = ON_VMS
248 ? VMS::Filespec::unixify( $filename )
249 : $filename;
0dc418cb
JB
250
251 ### user wants us to find the version from files
252 if( $FIND_VERSION ) {
253
e163f9a0 254 my $in_pod = 0;
9b31c40c 255 while ( my $line = <$fh> ) {
0dc418cb 256
e163f9a0
RGS
257 ### stolen from EU::MM_Unix->parse_version to address
258 ### #24062: "Problem with CPANPLUS 0.076 misidentifying
259 ### versions after installing Text::NSP 1.03" where a
260 ### VERSION mentioned in the POD was found before
261 ### the real $VERSION declaration.
9b31c40c
SH
262 $in_pod = $line =~ /^=(?!cut)/ ? 1 :
263 $line =~ /^=cut/ ? 0 :
264 $in_pod;
e163f9a0
RGS
265 next if $in_pod;
266
91e53322 267 ### try to find a version declaration in this string.
9b31c40c 268 my $ver = __PACKAGE__->_parse_version( $line );
91e53322
RGS
269
270 if( defined $ver ) {
271 $href->{version} = $ver;
0dc418cb
JB
272
273 last DIR;
274 }
275 }
276 }
277 }
278 }
279
280 ### if we couldn't find the file, return undef ###
281 return unless defined $href->{file};
282
3fa779ab 283 ### only complain if we're expected to find a version higher than 0.0 anyway
0dc418cb
JB
284 if( $FIND_VERSION and not defined $href->{version} ) {
285 { ### don't warn about the 'not numeric' stuff ###
286 local $^W;
287
288 ### if we got here, we didn't find the version
289 warn loc(q[Could not check version on '%1'], $args->{module} )
290 if $args->{verbose} and $args->{version} > 0;
291 }
292 $href->{uptodate} = 1;
293
294 } else {
295 ### don't warn about the 'not numeric' stuff ###
296 local $^W;
3fa779ab
JB
297
298 ### use qv(), as it will deal with developer release number
299 ### ie ones containing _ as well. This addresses bug report
300 ### #29348: Version compare logic doesn't handle alphas?
aacdad3c
SP
301 ###
302 ### Update from JPeacock: apparently qv() and version->new
303 ### are different things, and we *must* use version->new
304 ### here, or things like #30056 might start happening
6ba8cc37
CBW
305
306 ### We have to wrap this in an eval as version-0.82 raises
307 ### exceptions and not warnings now *sigh*
308
309 eval {
310
311 $href->{uptodate} =
aacdad3c
SP
312 version->new( $args->{version} ) <= version->new( $href->{version} )
313 ? 1
314 : 0;
6ba8cc37
CBW
315
316 };
0dc418cb
JB
317 }
318
1823d11b
CBW
319 if ( $DEPRECATED and version->new($]) >= version->new('5.011') ) {
320 require Module::CoreList;
321 require Config;
322
323 $href->{uptodate} = 0 if
324 exists $Module::CoreList::version{ 0+$] }{ $args->{module} } and
325 Module::CoreList::is_deprecated( $args->{module} ) and
326 $Config::Config{privlibexp} eq $href->{dir};
327 }
328
0dc418cb
JB
329 return $href;
330}
331
91e53322
RGS
332sub _parse_version {
333 my $self = shift;
334 my $str = shift or return;
335 my $verbose = shift or 0;
336
6ba8cc37
CBW
337 ### skip lines which doesn't contain VERSION
338 return unless $str =~ /VERSION/;
339
91e53322
RGS
340 ### skip commented out lines, they won't eval to anything.
341 return if $str =~ /^\s*#/;
342
343 ### the following regexp & eval statement comes from the
344 ### ExtUtils::MakeMaker source (EU::MM_Unix->parse_version)
345 ### Following #18892, which tells us the original
8c2265fd 346 ### regex breaks under -T, we must modify it so
91e53322
RGS
347 ### it captures the entire expression, and eval /that/
348 ### rather than $_, which is insecure.
aacdad3c
SP
349 my $taint_safe_str = do { $str =~ /(^.*$)/sm; $1 };
350
91e53322
RGS
351 if( $str =~ /(?<!\\)([\$*])(([\w\:\']*)\bVERSION)\b.*\=/ ) {
352
353 print "Evaluating: $str\n" if $verbose;
354
355 ### this creates a string to be eval'd, like:
356 # package Module::Load::Conditional::_version;
357 # no strict;
358 #
359 # local $VERSION;
360 # $VERSION=undef; do {
361 # use version; $VERSION = qv('0.0.3');
362 # }; $VERSION
363
364 my $eval = qq{
365 package Module::Load::Conditional::_version;
366 no strict;
367
368 local $1$2;
369 \$$2=undef; do {
aacdad3c 370 $taint_safe_str
91e53322
RGS
371 }; \$$2
372 };
373
374 print "Evaltext: $eval\n" if $verbose;
375
376 my $result = do {
377 local $^W = 0;
378 eval($eval);
379 };
380
381
382 my $rv = defined $result ? $result : '0.0';
383
384 print( $@ ? "Error: $@\n" : "Result: $rv\n" ) if $verbose;
385
386 return $rv;
387 }
388
389 ### unable to find a version in this string
390 return;
391}
392
0dc418cb
JB
393=head2 $bool = can_load( modules => { NAME => VERSION [,NAME => VERSION] }, [verbose => BOOL, nocache => BOOL] )
394
395C<can_load> will take a list of modules, optionally with version
396numbers and determine if it is able to load them. If it can load *ALL*
397of them, it will. If one or more are unloadable, none will be loaded.
398
399This is particularly useful if you have More Than One Way (tm) to
400solve a problem in a program, and only wish to continue down a path
401if all modules could be loaded, and not load them if they couldn't.
402
403This function uses the C<load> function from Module::Load under the
404hood.
405
406C<can_load> takes the following arguments:
407
408=over 4
409
410=item modules
411
412This is a hashref of module/version pairs. The version indicates the
413minimum version to load. If no version is provided, any version is
414assumed to be good enough.
415
416=item verbose
417
418This controls whether warnings should be printed if a module failed
419to load.
420The default is to use the value of $Module::Load::Conditional::VERBOSE.
421
422=item nocache
423
424C<can_load> keeps its results in a cache, so it will not load the
425same module twice, nor will it attempt to load a module that has
426already failed to load before. By default, C<can_load> will check its
427cache, but you can override that by setting C<nocache> to true.
428
429=cut
430
431sub can_load {
432 my %hash = @_;
433
434 my $tmpl = {
435 modules => { default => {}, strict_type => 1 },
436 verbose => { default => $VERBOSE },
437 nocache => { default => 0 },
438 };
439
440 my $args;
441
442 unless( $args = check( $tmpl, \%hash, $VERBOSE ) ) {
443 $ERROR = loc(q[Problem validating arguments!]);
444 warn $ERROR if $VERBOSE;
445 return;
446 }
447
448 ### layout of $CACHE:
449 ### $CACHE = {
450 ### $ module => {
451 ### usable => BOOL,
452 ### version => \d,
453 ### file => /path/to/file,
454 ### },
455 ### };
456
457 $CACHE ||= {}; # in case it was undef'd
458
459 my $error;
460 BLOCK: {
461 my $href = $args->{modules};
462
463 my @load;
464 for my $mod ( keys %$href ) {
465
466 next if $CACHE->{$mod}->{usable} && !$args->{nocache};
467
468 ### else, check if the hash key is defined already,
469 ### meaning $mod => 0,
470 ### indicating UNSUCCESSFUL prior attempt of usage
3fa779ab
JB
471
472 ### use qv(), as it will deal with developer release number
473 ### ie ones containing _ as well. This addresses bug report
474 ### #29348: Version compare logic doesn't handle alphas?
aacdad3c
SP
475 ###
476 ### Update from JPeacock: apparently qv() and version->new
477 ### are different things, and we *must* use version->new
478 ### here, or things like #30056 might start happening
0dc418cb
JB
479 if ( !$args->{nocache}
480 && defined $CACHE->{$mod}->{usable}
aacdad3c
SP
481 && (version->new( $CACHE->{$mod}->{version}||0 )
482 >= version->new( $href->{$mod} ) )
0dc418cb
JB
483 ) {
484 $error = loc( q[Already tried to use '%1', which was unsuccessful], $mod);
485 last BLOCK;
486 }
487
488 my $mod_data = check_install(
489 module => $mod,
490 version => $href->{$mod}
491 );
492
493 if( !$mod_data or !defined $mod_data->{file} ) {
494 $error = loc(q[Could not find or check module '%1'], $mod);
495 $CACHE->{$mod}->{usable} = 0;
496 last BLOCK;
497 }
498
499 map {
500 $CACHE->{$mod}->{$_} = $mod_data->{$_}
501 } qw[version file uptodate];
502
503 push @load, $mod;
504 }
505
506 for my $mod ( @load ) {
507
508 if ( $CACHE->{$mod}->{uptodate} ) {
509
510 eval { load $mod };
511
512 ### in case anything goes wrong, log the error, the fact
513 ### we tried to use this module and return 0;
514 if( $@ ) {
515 $error = $@;
516 $CACHE->{$mod}->{usable} = 0;
517 last BLOCK;
518 } else {
519 $CACHE->{$mod}->{usable} = 1;
520 }
521
522 ### module not found in @INC, store the result in
523 ### $CACHE and return 0
524 } else {
525
526 $error = loc(q[Module '%1' is not uptodate!], $mod);
527 $CACHE->{$mod}->{usable} = 0;
528 last BLOCK;
529 }
530 }
531
532 } # BLOCK
533
534 if( defined $error ) {
535 $ERROR = $error;
536 Carp::carp( loc(q|%1 [THIS MAY BE A PROBLEM!]|,$error) ) if $args->{verbose};
3fa779ab 537 return;
0dc418cb
JB
538 } else {
539 return 1;
540 }
541}
542
3fa779ab
JB
543=back
544
0dc418cb
JB
545=head2 @list = requires( MODULE );
546
547C<requires> can tell you what other modules a particular module
548requires. This is particularly useful when you're intending to write
549a module for public release and are listing its prerequisites.
550
551C<requires> takes but one argument: the name of a module.
552It will then first check if it can actually load this module, and
553return undef if it can't.
554Otherwise, it will return a list of modules and pragmas that would
555have been loaded on the module's behalf.
556
557Note: The list C<require> returns has originated from your current
558perl and your current install.
559
560=cut
561
562sub requires {
563 my $who = shift;
564
565 unless( check_install( module => $who ) ) {
566 warn loc(q[You do not have module '%1' installed], $who) if $VERBOSE;
567 return undef;
568 }
569
570 my $lib = join " ", map { qq["-I$_"] } @INC;
571 my $cmd = qq[$^X $lib -M$who -e"print(join(qq[\\n],keys(%INC)))"];
572
573 return sort
574 grep { !/^$who$/ }
575 map { chomp; s|/|::|g; $_ }
576 grep { s|\.pm$||i; }
577 `$cmd`;
578}
579
5801;
581
582__END__
583
584=head1 Global Variables
585
586The behaviour of Module::Load::Conditional can be altered by changing the
587following global variables:
588
589=head2 $Module::Load::Conditional::VERBOSE
590
591This controls whether Module::Load::Conditional will issue warnings and
592explanations as to why certain things may have failed. If you set it
593to 0, Module::Load::Conditional will not output any warnings.
594The default is 0;
595
596=head2 $Module::Load::Conditional::FIND_VERSION
597
598This controls whether Module::Load::Conditional will try to parse
599(and eval) the version from the module you're trying to load.
600
601If you don't wish to do this, set this variable to C<false>. Understand
602then that version comparisons are not possible, and Module::Load::Conditional
603can not tell you what module version you have installed.
604This may be desirable from a security or performance point of view.
605Note that C<$FIND_VERSION> code runs safely under C<taint mode>.
606
607The default is 1;
608
609=head2 $Module::Load::Conditional::CHECK_INC_HASH
610
611This controls whether C<Module::Load::Conditional> checks your
612C<%INC> hash to see if a module is available. By default, only
613C<@INC> is scanned to see if a module is physically on your
8c2265fd 614filesystem, or available via an C<@INC-hook>. Setting this variable
0dc418cb
JB
615to C<true> will trust any entries in C<%INC> and return them for
616you.
617
618The default is 0;
619
620=head2 $Module::Load::Conditional::CACHE
621
622This holds the cache of the C<can_load> function. If you explicitly
623want to remove the current cache, you can set this variable to
624C<undef>
625
626=head2 $Module::Load::Conditional::ERROR
627
628This holds a string of the last error that happened during a call to
629C<can_load>. It is useful to inspect this when C<can_load> returns
630C<undef>.
631
1823d11b
CBW
632=head2 $Module::Load::Conditional::DEPRECATED
633
634This controls whether C<Module::Load::Conditional> checks if
635a dual-life core module has been deprecated. If this is set to
636true C<check_install> will return false to C<uptodate>, if
637a dual-life module is found to be loaded from C<$Config{privlibexp}>
638
639The default is 0;
640
0dc418cb
JB
641=head1 See Also
642
643C<Module::Load>
644
3fa779ab
JB
645=head1 BUG REPORTS
646
647Please report bugs or other issues to E<lt>bug-module-load-conditional@rt.cpan.orgE<gt>.
648
0dc418cb
JB
649=head1 AUTHOR
650
3fa779ab 651This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.
0dc418cb
JB
652
653=head1 COPYRIGHT
654
3fa779ab
JB
655This library is free software; you may redistribute and/or modify it
656under the same terms as Perl itself.
0dc418cb 657
3fa779ab 658=cut