diff options
author | Nicholas Clark <nick@ccl4.org> | 2009-09-26 14:52:33 +0100 |
---|---|---|
committer | Nicholas Clark <nick@ccl4.org> | 2009-09-26 14:52:33 +0100 |
commit | b2f35940bb67ef1897a3424ba54bae0f74434d8e (patch) | |
tree | 7ed3fe4101000c53c9f1baef9dbce1a603369b70 /cpan | |
parent | 1ac05d83359ab0b4e03b39df1d104eb71a8437cf (diff) | |
download | perl-b2f35940bb67ef1897a3424ba54bae0f74434d8e.tar.gz |
Move Module::Load::Conditional from ext/ to cpan/
Diffstat (limited to 'cpan')
9 files changed, 975 insertions, 0 deletions
diff --git a/cpan/Module-Load-Conditional/lib/Module/Load/Conditional.pm b/cpan/Module-Load-Conditional/lib/Module/Load/Conditional.pm new file mode 100644 index 0000000000..47bafe1ead --- /dev/null +++ b/cpan/Module-Load-Conditional/lib/Module/Load/Conditional.pm @@ -0,0 +1,620 @@ +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 (); +use version; + +use constant ON_VMS => $^O eq 'VMS'; + +BEGIN { + use vars qw[ $VERSION @ISA $VERBOSE $CACHE @EXPORT_OK + $FIND_VERSION $ERROR $CHECK_INC_HASH]; + use Exporter; + @ISA = qw[Exporter]; + $VERSION = '0.30'; + $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<check_install> 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 dir + +Directory, or more exact the C<@INC> entry, where the module was +loaded from. + +=item version + +The version number of the installed module - this will be C<undef> 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<GLOBAL VARIABLES> 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<check_install> 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; + } + } + + ### store the directory we found the file in + $href->{dir} = $dir; + + ### files need to be in unix format under vms, + ### or they might be loaded twice + $href->{file} = ON_VMS + ? VMS::Filespec::unixify( $filename ) + : $filename; + + ### user wants us to find the version from files + if( $FIND_VERSION ) { + + my $in_pod = 0; + while ( my $line = <$fh> ) { + + ### stolen from EU::MM_Unix->parse_version to address + ### #24062: "Problem with CPANPLUS 0.076 misidentifying + ### versions after installing Text::NSP 1.03" where a + ### VERSION mentioned in the POD was found before + ### the real $VERSION declaration. + $in_pod = $line =~ /^=(?!cut)/ ? 1 : + $line =~ /^=cut/ ? 0 : + $in_pod; + next if $in_pod; + + ### try to find a version declaration in this string. + my $ver = __PACKAGE__->_parse_version( $line ); + + if( defined $ver ) { + $href->{version} = $ver; + + last DIR; + } + } + } + } + } + + ### if we couldn't find the file, return undef ### + return unless defined $href->{file}; + + ### only complain if we're expected to 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; + + ### use qv(), as it will deal with developer release number + ### ie ones containing _ as well. This addresses bug report + ### #29348: Version compare logic doesn't handle alphas? + ### + ### Update from JPeacock: apparently qv() and version->new + ### are different things, and we *must* use version->new + ### here, or things like #30056 might start happening + $href->{uptodate} = + version->new( $args->{version} ) <= version->new( $href->{version} ) + ? 1 + : 0; + } + + return $href; +} + +sub _parse_version { + my $self = shift; + my $str = shift or return; + my $verbose = shift or 0; + + ### skip commented out lines, they won't eval to anything. + return if $str =~ /^\s*#/; + + ### the following regexp & eval statement comes from the + ### ExtUtils::MakeMaker source (EU::MM_Unix->parse_version) + ### 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. + my $taint_safe_str = do { $str =~ /(^.*$)/sm; $1 }; + + if( $str =~ /(?<!\\)([\$*])(([\w\:\']*)\bVERSION)\b.*\=/ ) { + + print "Evaluating: $str\n" if $verbose; + + ### this creates a string to be eval'd, like: + # package Module::Load::Conditional::_version; + # no strict; + # + # local $VERSION; + # $VERSION=undef; do { + # use version; $VERSION = qv('0.0.3'); + # }; $VERSION + + my $eval = qq{ + package Module::Load::Conditional::_version; + no strict; + + local $1$2; + \$$2=undef; do { + $taint_safe_str + }; \$$2 + }; + + print "Evaltext: $eval\n" if $verbose; + + my $result = do { + local $^W = 0; + eval($eval); + }; + + + my $rv = defined $result ? $result : '0.0'; + + print( $@ ? "Error: $@\n" : "Result: $rv\n" ) if $verbose; + + return $rv; + } + + ### unable to find a version in this string + return; +} + +=head2 $bool = can_load( modules => { NAME => VERSION [,NAME => VERSION] }, [verbose => BOOL, nocache => BOOL] ) + +C<can_load> 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<load> function from Module::Load under the +hood. + +C<can_load> 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<can_load> 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<can_load> will check its +cache, but you can override that by setting C<nocache> 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 + + ### use qv(), as it will deal with developer release number + ### ie ones containing _ as well. This addresses bug report + ### #29348: Version compare logic doesn't handle alphas? + ### + ### Update from JPeacock: apparently qv() and version->new + ### are different things, and we *must* use version->new + ### here, or things like #30056 might start happening + if ( !$args->{nocache} + && defined $CACHE->{$mod}->{usable} + && (version->new( $CACHE->{$mod}->{version}||0 ) + >= version->new( $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; + } else { + return 1; + } +} + +=back + +=head2 @list = requires( MODULE ); + +C<requires> 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<requires> 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<require> 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<false>. 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<taint mode>. + +The default is 1; + +=head2 $Module::Load::Conditional::CHECK_INC_HASH + +This controls whether C<Module::Load::Conditional> 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<true> 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<can_load> function. If you explicitly +want to remove the current cache, you can set this variable to +C<undef> + +=head2 $Module::Load::Conditional::ERROR + +This holds a string of the last error that happened during a call to +C<can_load>. It is useful to inspect this when C<can_load> returns +C<undef>. + +=head1 See Also + +C<Module::Load> + +=head1 BUG REPORTS + +Please report bugs or other issues to E<lt>bug-module-load-conditional@rt.cpan.orgE<gt>. + +=head1 AUTHOR + +This module by Jos Boumans E<lt>kane@cpan.orgE<gt>. + +=head1 COPYRIGHT + +This library is free software; you may redistribute and/or modify it +under the same terms as Perl itself. + +=cut diff --git a/cpan/Module-Load-Conditional/t/01_Module_Load_Conditional.t b/cpan/Module-Load-Conditional/t/01_Module_Load_Conditional.t new file mode 100644 index 0000000000..b5d78c7a5d --- /dev/null +++ b/cpan/Module-Load-Conditional/t/01_Module_Load_Conditional.t @@ -0,0 +1,233 @@ +### Module::Load::Conditional test suite ### +### this should no longer be needed +# 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 { use FindBin; } +BEGIN { chdir 't' if -d 't' } + +use strict; +use File::Spec (); +use Test::More 'no_plan'; + +use constant ON_VMS => $^O eq 'VMS'; + +use lib File::Spec->catdir($FindBin::Bin, qw[.. lib] ); +use lib File::Spec->catdir($FindBin::Bin, q[to_load] ); + +use_ok( 'Module::Load::Conditional' ); + +### 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] ); + is( $rv->{version}, $Module::Load::Conditional::VERSION, + q[ Found proper version] ); + ok( $rv->{dir}, q[ Found directory information] ); + + { my $dir = File::Spec->canonpath( $rv->{dir} ); + + ### special rules apply on VMS, as always... + if (ON_VMS) { + ### Need path syntax for VMS compares. + $dir = VMS::Filespec::pathify($dir); + ### Remove the trailing VMS specific directory delimiter + $dir =~ s/\]//; + } + + ### quote for Win32 paths, use | to avoid slash confusion + my $dir_re = qr|^\Q$dir\E|i; + like( File::Spec->canonpath( $rv->{file} ), $dir_re, + q[ Dir subset of file path] ); + } + + ### break up the specification + my @rv_path = do { + + ### Use the UNIX specific method, as the VMS one currently + ### converts the file spec back to VMS format. + my $class = ON_VMS ? 'File::Spec::Unix' : 'File::Spec'; + + my($vol, $path, $file) = $class->splitpath( $rv->{'file'} ); + + my @path = ($vol, $class->splitdir( $path ), $file ); + + ### First element could be blank for some system types like VMS + shift @path if $vol eq ''; + + ### and return it + @path; + }; + my $inc_path = $INC{'Module/Load/Conditional.pm'}; + if ( $^O eq 'MSWin32' ) { + $inc_path = File::Spec->canonpath( $inc_path ); + $inc_path =~ s{\\}{/}g; # to meet with unix path + } + is( $inc_path, + File::Spec::Unix->catfile(@rv_path), + q[ Found proper file] + ); + + + +} + +### the version may contain an _, which means perl will warn about 'not +### numeric' -- turn off that warning here. +{ local $^W; + 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 finding a version of a module that mentions $VERSION in pod +{ my $rv = check_install( module => 'InPod' ); + ok( $rv, 'Testing $VERSION in POD' ); + ok( $rv->{version}, " Version found" ); + is( $rv->{version}, 2, " Version is correct" ); +} + +### test beta/developer release versions +{ my $test_ver = $Module::Load::Conditional::VERSION; + + ### strip beta tags + $test_ver =~ s/_\d+//g; + $test_ver .= '_99'; + + my $rv = check_install( + module => 'Module::Load::Conditional', + version => $test_ver, + ); + + ok( $rv, "Checking beta versions" ); + ok( !$rv->{'uptodate'}, " Beta version is higher" ); + +} + +### test $FIND_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 = { 'MustBe::Loaded' => 1 }; + my $bool = can_load( modules => $use_list ); + + ok( !$bool, q[Detect out of date module] ); +} + +{ + delete $INC{'LoadIt.pm'}; + delete $INC{'MustBe/Loaded.pm'}; + + my $use_list = { 'LoadIt' => 1, 'MustBe::Loaded' => 1 }; + my $bool = can_load( modules => $use_list ); + + ok( !$INC{'LoadIt.pm'} && !$INC{'MustBe/Loaded.pm'}, + q[Do not load if one prerequisite fails] + ); +} + + +### test 'requires' ### +SKIP:{ + skip "Depends on \$^X, which doesn't work well when testing the Perl core", + 1 if $ENV{PERL_CORE}; + + 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'} = $$.$$; + + ### XXX this is no longer needed with M::Load 0.11_01 + #$INC{'[.A.B.C]D.pm'} = $$.$$ if $^O eq 'VMS'; + } + + 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/cpan/Module-Load-Conditional/t/02_Parse_Version.t b/cpan/Module-Load-Conditional/t/02_Parse_Version.t new file mode 100644 index 0000000000..dd29c67657 --- /dev/null +++ b/cpan/Module-Load-Conditional/t/02_Parse_Version.t @@ -0,0 +1,99 @@ +BEGIN { chdir 't' if -d 't' } + +use strict; +use lib qw[../lib]; +use Test::More 'no_plan'; + +my $Class = 'Module::Load::Conditional'; +my $Meth = '_parse_version'; +my $Verbose = @ARGV ? 1 : 0; + +use_ok( $Class ); + +### versions that should parse +{ for my $str ( __PACKAGE__->_succeed ) { + my $res = $Class->$Meth( $str, $Verbose ); + ok( defined $res, "String '$str' identified as version string" ); + + ### XXX version.pm 0.69 pure perl fails tests under 5.6.2. + ### XXX version.pm <= 0.69 do not have a complete overload + ### implementation, which causes the following error: + ### $ perl -Mversion -le'qv(1)+0' + ### Operation "+": no method found, + ### left argument in overloaded package version, + ### right argument has no overloaded magic at -e line 1 + ### so we do the comparison ourselves, and then feed it to + ### the Test::More::ok(). + ### + ### Mailed jpeacock and p5p about both issues on 25-1-2007: + ### http://xrl.us/uem7 + ### (http://www.xray.mpe.mpg.de/mailing-lists/ + ### perl5-porters/2007-01/msg00805.html) + + ### Quell "Argument isn't numeric in gt" warnings... + my $bool = do { local $^W; $res > 0 }; + + ok( $bool, " Version is '$res'" ); + isnt( $res, '0.0', " Not the default value" ); + } +} + +### version that should fail +{ for my $str ( __PACKAGE__->_fail ) { + my $res = $Class->$Meth( $str, $Verbose ); + ok( ! defined $res, "String '$str' is not a version string" ); + } +} + + +################################ +### +### VERSION declarations to test +### +################################ + +sub _succeed { + return grep { /\S/ } map { s/^\s*//; $_ } split "\n", q[ + $VERSION = 1; + *VERSION = \'1.01'; + use version; $VERSION = qv('0.0.2'); + use version; $VERSION = qv('3.0.14'); + ($VERSION) = '$Revision: 2.03 $' =~ /\s(\d+\.\d+)\s/; + ( $VERSION ) = sprintf "%d.%02d", q$Revision: 1.23 $ =~ m/ (\d+) \. (\d+) /gx; + ($GD::Graph::area::VERSION) = '$Revision: 1.16.2.3 $' =~ /\s([\d.]+)/; + ($GD::Graph::axestype::VERSION) = '$Revision: 1.44.2.14 $' =~ /\s([\d.]+)/; + ($GD::Graph::colour::VERSION) = '$Revision: 1.10 $' =~ /\s([\d.]+)/; + ($GD::Graph::pie::VERSION) = '$Revision: 1.20.2.4 $' =~ /\s([\d.]+)/; + ($GD::Text::Align::VERSION) = '$Revision: 1.18 $' =~ /\s([\d.]+)/; + $VERSION = qv('0.0.1'); + use version; $VERSION = qv('0.0.3'); + $VERSION = do { my @r = ( ( $v = q<Version value="0.20.1"> ) =~ /\d+/g ); sprintf "%d.%02d", $r[0], int( $r[1] / 10 ) }; + ($VERSION) = sprintf '%i.%03i', split(/\./,('$Revision: 2.0 $' =~ /Revision: (\S+)\s/)[0]); # $Date: 2005/11/16 02:16:00 $ + ( $VERSION = q($Id: Tidy.pm,v 1.56 2006/07/19 23:13:33 perltidy Exp $) ) =~ s/^.*\s+(\d+)\/(\d+)\/(\d+).*$/$1$2$3/; # all one line for MakeMaker + ($VERSION) = q $Revision: 2.120 $ =~ /([\d.]+)/; + ($VERSION) = q$Revision: 1.00 $ =~ /([\d.]+)/; + $VERSION = "3.0.8"; + $VERSION = '1.0.5'; + ]; +} + +sub _fail { + return grep { /\S/ } map { s/^\s*//; $_ } split "\n", q[ + use vars qw($VERSION $AUTOLOAD %ERROR $ERROR $Warn $Die); + sub version { $GD::Graph::colour::VERSION } + my $VERS = qr{ $HWS VERSION $HWS \n }xms; + diag( "Testing $main_module \$${main_module}::VERSION" ); + our ( $VERSION, $v, $_VERSION ); + my $seen = { q{::} => { 'VERSION' => 1 } }; # avoid multiple scans + eval "$module->VERSION" + 'VERSION' => '1.030' # Variable and Value + 'VERSION' => '2.121_020' + 'VERSION' => '0.050', # Standard variable $VERSION + use vars qw( $VERSION $seq @FontDirs ); + $VERSION + # *VERSION = \'1.01'; + # ( $VERSION ) = '$Revision: 1.56 $ ' =~ /\$Revision:\s+([^\s]+)/; + #$VERSION = sprintf("%d.%s", map {s/_//g; $_} q$Name: $ =~ /-(\d+)_([\d_]+)/); + #$VERSION = sprintf("%d.%s", map {s/_//g; $_} q$Name: $ =~ /-(\d+)_([\d_]+)/); + ]; +} diff --git a/cpan/Module-Load-Conditional/t/to_load/Commented.pm b/cpan/Module-Load-Conditional/t/to_load/Commented.pm new file mode 100644 index 0000000000..1e3e057f33 --- /dev/null +++ b/cpan/Module-Load-Conditional/t/to_load/Commented.pm @@ -0,0 +1,4 @@ +# $VERSION = 1;
+$VERSION = 2;
+
+1;
diff --git a/cpan/Module-Load-Conditional/t/to_load/InPod.pm b/cpan/Module-Load-Conditional/t/to_load/InPod.pm new file mode 100644 index 0000000000..0d4c39b60c --- /dev/null +++ b/cpan/Module-Load-Conditional/t/to_load/InPod.pm @@ -0,0 +1,11 @@ +=pod + +$VERSION = 1; + +=cut + +package InPod; + +$VERSION = 2; + +1; diff --git a/cpan/Module-Load-Conditional/t/to_load/LoadIt.pm b/cpan/Module-Load-Conditional/t/to_load/LoadIt.pm new file mode 100644 index 0000000000..b97123dac7 --- /dev/null +++ b/cpan/Module-Load-Conditional/t/to_load/LoadIt.pm @@ -0,0 +1,3 @@ +$VERSION = 1;
+
+1;
\ No newline at end of file diff --git a/cpan/Module-Load-Conditional/t/to_load/LoadMe.pl b/cpan/Module-Load-Conditional/t/to_load/LoadMe.pl new file mode 100644 index 0000000000..6912615643 --- /dev/null +++ b/cpan/Module-Load-Conditional/t/to_load/LoadMe.pl @@ -0,0 +1 @@ +1;
\ No newline at end of file diff --git a/cpan/Module-Load-Conditional/t/to_load/MustBe/Loaded.pm b/cpan/Module-Load-Conditional/t/to_load/MustBe/Loaded.pm new file mode 100644 index 0000000000..e1af010dc8 --- /dev/null +++ b/cpan/Module-Load-Conditional/t/to_load/MustBe/Loaded.pm @@ -0,0 +1,3 @@ +$VERSION = 0.01;
+
+1;
\ No newline at end of file diff --git a/cpan/Module-Load-Conditional/t/to_load/ToBeLoaded b/cpan/Module-Load-Conditional/t/to_load/ToBeLoaded new file mode 100644 index 0000000000..6912615643 --- /dev/null +++ b/cpan/Module-Load-Conditional/t/to_load/ToBeLoaded @@ -0,0 +1 @@ +1;
\ No newline at end of file |