#line 1 "inc/Module/Load/Conditional.pm - /Users/kane/sources/p4/other/module-load-conditional/lib/Module/Load/Conditional.pm" package Module::Load::Conditional; use strict; use Module::Load; use Params::Check qw[check]; use Locale::Maketext::Simple Style => 'gettext'; use Carp (); use File::Spec (); use FileHandle (); BEGIN { use vars qw[$VERSION @ISA $VERBOSE $CACHE @EXPORT_OK $ERROR]; use Exporter; @ISA = qw[Exporter]; $VERSION = 0.05; $VERBOSE = 0; @EXPORT_OK = qw[check_install can_load requires]; } #line 127 ### this checks if a certain module is installed already ### ### if it returns true, the module in question is already installed ### or we found the file, but couldn't open it, OR there was no version ### to be found in the module ### it will return 0 if the version in the module is LOWER then the one ### we are looking for, or if we couldn't find the desired module to begin with ### if the installed version is higher or equal to the one we want, it will return ### a hashref with he module name and version in it.. so 'true' as well. sub check_install { my %hash = @_; my $tmpl = { version => { default => '0.0' }, module => { required => 1 }, verbose => { default => $VERBOSE }, }; my $args; unless( $args = check( $tmpl, \%hash, $VERBOSE ) ) { warn loc( q[A problem occurred checking arguments] ) if $VERBOSE; return; } my $file = File::Spec->catfile( split /::/, $args->{module} ) . '.pm'; ### where we store the return value ### my $href = { file => undef, version => undef, uptodate => undef, }; DIR: for my $dir ( @INC ) { my( $fh, $filename ); if ( ref $dir ) { ### @INC hook -- we invoke it and get the filehandle back ### this is actually documented behaviour as of 5.8 ;) if (UNIVERSAL::isa($dir, 'CODE')) { ($fh) = $dir->($dir, $file); } elsif (UNIVERSAL::isa($dir, 'ARRAY')) { ($fh) = $dir->[0]->($dir, $file, @{$dir}{1..$#{$dir}}) } elsif (UNIVERSAL::can($dir, 'INC')) { ($fh) = $dir->INC->($dir, $file); } if (!UNIVERSAL::isa($fh, 'GLOB')) { warn loc(q[Can not open file '%1': %2], $file, $!) if $args->{verbose}; next; } $filename = $INC{$file} || $file; } else { $filename = File::Spec->catfile($dir, $file); next unless -e $filename; $fh = new FileHandle; if (!$fh->open($filename)) { warn loc(q[Can not open file '%1': %2], $file, $!) if $args->{verbose}; next; } } $href->{file} = $filename; while (local $_ = <$fh> ) { ### the following regexp comes from the ExtUtils::MakeMaker ### documentation. if ( /([\$*])(([\w\:\']*)\bVERSION)\b.*\=/ ) { ### this will eval the version in to $VERSION if it ### was declared as $VERSION in the module. ### else the result will be in $res. ### this is a fix on skud's Module::InstalledVersion local $VERSION; my $res = eval $_; ### default to '0.0' if there REALLY is no version ### all to satisfy warnings $href->{version} = $VERSION || $res || '0.0'; last DIR; } } } ### if we couldn't find the file, return undef ### return unless defined $href->{file}; ### only complain if we expected fo find a version higher than 0.0 anyway if( !defined $href->{version} ) { { ### don't warn about the 'not numeric' stuff ### local $^W; ### if we got here, we didn't find the version warn loc(q[Could not check version on '%1'], $args->{module} ) if $args->{verbose} and $args->{version} > 0; } $href->{uptodate} = 1; } else { ### don't warn about the 'not numeric' stuff ### local $^W; $href->{uptodate} = $args->{version} <= $href->{version} ? 1 : 0; } return $href; } #line 284 sub can_load { my %hash = @_; my $tmpl = { modules => { default => {}, strict_type => 1 }, verbose => { default => $VERBOSE }, nocache => { default => 0 }, }; my $args; unless( $args = check( $tmpl, \%hash, $VERBOSE ) ) { $ERROR = loc(q[Problem validating arguments!]); warn $ERROR if $VERBOSE; return; } ### layout of $CACHE: ### $CACHE = { ### $ module => { ### usable => BOOL, ### version => \d, ### file => /path/to/file, ### }, ### }; $CACHE ||= {}; # in case it was undef'd my $error; BLOCK: { my $href = $args->{modules}; my @load; for my $mod ( keys %$href ) { next if $CACHE->{$mod}->{usable} && !$args->{nocache}; ### else, check if the hash key is defined already, ### meaning $mod => 0, ### indicating UNSUCCESSFUL prior attempt of usage if ( !$args->{nocache} && defined $CACHE->{$mod}->{usable} && (($CACHE->{$mod}->{version}||0) >= $href->{$mod}) ) { $error = loc( q[Already tried to use '%1', which was unsuccesful], $mod); last BLOCK; } my $mod_data = check_install( module => $mod, version => $href->{$mod} ); if( !$mod_data or !defined $mod_data->{file} ) { $error = loc(q[Could not find or check module '%1'], $mod); $CACHE->{$mod}->{usable} = 0; last BLOCK; } map { $CACHE->{$mod}->{$_} = $mod_data->{$_} } qw[version file uptodate]; push @load, $mod; } for my $mod ( @load ) { if ( $CACHE->{$mod}->{uptodate} ) { eval { load $mod }; ### in case anything goes wrong, log the error, the fact ### we tried to use this module and return 0; if( $@ ) { $error = $@; $CACHE->{$mod}->{usable} = 0; last BLOCK; } else { $CACHE->{$mod}->{usable} = 1; } ### module not found in @INC, store the result in ### $CACHE and return 0 } else { $error = loc(q[Module '%1' is not uptodate!], $mod); $CACHE->{$mod}->{usable} = 0; last BLOCK; } } } # BLOCK if( defined $error ) { $ERROR = $error; Carp::carp( loc(q|%1 [THIS MAY BE A PROBLEM!]|,$error) ) if $args->{verbose}; return undef; } else { return 1; } } #line 404 sub requires { my $who = shift; unless( check_install( module => $who ) ) { warn loc(q[You do not have module '%1' installed], $who) if $VERBOSE; return undef; } my $lib = join " ", map { "-I$_" } @INC; my $cmd = qq[$^X $lib -M$who -e"print(join(qq[\\n],keys(%INC)))"]; return sort grep { !/^$who$/ } map { chomp; s|/|::|g; $_ } grep { s|\.pm$||i; } `$cmd`; } 1; __END__ =head1 Global Variables The behaviour of Module::Load::Conditional can be altered by changing the following global variables: =head2 $Module::Load::Conditional::VERBOSE This controls whether Module::Load::Conditional will issue warnings and explenations as to why certain things may have failed. If you set it to 0, Module::Load::Conditional will not output any warnings. The default is 0; =head2 $Module::Load::Conditional::CACHE This holds the cache of the C function. If you explicitly want to remove the current cache, you can set this variable to C =head2 $Module::Load::Conditional::ERROR This holds a string of the last error that happened during a call to C. It is useful to inspect this when C returns C. =head1 See Also C =head1 AUTHOR This module by Jos Boumans Ekane@cpan.orgE. =head1 COPYRIGHT This module is copyright (c) 2002 Jos Boumans Ekane@cpan.orgE. All rights reserved. This library is free software; you may redistribute and/or modify it under the same terms as Perl itself.