1 package Module::Load::Conditional;
6 use Params::Check qw[check];
7 use Locale::Maketext::Simple Style => 'gettext';
14 use constant ON_VMS => $^O eq 'VMS';
17 use vars qw[ $VERSION @ISA $VERBOSE $CACHE @EXPORT_OK
18 $FIND_VERSION $ERROR $CHECK_INC_HASH];
25 @EXPORT_OK = qw[check_install can_load requires];
32 Module::Load::Conditional - Looking up module information / loading at runtime
36 use Module::Load::Conditional qw[can_load check_install requires];
42 'Test::More' => undef,
45 print can_load( modules => $use_list )
46 ? 'all modules loaded successfully'
47 : 'failed to load required modules';
50 my $rv = check_install( module => 'LWP', version => 5.60 )
51 or print 'LWP is not installed!';
53 print 'LWP up to date' if $rv->{uptodate};
54 print "LWP version is $rv->{version}\n";
55 print "LWP is installed as file $rv->{file}\n";
58 print "LWP requires the following modules to be installed:\n";
59 print join "\n", requires('LWP');
61 ### allow M::L::C to peek in your %INC rather than just
63 $Module::Load::Conditional::CHECK_INC_HASH = 1;
65 ### reset the 'can_load' cache
66 undef $Module::Load::Conditional::CACHE;
68 ### don't have Module::Load::Conditional issue warnings --
70 $Module::Load::Conditional::VERBOSE = 0;
72 ### The last error that happened during a call to 'can_load'
73 my $err = $Module::Load::Conditional::ERROR;
78 Module::Load::Conditional provides simple ways to query and possibly load any of
79 the modules you have installed on your system during runtime.
81 It is able to load multiple modules at once or none at all if one of
82 them was not able to load. It also takes care of any error checking
87 =head1 $href = check_install( module => NAME [, version => VERSION, verbose => BOOL ] );
89 C<check_install> allows you to verify if a certain module is installed
90 or not. You may call it with the following arguments:
96 The name of the module you wish to verify -- this is a required key
100 The version this module needs to be -- this is optional
104 Whether or not to be verbose about what it is doing -- it will default
105 to $Module::Load::Conditional::VERBOSE
109 It will return undef if it was not able to find where the module was
110 installed, or a hash reference with the following keys if it was able
117 Full path to the file that contains the module
121 Directory, or more exact the C<@INC> entry, where the module was
126 The version number of the installed module - this will be C<undef> if
127 the module had no (or unparsable) version number, or if the variable
128 C<$Module::Load::Conditional::FIND_VERSION> was set to true.
129 (See the C<GLOBAL VARIABLES> section below for details)
133 A boolean value indicating whether or not the module was found to be
134 at least the version you specified. If you did not specify a version,
135 uptodate will always be true if the module was found.
136 If no parsable version was found in the module, uptodate will also be
137 true, since C<check_install> had no way to verify clearly.
143 ### this checks if a certain module is installed already ###
144 ### if it returns true, the module in question is already installed
145 ### or we found the file, but couldn't open it, OR there was no version
146 ### to be found in the module
147 ### it will return 0 if the version in the module is LOWER then the one
148 ### we are looking for, or if we couldn't find the desired module to begin with
149 ### if the installed version is higher or equal to the one we want, it will return
150 ### a hashref with he module name and version in it.. so 'true' as well.
155 version => { default => '0.0' },
156 module => { required => 1 },
157 verbose => { default => $VERBOSE },
161 unless( $args = check( $tmpl, \%hash, $VERBOSE ) ) {
162 warn loc( q[A problem occurred checking arguments] ) if $VERBOSE;
166 my $file = File::Spec->catfile( split /::/, $args->{module} ) . '.pm';
167 my $file_inc = File::Spec::Unix->catfile(
168 split /::/, $args->{module}
171 ### where we store the return value ###
180 ### check the inc hash if we're allowed to
181 if( $CHECK_INC_HASH ) {
182 $filename = $href->{'file'} =
183 $INC{ $file_inc } if defined $INC{ $file_inc };
185 ### find the version by inspecting the package
186 if( defined $filename && $FIND_VERSION ) {
188 $href->{version} = ${ "$args->{module}"."::VERSION" };
192 ### we didnt find the filename yet by looking in %INC,
194 unless( $filename ) {
196 DIR: for my $dir ( @INC ) {
201 ### @INC hook -- we invoke it and get the filehandle back
202 ### this is actually documented behaviour as of 5.8 ;)
204 if (UNIVERSAL::isa($dir, 'CODE')) {
205 ($fh) = $dir->($dir, $file);
207 } elsif (UNIVERSAL::isa($dir, 'ARRAY')) {
208 ($fh) = $dir->[0]->($dir, $file, @{$dir}{1..$#{$dir}})
210 } elsif (UNIVERSAL::can($dir, 'INC')) {
211 ($fh) = $dir->INC->($dir, $file);
214 if (!UNIVERSAL::isa($fh, 'GLOB')) {
215 warn loc(q[Cannot open file '%1': %2], $file, $!)
220 $filename = $INC{$file_inc} || $file;
223 $filename = File::Spec->catfile($dir, $file);
224 next unless -e $filename;
226 $fh = new FileHandle;
227 if (!$fh->open($filename)) {
228 warn loc(q[Cannot open file '%1': %2], $file, $!)
234 ### store the directory we found the file in
237 ### files need to be in unix format under vms,
238 ### or they might be loaded twice
239 $href->{file} = ON_VMS
240 ? VMS::Filespec::unixify( $filename )
243 ### user wants us to find the version from files
244 if( $FIND_VERSION ) {
247 while ( my $line = <$fh> ) {
249 ### stolen from EU::MM_Unix->parse_version to address
250 ### #24062: "Problem with CPANPLUS 0.076 misidentifying
251 ### versions after installing Text::NSP 1.03" where a
252 ### VERSION mentioned in the POD was found before
253 ### the real $VERSION declaration.
254 $in_pod = $line =~ /^=(?!cut)/ ? 1 :
255 $line =~ /^=cut/ ? 0 :
259 ### try to find a version declaration in this string.
260 my $ver = __PACKAGE__->_parse_version( $line );
263 $href->{version} = $ver;
272 ### if we couldn't find the file, return undef ###
273 return unless defined $href->{file};
275 ### only complain if we're expected to find a version higher than 0.0 anyway
276 if( $FIND_VERSION and not defined $href->{version} ) {
277 { ### don't warn about the 'not numeric' stuff ###
280 ### if we got here, we didn't find the version
281 warn loc(q[Could not check version on '%1'], $args->{module} )
282 if $args->{verbose} and $args->{version} > 0;
284 $href->{uptodate} = 1;
287 ### don't warn about the 'not numeric' stuff ###
290 ### use qv(), as it will deal with developer release number
291 ### ie ones containing _ as well. This addresses bug report
292 ### #29348: Version compare logic doesn't handle alphas?
294 ### Update from JPeacock: apparently qv() and version->new
295 ### are different things, and we *must* use version->new
296 ### here, or things like #30056 might start happening
298 version->new( $args->{version} ) <= version->new( $href->{version} )
308 my $str = shift or return;
309 my $verbose = shift or 0;
311 ### skip commented out lines, they won't eval to anything.
312 return if $str =~ /^\s*#/;
314 ### the following regexp & eval statement comes from the
315 ### ExtUtils::MakeMaker source (EU::MM_Unix->parse_version)
316 ### Following #18892, which tells us the original
317 ### regex breaks under -T, we must modifiy it so
318 ### it captures the entire expression, and eval /that/
319 ### rather than $_, which is insecure.
320 my $taint_safe_str = do { $str =~ /(^.*$)/sm; $1 };
322 if( $str =~ /(?<!\\)([\$*])(([\w\:\']*)\bVERSION)\b.*\=/ ) {
324 print "Evaluating: $str\n" if $verbose;
326 ### this creates a string to be eval'd, like:
327 # package Module::Load::Conditional::_version;
331 # $VERSION=undef; do {
332 # use version; $VERSION = qv('0.0.3');
336 package Module::Load::Conditional::_version;
345 print "Evaltext: $eval\n" if $verbose;
353 my $rv = defined $result ? $result : '0.0';
355 print( $@ ? "Error: $@\n" : "Result: $rv\n" ) if $verbose;
360 ### unable to find a version in this string
364 =head2 $bool = can_load( modules => { NAME => VERSION [,NAME => VERSION] }, [verbose => BOOL, nocache => BOOL] )
366 C<can_load> will take a list of modules, optionally with version
367 numbers and determine if it is able to load them. If it can load *ALL*
368 of them, it will. If one or more are unloadable, none will be loaded.
370 This is particularly useful if you have More Than One Way (tm) to
371 solve a problem in a program, and only wish to continue down a path
372 if all modules could be loaded, and not load them if they couldn't.
374 This function uses the C<load> function from Module::Load under the
377 C<can_load> takes the following arguments:
383 This is a hashref of module/version pairs. The version indicates the
384 minimum version to load. If no version is provided, any version is
385 assumed to be good enough.
389 This controls whether warnings should be printed if a module failed
391 The default is to use the value of $Module::Load::Conditional::VERBOSE.
395 C<can_load> keeps its results in a cache, so it will not load the
396 same module twice, nor will it attempt to load a module that has
397 already failed to load before. By default, C<can_load> will check its
398 cache, but you can override that by setting C<nocache> to true.
406 modules => { default => {}, strict_type => 1 },
407 verbose => { default => $VERBOSE },
408 nocache => { default => 0 },
413 unless( $args = check( $tmpl, \%hash, $VERBOSE ) ) {
414 $ERROR = loc(q[Problem validating arguments!]);
415 warn $ERROR if $VERBOSE;
419 ### layout of $CACHE:
424 ### file => /path/to/file,
428 $CACHE ||= {}; # in case it was undef'd
432 my $href = $args->{modules};
435 for my $mod ( keys %$href ) {
437 next if $CACHE->{$mod}->{usable} && !$args->{nocache};
439 ### else, check if the hash key is defined already,
440 ### meaning $mod => 0,
441 ### indicating UNSUCCESSFUL prior attempt of usage
443 ### use qv(), as it will deal with developer release number
444 ### ie ones containing _ as well. This addresses bug report
445 ### #29348: Version compare logic doesn't handle alphas?
447 ### Update from JPeacock: apparently qv() and version->new
448 ### are different things, and we *must* use version->new
449 ### here, or things like #30056 might start happening
450 if ( !$args->{nocache}
451 && defined $CACHE->{$mod}->{usable}
452 && (version->new( $CACHE->{$mod}->{version}||0 )
453 >= version->new( $href->{$mod} ) )
455 $error = loc( q[Already tried to use '%1', which was unsuccessful], $mod);
459 my $mod_data = check_install(
461 version => $href->{$mod}
464 if( !$mod_data or !defined $mod_data->{file} ) {
465 $error = loc(q[Could not find or check module '%1'], $mod);
466 $CACHE->{$mod}->{usable} = 0;
471 $CACHE->{$mod}->{$_} = $mod_data->{$_}
472 } qw[version file uptodate];
477 for my $mod ( @load ) {
479 if ( $CACHE->{$mod}->{uptodate} ) {
483 ### in case anything goes wrong, log the error, the fact
484 ### we tried to use this module and return 0;
487 $CACHE->{$mod}->{usable} = 0;
490 $CACHE->{$mod}->{usable} = 1;
493 ### module not found in @INC, store the result in
494 ### $CACHE and return 0
497 $error = loc(q[Module '%1' is not uptodate!], $mod);
498 $CACHE->{$mod}->{usable} = 0;
505 if( defined $error ) {
507 Carp::carp( loc(q|%1 [THIS MAY BE A PROBLEM!]|,$error) ) if $args->{verbose};
516 =head2 @list = requires( MODULE );
518 C<requires> can tell you what other modules a particular module
519 requires. This is particularly useful when you're intending to write
520 a module for public release and are listing its prerequisites.
522 C<requires> takes but one argument: the name of a module.
523 It will then first check if it can actually load this module, and
524 return undef if it can't.
525 Otherwise, it will return a list of modules and pragmas that would
526 have been loaded on the module's behalf.
528 Note: The list C<require> returns has originated from your current
529 perl and your current install.
536 unless( check_install( module => $who ) ) {
537 warn loc(q[You do not have module '%1' installed], $who) if $VERBOSE;
541 my $lib = join " ", map { qq["-I$_"] } @INC;
542 my $cmd = qq[$^X $lib -M$who -e"print(join(qq[\\n],keys(%INC)))"];
546 map { chomp; s|/|::|g; $_ }
555 =head1 Global Variables
557 The behaviour of Module::Load::Conditional can be altered by changing the
558 following global variables:
560 =head2 $Module::Load::Conditional::VERBOSE
562 This controls whether Module::Load::Conditional will issue warnings and
563 explanations as to why certain things may have failed. If you set it
564 to 0, Module::Load::Conditional will not output any warnings.
567 =head2 $Module::Load::Conditional::FIND_VERSION
569 This controls whether Module::Load::Conditional will try to parse
570 (and eval) the version from the module you're trying to load.
572 If you don't wish to do this, set this variable to C<false>. Understand
573 then that version comparisons are not possible, and Module::Load::Conditional
574 can not tell you what module version you have installed.
575 This may be desirable from a security or performance point of view.
576 Note that C<$FIND_VERSION> code runs safely under C<taint mode>.
580 =head2 $Module::Load::Conditional::CHECK_INC_HASH
582 This controls whether C<Module::Load::Conditional> checks your
583 C<%INC> hash to see if a module is available. By default, only
584 C<@INC> is scanned to see if a module is physically on your
585 filesystem, or avialable via an C<@INC-hook>. Setting this variable
586 to C<true> will trust any entries in C<%INC> and return them for
591 =head2 $Module::Load::Conditional::CACHE
593 This holds the cache of the C<can_load> function. If you explicitly
594 want to remove the current cache, you can set this variable to
597 =head2 $Module::Load::Conditional::ERROR
599 This holds a string of the last error that happened during a call to
600 C<can_load>. It is useful to inspect this when C<can_load> returns
609 Please report bugs or other issues to E<lt>bug-module-load-conditional@rt.cpan.orgE<gt>.
613 This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.
617 This library is free software; you may redistribute and/or modify it
618 under the same terms as Perl itself.