lib/Module/Load/Conditional.pm

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