[Summary view] [Print] [Text view]

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