vcs.maemo.org Git - pkg-perl/blob - deb-src/libalien-wxwidgets-perl/libalien-wxwidgets-perl-0.50/inc/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 use version     qw[qv];
  13
  14 BEGIN {
  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
  30 Module::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
  76 Module::Load::Conditional provides simple ways to query and possibly load any of
  77 the modules you have installed on your system during runtime.
  78
  79 It is able to load multiple modules at once or none at all if one of
  80 them was not able to load. It also takes care of any error checking
  81 and so forth.
  82
  83 =head1 Methods
  84
  85 =head1 $href = check_install( module => NAME [, version => VERSION, verbose => BOOL ] );
  86
  87 C<check_install> allows you to verify if a certain module is installed
  88 or not. You may call it with the following arguments:
  89
  90 =over 4
  91
  92 =item module
  93
  94 The name of the module you wish to verify -- this is a required key
  95
  96 =item version
  97
  98 The version this module needs to be -- this is optional
  99
 100 =item verbose
 101
 102 Whether or not to be verbose about what it is doing -- it will default
 103 to $Module::Load::Conditional::VERBOSE
 104
 105 =back
 106
 107 It will return undef if it was not able to find where the module was
 108 installed, or a hash reference with the following keys if it was able
 109 to find the file:
 110
 111 =over 4
 112
 113 =item file
 114
 115 Full path to the file that contains the module
 116
 117 =item version
 118
 119 The version number of the installed module - this will be C<undef> if
 120 the module had no (or unparsable) version number, or if the variable
 121 C<$Module::Load::Conditional::FIND_VERSION> was set to true.
 122 (See the C<GLOBAL VARIABLES> section below for details)
 123
 124 =item uptodate
 125
 126 A boolean value indicating whether or not the module was found to be
 127 at least the version you specified. If you did not specify a version,
 128 uptodate will always be true if the module was found.
 129 If no parsable version was found in the module, uptodate will also be
 130 true, 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.
 144 sub 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
 279 sub _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
 338 C<can_load> will take a list of modules, optionally with version
 339 numbers and determine if it is able to load them. If it can load *ALL*
 340 of them, it will. If one or more are unloadable, none will be loaded.
 341
 342 This is particularly useful if you have More Than One Way (tm) to
 343 solve a problem in a program, and only wish to continue down a path
 344 if all modules could be loaded, and not load them if they couldn't.
 345
 346 This function uses the C<load> function from Module::Load under the
 347 hood.
 348
 349 C<can_load> takes the following arguments:
 350
 351 =over 4
 352
 353 =item modules
 354
 355 This is a hashref of module/version pairs. The version indicates the
 356 minimum version to load. If no version is provided, any version is
 357 assumed to be good enough.
 358
 359 =item verbose
 360
 361 This controls whether warnings should be printed if a module failed
 362 to load.
 363 The default is to use the value of $Module::Load::Conditional::VERBOSE.
 364
 365 =item nocache
 366
 367 C<can_load> keeps its results in a cache, so it will not load the
 368 same module twice, nor will it attempt to load a module that has
 369 already failed to load before. By default, C<can_load> will check its
 370 cache, but you can override that by setting C<nocache> to true.
 371
 372 =cut
 373
 374 sub 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
 479 C<requires> can tell you what other modules a particular module
 480 requires. This is particularly useful when you're intending to write
 481 a module for public release and are listing its prerequisites.
 482
 483 C<requires> takes but one argument: the name of a module.
 484 It will then first check if it can actually load this module, and
 485 return undef if it can't.
 486 Otherwise, it will return a list of modules and pragmas that would
 487 have been loaded on the module's behalf.
 488
 489 Note: The list C<require> returns has originated from your current
 490 perl and your current install.
 491
 492 =cut
 493
 494 sub 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
 512 1;
 513
 514 __END__
 515
 516 =head1 Global Variables
 517
 518 The behaviour of Module::Load::Conditional can be altered by changing the
 519 following global variables:
 520
 521 =head2 $Module::Load::Conditional::VERBOSE
 522
 523 This controls whether Module::Load::Conditional will issue warnings and
 524 explanations as to why certain things may have failed. If you set it
 525 to 0, Module::Load::Conditional will not output any warnings.
 526 The default is 0;
 527
 528 =head2 $Module::Load::Conditional::FIND_VERSION
 529
 530 This controls whether Module::Load::Conditional will try to parse
 531 (and eval) the version from the module you're trying to load.
 532
 533 If you don't wish to do this, set this variable to C<false>. Understand
 534 then that version comparisons are not possible, and Module::Load::Conditional
 535 can not tell you what module version you have installed.
 536 This may be desirable from a security or performance point of view.
 537 Note that C<$FIND_VERSION> code runs safely under C<taint mode>.
 538
 539 The default is 1;
 540
 541 =head2 $Module::Load::Conditional::CHECK_INC_HASH
 542
 543 This controls whether C<Module::Load::Conditional> checks your
 544 C<%INC> hash to see if a module is available. By default, only
 545 C<@INC> is scanned to see if a module is physically on your
 546 filesystem, or avialable via an C<@INC-hook>. Setting this variable
 547 to C<true> will trust any entries in C<%INC> and return them for
 548 you.
 549
 550 The default is 0;
 551
 552 =head2 $Module::Load::Conditional::CACHE
 553
 554 This holds the cache of the C<can_load> function. If you explicitly
 555 want to remove the current cache, you can set this variable to
 556 C<undef>
 557
 558 =head2 $Module::Load::Conditional::ERROR
 559
 560 This holds a string of the last error that happened during a call to
 561 C<can_load>. It is useful to inspect this when C<can_load> returns
 562 C<undef>.
 563
 564 =head1 See Also
 565
 566 C<Module::Load>
 567
 568 =head1 AUTHOR
 569
 570 This module by
 571 Jos Boumans E<lt>kane@cpan.orgE<gt>.
 572
 573 =head1 COPYRIGHT
 574
 575 This module is copyright (c) 2002-2007 Jos Boumans
 576 E<lt>kane@cpan.orgE<gt>. All rights reserved.
 577
 578 This library is free software; you may redistribute and/or modify
 579 it under the same terms as Perl itself.