From: Jos I. Boumans Date: Fri, 24 Nov 2006 18:07:54 +0000 (+0100) Subject: Add Module::Load::Conditional to the core X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0dc418cbde48cb38a38731db29a06b0f700688d6;p=p5sagit%2Fp5-mst-13.2.git Add Module::Load::Conditional to the core From: "Jos Boumans" Message-ID: <23336.80.127.35.68.1164388074.squirrel@webmail.xs4all.nl> p4raw-id: //depot/perl@29379 --- diff --git a/MANIFEST b/MANIFEST index e535212..1195c21 100644 --- a/MANIFEST +++ b/MANIFEST @@ -978,10 +978,10 @@ ext/re/re_top.h re extension symbol hiding header ext/re/re.xs re extension external subroutines ext/re/t/lexical_debug.pl generate debug output for lexical re 'debug' ext/re/t/lexical_debug.t test that lexical re 'debug' works +ext/re/t/re_funcs.t see if exportable funcs from re.pm work ext/re/t/regop.pl generate debug output for various patterns ext/re/t/regop.t test RE optimizations by scraping debug output ext/re/t/re.t see if re pragma works -ext/re/t/re_funcs.t see if exportable funcs from re.pm work ext/Safe/t/safe1.t See if Safe works ext/Safe/t/safe2.t See if Safe works ext/Safe/t/safe3.t See if Safe works @@ -1380,8 +1380,8 @@ lib/Attribute/Handlers/demo/Descriptions.pm Attribute::Handlers demo lib/Attribute/Handlers/demo/MyClass.pm Attribute::Handlers demo lib/Attribute/Handlers.pm Attribute::Handlers lib/Attribute/Handlers/README Attribute::Handlers -lib/Attribute/Handlers/t/multi.t See if Attribute::Handlers works lib/Attribute/Handlers/t/linerep.t See if Attribute::Handlers works +lib/Attribute/Handlers/t/multi.t See if Attribute::Handlers works lib/attributes.pm For "sub foo : attrlist" lib/AutoLoader.pm Autoloader base class lib/AutoLoader.t See if AutoLoader works @@ -2001,6 +2001,13 @@ lib/Module/CoreList/bin/corelist Module::CoreList lib/Module/CoreList.pm Module::CoreList lib/Module/CoreList/t/corelist.t Module::CoreList lib/Module/CoreList/t/find_modules.t Module::CoreList +lib/Module/Load/Conditional.pm Module::Conditional +lib/Module/Load/Conditional/t/01_Module_Load_Conditional.t Module::Conditional tests +lib/Module/Load/Conditional/t/to_load/Commented.pm Module::Conditional tests +lib/Module/Load/Conditional/t/to_load/LoadIt.pm Module::Conditional tests +lib/Module/Load/Conditional/t/to_load/LoadMe.pl Module::Conditional tests +lib/Module/Load/Conditional/t/to_load/Must/Be/Loaded.pm Module::Conditional tests +lib/Module/Load/Conditional/t/to_load/ToBeLoaded Module::Conditional tests lib/Module/Loaded.pm Module::Loaded lib/Module/Loaded/t/01_Module-Loaded.t Module::Loaded tests lib/Module/Load.pm Module::Load @@ -2520,8 +2527,8 @@ lib/Text/TabsWrap/t/37000.t See if Text::Tabs is working lib/Text/TabsWrap/t/39548.t See if Text::Tabs is working lib/Text/TabsWrap/t/belg4mit.t See if Text::Tabs is working lib/Text/TabsWrap/t/fill.t See if Text::Wrap::fill works -lib/Text/TabsWrap/t/Jacobson.t See if Text::Tabs is working lib/Text/TabsWrap/t/Jacobson2.t See if Text::Tabs is working +lib/Text/TabsWrap/t/Jacobson.t See if Text::Tabs is working lib/Text/TabsWrap/t/Jochen.t See if Text::Tabs is working lib/Text/TabsWrap/t/sep2.t See if Text::Tabs is working lib/Text/TabsWrap/t/sep.t See if Text::Tabs is working diff --git a/lib/Module/Load/Conditional.pm b/lib/Module/Load/Conditional.pm new file mode 100644 index 0000000..510ae24 --- /dev/null +++ b/lib/Module/Load/Conditional.pm @@ -0,0 +1,531 @@ +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 + $FIND_VERSION $ERROR $CHECK_INC_HASH]; + use Exporter; + @ISA = qw[Exporter]; + $VERSION = '0.12'; + $VERBOSE = 0; + $FIND_VERSION = 1; + $CHECK_INC_HASH = 0; + @EXPORT_OK = qw[check_install can_load requires]; +} + +=pod + +=head1 NAME + +Module::Load::Conditional - Looking up module information / loading at runtime + +=head1 SYNOPSIS + + use Module::Load::Conditional qw[can_load check_install requires]; + + + my $use_list = { + CPANPLUS => 0.05, + LWP => 5.60, + 'Test::More' => undef, + }; + + print can_load( modules => $use_list ) + ? 'all modules loaded successfully' + : 'failed to load required modules'; + + + my $rv = check_install( module => 'LWP', version => 5.60 ) + or print 'LWP is not installed!'; + + print 'LWP up to date' if $rv->{uptodate}; + print "LWP version is $rv->{version}\n"; + print "LWP is installed as file $rv->{file}\n"; + + + print "LWP requires the following modules to be installed:\n"; + print join "\n", requires('LWP'); + + ### allow M::L::C to peek in your %INC rather than just + ### scanning @INC + $Module::Load::Conditional::CHECK_INC_HASH = 1; + + ### reset the 'can_load' cache + undef $Module::Load::Conditional::CACHE; + + ### don't have Module::Load::Conditional issue warnings -- + ### default is '1' + $Module::Load::Conditional::VERBOSE = 0; + + ### The last error that happened during a call to 'can_load' + my $err = $Module::Load::Conditional::ERROR; + + +=head1 DESCRIPTION + +Module::Load::Conditional provides simple ways to query and possibly load any of +the modules you have installed on your system during runtime. + +It is able to load multiple modules at once or none at all if one of +them was not able to load. It also takes care of any error checking +and so forth. + +=head1 Methods + +=head1 $href = check_install( module => NAME [, version => VERSION, verbose => BOOL ] ); + +C allows you to verify if a certain module is installed +or not. You may call it with the following arguments: + +=over 4 + +=item module + +The name of the module you wish to verify -- this is a required key + +=item version + +The version this module needs to be -- this is optional + +=item verbose + +Whether or not to be verbose about what it is doing -- it will default +to $Module::Load::Conditional::VERBOSE + +=back + +It will return undef if it was not able to find where the module was +installed, or a hash reference with the following keys if it was able +to find the file: + +=over 4 + +=item file + +Full path to the file that contains the module + +=item version + +The version number of the installed module - this will be C if +the module had no (or unparsable) version number, or if the variable +C<$Module::Load::Conditional::FIND_VERSION> was set to true. +(See the C section below for details) + +=item uptodate + +A boolean value indicating whether or not the module was found to be +at least the version you specified. If you did not specify a version, +uptodate will always be true if the module was found. +If no parsable version was found in the module, uptodate will also be +true, since C had no way to verify clearly. + +=back + +=cut + +### 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'; + my $file_inc = File::Spec::Unix->catfile( + split /::/, $args->{module} + ) . '.pm'; + + ### where we store the return value ### + my $href = { + file => undef, + version => undef, + uptodate => undef, + }; + + my $filename; + + ### check the inc hash if we're allowed to + if( $CHECK_INC_HASH ) { + $filename = $href->{'file'} = + $INC{ $file_inc } if defined $INC{ $file_inc }; + + ### find the version by inspecting the package + if( defined $filename && $FIND_VERSION ) { + no strict 'refs'; + $href->{version} = ${ "$args->{module}"."::VERSION" }; + } + } + + ### we didnt find the filename yet by looking in %INC, + ### so scan the dirs + unless( $filename ) { + + DIR: for my $dir ( @INC ) { + + my $fh; + + 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[Cannot open file '%1': %2], $file, $!) + if $args->{verbose}; + next; + } + + $filename = $INC{$file_inc} || $file; + + } else { + $filename = File::Spec->catfile($dir, $file); + next unless -e $filename; + + $fh = new FileHandle; + if (!$fh->open($filename)) { + warn loc(q[Cannot open file '%1': %2], $file, $!) + if $args->{verbose}; + next; + } + } + + $href->{file} = $filename; + + ### user wants us to find the version from files + if( $FIND_VERSION ) { + + while (local $_ = <$fh> ) { + + ### skip commented out lines, they won't eval to anything. + next if /^\s*#/; + + ### the following regexp comes from the ExtUtils::MakeMaker + ### documentation. + ### Following #18892, which tells us the original + ### regex breaks under -T, we must modifiy it so + ### it captures the entire expression, and eval /that/ + ### rather than $_, which is insecure. + 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 $1; + + ### 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( $FIND_VERSION and not 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; +} + +=head2 $bool = can_load( modules => { NAME => VERSION [,NAME => VERSION] }, [verbose => BOOL, nocache => BOOL] ) + +C will take a list of modules, optionally with version +numbers and determine if it is able to load them. If it can load *ALL* +of them, it will. If one or more are unloadable, none will be loaded. + +This is particularly useful if you have More Than One Way (tm) to +solve a problem in a program, and only wish to continue down a path +if all modules could be loaded, and not load them if they couldn't. + +This function uses the C function from Module::Load under the +hood. + +C takes the following arguments: + +=over 4 + +=item modules + +This is a hashref of module/version pairs. The version indicates the +minimum version to load. If no version is provided, any version is +assumed to be good enough. + +=item verbose + +This controls whether warnings should be printed if a module failed +to load. +The default is to use the value of $Module::Load::Conditional::VERBOSE. + +=item nocache + +C keeps its results in a cache, so it will not load the +same module twice, nor will it attempt to load a module that has +already failed to load before. By default, C will check its +cache, but you can override that by setting C to true. + +=cut + +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 unsuccessful], $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; + } +} + +=head2 @list = requires( MODULE ); + +C can tell you what other modules a particular module +requires. This is particularly useful when you're intending to write +a module for public release and are listing its prerequisites. + +C takes but one argument: the name of a module. +It will then first check if it can actually load this module, and +return undef if it can't. +Otherwise, it will return a list of modules and pragmas that would +have been loaded on the module's behalf. + +Note: The list C returns has originated from your current +perl and your current install. + +=cut + +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 { qq["-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 +explanations 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::FIND_VERSION + +This controls whether Module::Load::Conditional will try to parse +(and eval) the version from the module you're trying to load. + +If you don't wish to do this, set this variable to C. Understand +then that version comparisons are not possible, and Module::Load::Conditional +can not tell you what module version you have installed. +This may be desirable from a security or performance point of view. +Note that C<$FIND_VERSION> code runs safely under C. + +The default is 1; + +=head2 $Module::Load::Conditional::CHECK_INC_HASH + +This controls whether C checks your +C<%INC> hash to see if a module is available. By default, only +C<@INC> is scanned to see if a module is physically on your +filesystem, or avialable via an C<@INC-hook>. Setting this variable +to C will trust any entries in C<%INC> and return them for +you. + +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. diff --git a/lib/Module/Load/Conditional/t/01_Module_Load_Conditional.t b/lib/Module/Load/Conditional/t/01_Module_Load_Conditional.t new file mode 100644 index 0000000..6ba26f2 --- /dev/null +++ b/lib/Module/Load/Conditional/t/01_Module_Load_Conditional.t @@ -0,0 +1,159 @@ +### Module::Load::Conditional test suite ### +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir '../lib/Module/Load/Conditional' + if -d '../lib/Module/Load/Conditional'; + unshift @INC, '../../../..'; + + ### fix perl location too + $^X = '../../../../../t/' . $^X; + } +} + +BEGIN { chdir 't' if -d 't' } + +use strict; +use lib qw[../lib to_load]; +use File::Spec (); + +use Test::More tests => 20; + +### case 1 ### +use_ok( 'Module::Load::Conditional' ) or diag "Module.pm not found. Dying", die; + +### stupid stupid warnings ### +{ $Module::Load::Conditional::VERBOSE = + $Module::Load::Conditional::VERBOSE = 0; + + *can_load = *Module::Load::Conditional::can_load + = *Module::Load::Conditional::can_load; + *check_install = *Module::Load::Conditional::check_install + = *Module::Load::Conditional::check_install; + *requires = *Module::Load::Conditional::requires + = *Module::Load::Conditional::requires; +} + +{ + my $rv = check_install( + module => 'Module::Load::Conditional', + version => $Module::Load::Conditional::VERSION, + ); + + ok( $rv->{uptodate}, q[Verify self] ); + ok( $rv->{version} == $Module::Load::Conditional::VERSION, + q[ Found proper version] ); + + ok( $INC{'Module/Load/Conditional.pm'} eq + File::Spec::Unix->catfile(File::Spec->splitdir($rv->{file}) ), + q[ Found proper file] + ); + +} + +{ + my $rv = check_install( + module => 'Module::Load::Conditional', + version => $Module::Load::Conditional::VERSION + 1, + ); + + ok( !$rv->{uptodate} && $rv->{version} && $rv->{file}, + q[Verify out of date module] + ); +} + +{ + my $rv = check_install( module => 'Module::Load::Conditional' ); + + ok( $rv->{uptodate} && $rv->{version} && $rv->{file}, + q[Verify any module] + ); +} + +{ + my $rv = check_install( module => 'Module::Does::Not::Exist' ); + + ok( !$rv->{uptodate} && !$rv->{version} && !$rv->{file}, + q[Verify non-existant module] + ); + +} + +### test $FILE_VERSION +{ local $Module::Load::Conditional::FIND_VERSION = 0; + local $Module::Load::Conditional::FIND_VERSION = 0; + + my $rv = check_install( module => 'Module::Load::Conditional' ); + + ok( $rv, 'Testing $FIND_VERSION' ); + is( $rv->{version}, undef, " No version info returned" ); + ok( $rv->{uptodate}, " Module marked as uptodate" ); +} + +### test 'can_load' ### + +{ + my $use_list = { 'LoadIt' => 1 }; + my $bool = can_load( modules => $use_list ); + + ok( $bool, q[Load simple module] ); +} + +{ + my $use_list = { 'Commented' => 2 }; + my $bool = can_load( modules => $use_list ); + + ok( $bool, q[Load module with a second, commented-out $VERSION] ); +} + +{ + my $use_list = { 'Must::Be::Loaded' => 1 }; + my $bool = can_load( modules => $use_list ); + + ok( !$bool, q[Detect out of date module] ); +} + +{ + delete $INC{'LoadIt.pm'}; + delete $INC{'Must/Be/Loaded.pm'}; + + my $use_list = { 'LoadIt' => 1, 'Must::Be::Loaded' => 1 }; + my $bool = can_load( modules => $use_list ); + + ok( !$INC{'LoadIt.pm'} && !$INC{'Must/Be/Loaded.pm'}, + q[Do not load if one prerequisite fails] + ); +} + + +### test 'requires' ### + +{ my %list = map { $_ => 1 } requires('Carp'); + + my $flag; + $flag++ unless delete $list{'Exporter'}; + + ok( !$flag, q[Detecting requirements] ); +} + + + +### test using the %INC lookup for check_install +{ local $Module::Load::Conditional::CHECK_INC_HASH = 1; + local $Module::Load::Conditional::CHECK_INC_HASH = 1; + + { package A::B::C::D; + $A::B::C::D::VERSION = $$; + $INC{'A/B/C/D.pm'} = $$.$$; + } + + my $href = check_install( module => 'A::B::C::D', version => 0 ); + + ok( $href, 'Found package in %INC' ); + is( $href->{'file'}, $$.$$, ' Found correct file' ); + is( $href->{'version'}, $$, ' Found correct version' ); + ok( $href->{'uptodate'}, ' Marked as uptodate' ); + ok( can_load( modules => { 'A::B::C::D' => 0 } ), + ' can_load successful' ); +} + + diff --git a/lib/Module/Load/Conditional/t/to_load/Commented.pm b/lib/Module/Load/Conditional/t/to_load/Commented.pm new file mode 100644 index 0000000..1e3e057 --- /dev/null +++ b/lib/Module/Load/Conditional/t/to_load/Commented.pm @@ -0,0 +1,4 @@ +# $VERSION = 1; +$VERSION = 2; + +1; diff --git a/lib/Module/Load/Conditional/t/to_load/LoadIt.pm b/lib/Module/Load/Conditional/t/to_load/LoadIt.pm new file mode 100644 index 0000000..b97123d --- /dev/null +++ b/lib/Module/Load/Conditional/t/to_load/LoadIt.pm @@ -0,0 +1,3 @@ +$VERSION = 1; + +1; \ No newline at end of file diff --git a/lib/Module/Load/Conditional/t/to_load/LoadMe.pl b/lib/Module/Load/Conditional/t/to_load/LoadMe.pl new file mode 100644 index 0000000..6912615 --- /dev/null +++ b/lib/Module/Load/Conditional/t/to_load/LoadMe.pl @@ -0,0 +1 @@ +1; \ No newline at end of file diff --git a/lib/Module/Load/Conditional/t/to_load/Must/Be/Loaded.pm b/lib/Module/Load/Conditional/t/to_load/Must/Be/Loaded.pm new file mode 100644 index 0000000..e1af010 --- /dev/null +++ b/lib/Module/Load/Conditional/t/to_load/Must/Be/Loaded.pm @@ -0,0 +1,3 @@ +$VERSION = 0.01; + +1; \ No newline at end of file diff --git a/lib/Module/Load/Conditional/t/to_load/ToBeLoaded b/lib/Module/Load/Conditional/t/to_load/ToBeLoaded new file mode 100644 index 0000000..6912615 --- /dev/null +++ b/lib/Module/Load/Conditional/t/to_load/ToBeLoaded @@ -0,0 +1 @@ +1; \ No newline at end of file