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