Upgrade to Module::Load::Conditional 0.16, by Jos Boumans

p4raw-id: //depot/perl@29989

3 files changed, 162 insertions, 24 deletions

diff --git a/lib/Module/Load/Conditional.pm b/lib/Module/Load/Conditional.pm
index 0aa3d04086..e29c563377 100644
--- a/lib/Module/Load/Conditional.pm
+++ b/lib/Module/Load/Conditional.pm
@@ -9,13 +9,14 @@ use Locale::Maketext::Simple Style => 'gettext';
 use Carp        ();
 use File::Spec  ();
 use FileHandle  ();
+use version     qw[qv];
 
 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.16';
     $VERBOSE        = 0;
     $FIND_VERSION   = 1;
     $CHECK_INC_HASH = 0;
@@ -239,28 +240,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;
                     }
@@ -292,6 +276,63 @@ sub check_install {
     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
diff --git a/lib/Module/Load/Conditional/t/01_Module_Load_Conditional.t b/lib/Module/Load/Conditional/t/01_Module_Load_Conditional.t
index af05c45b5e..2dc249ffd5 100644
--- a/lib/Module/Load/Conditional/t/01_Module_Load_Conditional.t
+++ b/lib/Module/Load/Conditional/t/01_Module_Load_Conditional.t
@@ -19,7 +19,7 @@ use File::Spec ();
 use Test::More tests => 23;
 
 ### case 1 ###
-use_ok( 'Module::Load::Conditional' ) or diag "Module.pm not found.  Dying", die;
+use_ok( 'Module::Load::Conditional' );
 
 ### stupid stupid warnings ###
 {   $Module::Load::Conditional::VERBOSE =   
diff --git a/lib/Module/Load/Conditional/t/02_Parse_Version.t b/lib/Module/Load/Conditional/t/02_Parse_Version.t
new file mode 100644
index 0000000000..48fad07f28
--- /dev/null
+++ b/lib/Module/Load/Conditional/t/02_Parse_Version.t
@@ -0,0 +1,97 @@
+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.]+)/;
+    ];
+}
+
+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_]+)/);
+    ];
+}