X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/e163f9a0cad0e6bc632cba9a82e10b83f046f88d..fc934b13d23aabf19a3b0a92666cf2d0b2eb51ab:/lib/Module/Load/Conditional.pm

diff --git a/lib/Module/Load/Conditional.pm b/lib/Module/Load/Conditional.pm
index 0aa3d04..a97a9f0 100644
--- a/lib/Module/Load/Conditional.pm
+++ b/lib/Module/Load/Conditional.pm
@@ -3,19 +3,22 @@ package Module::Load::Conditional;
 use strict;
 
 use Module::Load;
-use Params::Check qw[check];
-use Locale::Maketext::Simple Style => 'gettext';
+use Params::Check                       qw[check];
+use Locale::Maketext::Simple Style  => 'gettext';
 
 use Carp        ();
 use File::Spec  ();
 use FileHandle  ();
+use version     qw[qv];
+
+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.14';
+    $VERSION        = '0.20';
     $VERBOSE        = 0;
     $FIND_VERSION   = 1;
     $CHECK_INC_HASH = 0;
@@ -223,7 +226,11 @@ sub check_install {
                 }
             }
     
-            $href->{file} = $filename;
+            ### 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 ) {
@@ -239,28 +246,11 @@ sub check_install {
                     $in_pod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $in_pod;
                     next if $in_pod;
                     
-                    ### 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';
+                    ### try to find a version declaration in this string.
+                    my $ver = __PACKAGE__->_parse_version( $_ );
+
+                    if( defined $ver ) {
+                        $href->{version} = $ver;
         
                         last DIR;
                     }
@@ -272,7 +262,7 @@ sub check_install {
     ### 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
+    ### 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;
@@ -286,12 +276,74 @@ sub check_install {
     } else {
         ### don't warn about the 'not numeric' stuff ###
         local $^W;
-        $href->{uptodate} = $args->{version} <= $href->{version} ? 1 : 0;
+        
+        ### 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?
+        $href->{uptodate} = 
+            qv( $args->{version} ) <= qv( $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.
+
+    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 {
+                $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
@@ -370,9 +422,13 @@ sub can_load {
             ### 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?
             if (    !$args->{nocache}
                     && defined $CACHE->{$mod}->{usable}
-                    && (($CACHE->{$mod}->{version}||0) >= $href->{$mod})
+                    && (qv($CACHE->{$mod}->{version}||0) >= qv($href->{$mod}))
             ) {
                 $error = loc( q[Already tried to use '%1', which was unsuccessful], $mod);
                 last BLOCK;
@@ -427,12 +483,14 @@ sub can_load {
     if( defined $error ) {
         $ERROR = $error;
         Carp::carp( loc(q|%1 [THIS MAY BE A PROBLEM!]|,$error) ) if $args->{verbose};
-        return undef;
+        return;
     } else {
         return 1;
     }
 }
 
+=back
+
 =head2 @list = requires( MODULE );
 
 C<requires> can tell you what other modules a particular module
@@ -524,15 +582,17 @@ C<undef>.
 
 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>.
+This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.
 
 =head1 COPYRIGHT
 
-This module is copyright (c) 2002-2007 Jos Boumans 
-E<lt>kane@cpan.orgE<gt>. All rights reserved.
+This library is free software; you may redistribute and/or modify it 
+under the same terms as Perl itself.
 
-This library is free software; you may redistribute and/or modify 
-it under the same terms as Perl itself.
+=cut