summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Module/Load/Conditional.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Module/Load/Conditional.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/Module/Load/Conditional.pm167
1 files changed, 47 insertions, 120 deletions
diff --git a/Master/tlpkg/tlperl/lib/Module/Load/Conditional.pm b/Master/tlpkg/tlperl/lib/Module/Load/Conditional.pm
index 39dccf1ce2b..342371f8794 100644
--- a/Master/tlpkg/tlperl/lib/Module/Load/Conditional.pm
+++ b/Master/tlpkg/tlperl/lib/Module/Load/Conditional.pm
@@ -11,6 +11,8 @@ use File::Spec ();
use FileHandle ();
use version;
+use Module::Metadata ();
+
use constant ON_VMS => $^O eq 'VMS';
BEGIN {
@@ -18,7 +20,7 @@ BEGIN {
$FIND_VERSION $ERROR $CHECK_INC_HASH];
use Exporter;
@ISA = qw[Exporter];
- $VERSION = '0.46';
+ $VERSION = '0.54';
$VERBOSE = 0;
$DEPRECATED = 0;
$FIND_VERSION = 1;
@@ -137,7 +139,7 @@ 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.
-See also C<$Module::Load::Conditional::DEPRECATED>, which affects
+See also C<$Module::Load::Conditional::DEPRECATED>, which affects
the outcome of this value.
=back
@@ -168,8 +170,8 @@ sub check_install {
}
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 ###
@@ -178,59 +180,59 @@ sub check_install {
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, $!)
@@ -238,45 +240,31 @@ sub check_install {
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 don't need the version, we're done
+ last DIR unless $FIND_VERSION;
+
+ ### otherwise, the user wants us to find the version from files
+ my $mod_info = Module::Metadata->new_from_handle( $fh, $filename );
+ my $ver = $mod_info->version( $args->{module} );
+
+ if( defined $ver ) {
+ $href->{version} = $ver;
+
+ last DIR;
}
}
}
-
+
### if we couldn't find the file, return undef ###
return unless defined $href->{file};
@@ -294,7 +282,7 @@ sub check_install {
} 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?
@@ -308,19 +296,19 @@ sub check_install {
eval {
- $href->{uptodate} =
+ $href->{uptodate} =
version->new( $args->{version} ) <= version->new( $href->{version} )
- ? 1
+ ? 1
: 0;
};
}
- if ( $DEPRECATED and version->new($]) >= version->new('5.011') ) {
+ if ( $DEPRECATED and "$]" >= 5.011 ) {
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};
@@ -329,67 +317,6 @@ sub check_install {
return $href;
}
-sub _parse_version {
- my $self = shift;
- 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)
- ### 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
-
- 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
@@ -475,10 +402,10 @@ sub can_load {
###
### 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);
@@ -568,7 +495,7 @@ sub requires {
}
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$/ }
@@ -596,12 +523,12 @@ 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.
+(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;
@@ -631,9 +558,9 @@ C<undef>.
=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;
@@ -652,7 +579,7 @@ 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
+This library is free software; you may redistribute and/or modify it
under the same terms as Perl itself.
=cut