1package Module::Load::Conditional; 2 3use strict; 4 5use Module::Load qw/load autoload_remote/; 6use Params::Check qw[check]; 7use Locale::Maketext::Simple Style => 'gettext'; 8 9use Carp (); 10use File::Spec (); 11use FileHandle (); 12use version; 13 14use Module::Metadata (); 15 16use constant ON_VMS => $^O eq 'VMS'; 17use constant ON_WIN32 => $^O eq 'MSWin32' ? 1 : 0; 18use constant QUOTE => do { ON_WIN32 ? q["] : q['] }; 19 20BEGIN { 21 use vars qw[ $VERSION @ISA $VERBOSE $CACHE @EXPORT_OK $DEPRECATED 22 $FIND_VERSION $ERROR $CHECK_INC_HASH $FORCE_SAFE_INC ]; 23 use Exporter; 24 @ISA = qw[Exporter]; 25 $VERSION = '0.70'; 26 $VERBOSE = 0; 27 $DEPRECATED = 0; 28 $FIND_VERSION = 1; 29 $CHECK_INC_HASH = 0; 30 $FORCE_SAFE_INC = 0; 31 @EXPORT_OK = qw[check_install can_load requires]; 32} 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 ) { 196 no strict 'refs'; 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 = new FileHandle; 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 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 and $Config::Config{privlibexp} ne $Config::Config{sitelibexp}; 328 } 329 330 return $href; 331} 332 333=head2 $bool = can_load( modules => { NAME => VERSION [,NAME => VERSION] }, [verbose => BOOL, nocache => BOOL, autoload => BOOL] ) 334 335C<can_load> will take a list of modules, optionally with version 336numbers and determine if it is able to load them. If it can load *ALL* 337of them, it will. If one or more are unloadable, none will be loaded. 338 339This is particularly useful if you have More Than One Way (tm) to 340solve a problem in a program, and only wish to continue down a path 341if all modules could be loaded, and not load them if they couldn't. 342 343This function uses the C<load> function or the C<autoload_remote> function 344from Module::Load under the hood. 345 346C<can_load> takes the following arguments: 347 348=over 4 349 350=item modules 351 352This is a hashref of module/version pairs. The version indicates the 353minimum version to load. If no version is provided, any version is 354assumed to be good enough. 355 356=item verbose 357 358This controls whether warnings should be printed if a module failed 359to load. 360The default is to use the value of $Module::Load::Conditional::VERBOSE. 361 362=item nocache 363 364C<can_load> keeps its results in a cache, so it will not load the 365same module twice, nor will it attempt to load a module that has 366already failed to load before. By default, C<can_load> will check its 367cache, but you can override that by setting C<nocache> to true. 368 369=item autoload 370 371This controls whether imports the functions of a loaded modules to the caller package. The default is no importing any functions. 372 373See the C<autoload> function and the C<autoload_remote> function from L<Module::Load> for details. 374 375=cut 376 377sub can_load { 378 my %hash = @_; 379 380 my $tmpl = { 381 modules => { default => {}, strict_type => 1 }, 382 verbose => { default => $VERBOSE }, 383 nocache => { default => 0 }, 384 autoload => { default => 0 }, 385 }; 386 387 my $args; 388 389 unless( $args = check( $tmpl, \%hash, $VERBOSE ) ) { 390 $ERROR = loc(q[Problem validating arguments!]); 391 warn $ERROR if $VERBOSE; 392 return; 393 } 394 395 ### layout of $CACHE: 396 ### $CACHE = { 397 ### $ module => { 398 ### usable => BOOL, 399 ### version => \d, 400 ### file => /path/to/file, 401 ### }, 402 ### }; 403 404 $CACHE ||= {}; # in case it was undef'd 405 406 my $error; 407 BLOCK: { 408 my $href = $args->{modules}; 409 410 my @load; 411 for my $mod ( keys %$href ) { 412 413 next if $CACHE->{$mod}->{usable} && !$args->{nocache}; 414 415 ### else, check if the hash key is defined already, 416 ### meaning $mod => 0, 417 ### indicating UNSUCCESSFUL prior attempt of usage 418 419 ### use qv(), as it will deal with developer release number 420 ### ie ones containing _ as well. This addresses bug report 421 ### #29348: Version compare logic doesn't handle alphas? 422 ### 423 ### Update from JPeacock: apparently qv() and version->new 424 ### are different things, and we *must* use version->new 425 ### here, or things like #30056 might start happening 426 if ( !$args->{nocache} 427 && defined $CACHE->{$mod}->{usable} 428 && (version->new( $CACHE->{$mod}->{version}||0 ) 429 >= version->new( $href->{$mod} ) ) 430 ) { 431 $error = loc( q[Already tried to use '%1', which was unsuccessful], $mod); 432 last BLOCK; 433 } 434 435 my $mod_data = check_install( 436 module => $mod, 437 version => $href->{$mod} 438 ); 439 440 if( !$mod_data or !defined $mod_data->{file} ) { 441 $error = loc(q[Could not find or check module '%1'], $mod); 442 $CACHE->{$mod}->{usable} = 0; 443 last BLOCK; 444 } 445 446 map { 447 $CACHE->{$mod}->{$_} = $mod_data->{$_} 448 } qw[version file uptodate]; 449 450 push @load, $mod; 451 } 452 453 for my $mod ( @load ) { 454 455 if ( $CACHE->{$mod}->{uptodate} ) { 456 457 local @INC = @INC[0..$#INC-1] if $FORCE_SAFE_INC && $INC[-1] eq '.'; 458 459 if ( $args->{autoload} ) { 460 my $who = (caller())[0]; 461 eval { autoload_remote $who, $mod }; 462 } else { 463 eval { load $mod }; 464 } 465 466 ### in case anything goes wrong, log the error, the fact 467 ### we tried to use this module and return 0; 468 if( $@ ) { 469 $error = $@; 470 $CACHE->{$mod}->{usable} = 0; 471 last BLOCK; 472 } else { 473 $CACHE->{$mod}->{usable} = 1; 474 } 475 476 ### module not found in @INC, store the result in 477 ### $CACHE and return 0 478 } else { 479 480 $error = loc(q[Module '%1' is not uptodate!], $mod); 481 $CACHE->{$mod}->{usable} = 0; 482 last BLOCK; 483 } 484 } 485 486 } # BLOCK 487 488 if( defined $error ) { 489 $ERROR = $error; 490 Carp::carp( loc(q|%1 [THIS MAY BE A PROBLEM!]|,$error) ) if $args->{verbose}; 491 return; 492 } else { 493 return 1; 494 } 495} 496 497=back 498 499=head2 @list = requires( MODULE ); 500 501C<requires> can tell you what other modules a particular module 502requires. This is particularly useful when you're intending to write 503a module for public release and are listing its prerequisites. 504 505C<requires> takes but one argument: the name of a module. 506It will then first check if it can actually load this module, and 507return undef if it can't. 508Otherwise, it will return a list of modules and pragmas that would 509have been loaded on the module's behalf. 510 511Note: The list C<require> returns has originated from your current 512perl and your current install. 513 514=cut 515 516sub requires { 517 my $who = shift; 518 519 unless( check_install( module => $who ) ) { 520 warn loc(q[You do not have module '%1' installed], $who) if $VERBOSE; 521 return undef; 522 } 523 524 local @INC = @INC[0..$#INC-1] if $FORCE_SAFE_INC && $INC[-1] eq '.'; 525 526 my $lib = join " ", map { qq["-I$_"] } @INC; 527 my $oneliner = 'print(join(qq[\n],map{qq[BONG=$_]}keys(%INC)),qq[\n])'; 528 my $cmd = join '', qq["$^X" $lib -M$who -e], QUOTE, $oneliner, QUOTE; 529 530 return sort 531 grep { !/^$who$/ } 532 map { chomp; s|/|::|g; $_ } 533 grep { s|\.pm$||i; } 534 map { s!^BONG\=!!; $_ } 535 grep { m!^BONG\=! } 536 `$cmd`; 537} 538 5391; 540 541__END__ 542 543=head1 Global Variables 544 545The behaviour of Module::Load::Conditional can be altered by changing the 546following global variables: 547 548=head2 $Module::Load::Conditional::VERBOSE 549 550This controls whether Module::Load::Conditional will issue warnings and 551explanations as to why certain things may have failed. If you set it 552to 0, Module::Load::Conditional will not output any warnings. 553The default is 0; 554 555=head2 $Module::Load::Conditional::FIND_VERSION 556 557This controls whether Module::Load::Conditional will try to parse 558(and eval) the version from the module you're trying to load. 559 560If you don't wish to do this, set this variable to C<false>. Understand 561then that version comparisons are not possible, and Module::Load::Conditional 562can not tell you what module version you have installed. 563This may be desirable from a security or performance point of view. 564Note that C<$FIND_VERSION> code runs safely under C<taint mode>. 565 566The default is 1; 567 568=head2 $Module::Load::Conditional::CHECK_INC_HASH 569 570This controls whether C<Module::Load::Conditional> checks your 571C<%INC> hash to see if a module is available. By default, only 572C<@INC> is scanned to see if a module is physically on your 573filesystem, or available via an C<@INC-hook>. Setting this variable 574to C<true> will trust any entries in C<%INC> and return them for 575you. 576 577The default is 0; 578 579=head2 $Module::Load::Conditional::FORCE_SAFE_INC 580 581This controls whether C<Module::Load::Conditional> sanitises C<@INC> 582by removing "C<.>". The current default setting is C<0>, but this 583may change in a future release. 584 585=head2 $Module::Load::Conditional::CACHE 586 587This holds the cache of the C<can_load> function. If you explicitly 588want to remove the current cache, you can set this variable to 589C<undef> 590 591=head2 $Module::Load::Conditional::ERROR 592 593This holds a string of the last error that happened during a call to 594C<can_load>. It is useful to inspect this when C<can_load> returns 595C<undef>. 596 597=head2 $Module::Load::Conditional::DEPRECATED 598 599This controls whether C<Module::Load::Conditional> checks if 600a dual-life core module has been deprecated. If this is set to 601true C<check_install> will return false to C<uptodate>, if 602a dual-life module is found to be loaded from C<$Config{privlibexp}> 603 604The default is 0; 605 606=head1 See Also 607 608C<Module::Load> 609 610=head1 BUG REPORTS 611 612Please report bugs or other issues to E<lt>bug-module-load-conditional@rt.cpan.orgE<gt>. 613 614=head1 AUTHOR 615 616This module by Jos Boumans E<lt>kane@cpan.orgE<gt>. 617 618=head1 COPYRIGHT 619 620This library is free software; you may redistribute and/or modify it 621under the same terms as Perl itself. 622 623=cut 624