$FIND_VERSION $ERROR $CHECK_INC_HASH];
use Exporter;
@ISA = qw[Exporter];
- $VERSION = '0.46';
+ $VERSION = '0.50';
$VERBOSE = 0;
$DEPRECATED = 0;
$FIND_VERSION = 1;
If no parsable version was found in the module, uptodate will also be
true, since C<check_install> had no way to verify clearly.
-See also C<$Module::Load::Conditional::DEPRECATED>, which affects
+See also C<$Module::Load::Conditional::DEPRECATED>, which affects
the outcome of this value.
=back
}
my $file = File::Spec->catfile( split /::/, $args->{module} ) . '.pm';
- my $file_inc = File::Spec::Unix->catfile(
- split /::/, $args->{module}
+ my $file_inc = File::Spec::Unix->catfile(
+ split /::/, $args->{module}
) . '.pm';
### where we store the return value ###
version => undef,
uptodate => undef,
};
-
+
my $filename;
### check the inc hash if we're allowed to
if( $CHECK_INC_HASH ) {
- $filename = $href->{'file'} =
+ $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" };
+ $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 ;)
my $existed_in_inc = $INC{$file_inc};
-
+
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($file);
}
-
+
if (!UNIVERSAL::isa($fh, 'GLOB')) {
warn loc(q[Cannot open file '%1': %2], $file, $!)
if $args->{verbose};
next;
}
-
+
$filename = $INC{$file_inc} || $file;
delete $INC{$file_inc} if not $existed_in_inc;
-
+
} 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, $!)
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
+ my $line;
+ while ( $line = <$fh> ) {
+
### #24062: "Problem with CPANPLUS 0.076 misidentifying
- ### versions after installing Text::NSP 1.03" where a
+ ### 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;
+ if( $line =~ /^=(.{0,3})/ ) {
+ $in_pod = $1 ne 'cut';
+ }
next if $in_pod;
-
+
+ ### skip lines which doesn't contain VERSION
+ next unless $line =~ /VERSION/;
+
### 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};
} 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?
eval {
- $href->{uptodate} =
+ $href->{uptodate} =
version->new( $args->{version} ) <= version->new( $href->{version} )
- ? 1
+ ? 1
: 0;
};
require Module::CoreList;
require Config;
- $href->{uptodate} = 0 if
+ $href->{uptodate} = 0 if
exists $Module::CoreList::version{ 0+$] }{ $args->{module} } and
Module::CoreList::is_deprecated( $args->{module} ) and
$Config::Config{privlibexp} eq $href->{dir};
my $str = shift or return;
my $verbose = shift || 0;
- ### skip lines which doesn't contain VERSION
- return unless $str =~ /VERSION/;
-
### 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)
+
+ ### 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 modify 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
-
+ # }; $VERSION
+
my $eval = qq{
package Module::Load::Conditional::_version;
no strict;
$taint_safe_str
}; \$$2
};
-
+
print "Evaltext: $eval\n" if $verbose;
-
+
my $result = do {
local $^W = 0;
- eval($eval);
+ 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;
}
###
### 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
+ ### here, or things like #30056 might start happening
if ( !$args->{nocache}
&& defined $CACHE->{$mod}->{usable}
- && (version->new( $CACHE->{$mod}->{version}||0 )
+ && (version->new( $CACHE->{$mod}->{version}||0 )
>= version->new( $href->{$mod} ) )
) {
$error = loc( q[Already tried to use '%1', which was unsuccessful], $mod);
}
my $lib = join " ", map { qq["-I$_"] } @INC;
- my $cmd = qq[$^X $lib -M$who -e"print(join(qq[\\n],keys(%INC)))"];
+ my $cmd = qq["$^X" $lib -M$who -e"print(join(qq[\\n],keys(%INC)))"];
return sort
grep { !/^$who$/ }
=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.
+(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.
+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::DEPRECATED
-This controls whether C<Module::Load::Conditional> checks if
+This controls whether C<Module::Load::Conditional> checks if
a dual-life core module has been deprecated. If this is set to
-true C<check_install> will return false to C<uptodate>, if
+true C<check_install> will return false to C<uptodate>, if
a dual-life module is found to be loaded from C<$Config{privlibexp}>
The default is 0;
=head1 COPYRIGHT
-This library is free software; you may redistribute and/or modify it
+This library is free software; you may redistribute and/or modify it
under the same terms as Perl itself.
=cut
### Module::Load::Conditional test suite ###
### this should no longer be needed
-# BEGIN {
+# BEGIN {
# if( $ENV{PERL_CORE} ) {
-# chdir '../lib/Module/Load/Conditional'
+# 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_ok( 'Module::Load::Conditional' );
### stupid stupid warnings ###
-{ $Module::Load::Conditional::VERBOSE =
+{ $Module::Load::Conditional::VERBOSE =
$Module::Load::Conditional::VERBOSE = 0;
*can_load = *Module::Load::Conditional::can_load
);
ok( $rv->{uptodate}, q[Verify self] );
- is( $rv->{version}, $Module::Load::Conditional::VERSION,
+ 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...
$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,
### 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
+ ### and return it
@path;
};
my $inc_path = $INC{'Module/Load/Conditional.pm'};
File::Spec::Unix->catfile(@rv_path),
q[ Found proper file]
);
-
-
+
+
}
### 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',
+
+ 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' ###
### test 'requires' ###
SKIP:{
- skip "Depends on \$^X, which doesn't work well when testing the Perl core",
+ 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'};
### 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 = $$;
+
+ { 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' );
https://perl5.git.perl.org / perl5.git / commitdiff