David Golden wrote:
> I've released 0.33_01 so we can test the hell out of it with the goal
> if getting it into Perl 5.10.1.  I'll prepare a patch for blead and
> will start regression testing it versus 0.33.

Since it looks like you are going to have to do a quick 0.33_02 to fix the
problems with the core tests, I'm attaching a patch to bring M::B up to speed
with the soon to be released version.pm 0.77 changes.  There are a number of API
changes that are included (parse/declare in the place of new/qv) and more
importantly, a bug fix relating to eval and locales:

        http://rt.perl.org/rt3/Ticket/Display.html?id=66244
        http://rt.cpan.org/Ticket/Display.html?id=46921

that changes the parser.  I haven't actually been able to trigger the error in a
test case (only with XS), but I made parallel changes to the pure Perl modules
just to be on the safe side.

I also patched Module::Build::Base and the associated t/metadata.t test to match
the expected behavior /vis-a-vis/ normalized dotted-decimal version tuples.

Thanks

John
=== lib/Module/Build/Base.pm
==================================================================
--- lib/Module/Build/Base.pm	(revision 2576)
+++ lib/Module/Build/Base.pm	(local)
@@ -3620,9 +3620,7 @@
   }
   elsif ( ref $version eq 'version' || 
           ref $version eq 'Module::Build::Version' ) { # version objects
-    my $string = $version->stringify;
-    # normalize leading-v: "v1.2" -> "v1.2.0"
-    $version = substr($string,0,1) eq 'v' ? $version->normal : $string;
+    $version = $version->is_qv ? $version->normal : $version->stringify;
   }
   elsif ( $version =~ /^[^v][^.]*\.[^.]+\./ ) { # no leading v, multiple dots
     # normalize string tuples without "v": "1.2.3" -> "v1.2.3"
=== lib/Module/Build/Version.pm
==================================================================
--- lib/Module/Build/Version.pm	(revision 2576)
+++ lib/Module/Build/Version.pm	(local)
@@ -2,7 +2,7 @@
 use strict;
 
 use vars qw($VERSION);
-$VERSION = 0.74;
+$VERSION = 0.77;
 
 eval "use version $VERSION";
 if ($@) { # can't locate version files, use our own
@@ -46,35 +46,81 @@
 use 5.005_04;
 use strict;
 
-use vars qw(@ISA $VERSION $CLASS *qv);
+use vars qw(@ISA $VERSION $CLASS *declare *qv);
 
-$VERSION = 0.000;
+$VERSION = 0;
 
 $CLASS = 'version';
 
 push @ISA, "version::vpp";
+local $^W;
 *version::qv = \&version::vpp::qv;
+*version::declare = \&version::vpp::declare;
+*version::_VERSION = \&version::vpp::_VERSION;
+if ($] > 5.009001 && $] <= 5.010000) {
+    no strict 'refs';
+    *{'version::stringify'} = \*version::vpp::stringify;
+    *{'version::(""'} = \*version::vpp::stringify;
+}
 
 # Preloaded methods go here.
 sub import {
-    my ($class) = @_;
+    no strict 'refs';
+    my ($class) = shift;
+
+    # Set up any derived class
+    unless ($class eq 'version') {
+	local $^W;
+	*{$class.'::declare'} =  \&version::declare;
+	*{$class.'::qv'} = \&version::qv;
+    }
+
+    my %args;
+    if (@_) { # any remaining terms are arguments
+	map { $args{$_} = 1 } @_
+    }
+    else { # no parameters at all on use line
+    	%args = 
+	(
+	    qv => 1,
+	    'UNIVERSAL::VERSION' => 1,
+	);
+    }
+
     my $callpkg = caller();
-    no strict 'refs';
     
-    *{$callpkg."::qv"} = 
-	    sub {return bless version::qv(shift), $class }
-	unless defined(&{"$callpkg\::qv"});
+    if (exists($args{declare})) {
+	*{$callpkg."::declare"} = 
+	    sub {return $class->declare(shift) }
+	  unless defined(&{$callpkg.'::declare'});
+    }
 
+    if (exists($args{qv})) {
+	*{$callpkg."::qv"} =
+	    sub {return $class->qv(shift) }
+	  unless defined(&{"$callpkg\::qv"});
+    }
+
+    if (exists($args{'UNIVERSAL::VERSION'})) {
+	local $^W;
+	*UNIVERSAL::VERSION = \&version::_VERSION;
+    }
+
+    if (exists($args{'VERSION'})) {
+	*{$callpkg."::VERSION"} = \&version::_VERSION;
+    }
 }
 
 1;
+
 # replace everything from here to the end with the current version/vpp.pm
 package version::vpp;
 use strict;
 
+use POSIX qw/locale_h/;
 use locale;
 use vars qw ($VERSION @ISA @REGEXS);
-$VERSION = 0.76;
+$VERSION = '0.77';
 
 push @REGEXS, qr/
 	^v?	# optional leading 'v'
@@ -108,7 +154,7 @@
 	my ($class, $value) = @_;
 	my $self = bless ({}, ref ($class) || $class);
 	
-	if ( ref($value) && eval("$value->isa('version')") ) {
+	if ( ref($value) && eval('$value->isa("version")') ) {
 	    # Can copy the elements directly
 	    $self->{version} = [ @{$value->{version} } ];
 	    $self->{qv} = 1 if $value->{qv};
@@ -117,10 +163,15 @@
 	    return $self;
 	}
 
-	require POSIX;
-	my $currlocale = POSIX::setlocale(&POSIX::LC_ALL);
-	my $radix_comma = ( POSIX::localeconv()->{decimal_point} eq ',' );
+	my $currlocale = setlocale(LC_ALL);
 
+	# if the current locale uses commas for decimal points, we
+	# just replace commas with decimal places, rather than changing
+	# locales
+	if ( localeconv()->{decimal_point} eq ',' ) {
+	    $value =~ tr/,/./;
+	}
+
 	if ( not defined $value or $value =~ /^undef$/ ) {
 	    # RT #19517 - special case for undef comparison
 	    # or someone forgot to pass a value
@@ -136,18 +187,11 @@
 	$value = _un_vstring($value);
 
 	# exponential notation
-	if ( $value =~ /\d+.?\d*e-?\d+/ ) {
+	if ( $value =~ /\d+.?\d*e[-+]?\d+/ ) {
 	    $value = sprintf("%.9f",$value);
-	    $value =~ s/(0+)$//;
+	    $value =~ s/(0+)$//; # trim trailing zeros
 	}
 	
-	# if the original locale used commas for decimal points, we
-	# just replace commas with decimal places, rather than changing
-	# locales
-	if ( $radix_comma ) {
-	    $value =~ tr/,/./;
-	}
-
 	# This is not very efficient, but it is morally equivalent
 	# to the XS code (as that is the reference implementation).
 	# See vutil/vutil.c for details
@@ -171,7 +215,7 @@
 	$start = $last = $pos = $s;
 		
 	# pre-scan the input string to check for decimals/underbars
-	while ( substr($value,$pos,1) =~ /[._\d]/ ) {
+	while ( substr($value,$pos,1) =~ /[._\d,]/ ) {
 	    if ( substr($value,$pos,1) eq '.' ) {
 		if ($alpha) {
 		    Carp::croak("Invalid version format ".
@@ -189,6 +233,12 @@
 		$alpha = 1;
 		$width = $pos - $last - 1; # natural width of sub-version
 	    }
+	    elsif ( substr($value,$pos,1) eq ','
+		    and substr($value,$pos+1,1) =~ /[0-9]/ ) {
+		# looks like an unhandled locale
+		$saw_period++;
+		$last = $pos;
+	    }
 	    $pos++;
 	}
 
@@ -291,6 +341,10 @@
 		    && substr($value,$pos+1,1) =~ /\d/ ) {
 		    $s = ++$pos;
 		}
+		elsif ( substr($value,$pos,1) eq ',' 
+		    && substr($value,$pos+1,1) =~ /\d/ ) {
+		    $s = ++$pos;
+		}
 		elsif ( substr($value,$pos,1) =~ /\d/ ) {
 		    $s = $pos;
 		}
@@ -342,6 +396,8 @@
 	return ($self);
 }
 
+*parse = \&new;
+
 sub numify 
 {
     my ($self) = @_;
@@ -518,14 +574,21 @@
 }
 
 sub qv {
-    my ($value) = @_;
+    my $value = shift;
+    my $class = 'version';
+    if (@_) {
+	$class = ref($value) || $value;
+	$value = shift;
+    }
 
     $value = _un_vstring($value);
     $value = 'v'.$value unless $value =~ /(^v|\d+\.\d+\.\d)/;
-    my $version = version->new($value); # always use base class
+    my $version = $class->new($value);
     return $version;
 }
 
+*declare = \&qv;
+
 sub is_qv {
     my ($self) = @_;
     return (exists $self->{qv});
@@ -558,69 +621,64 @@
     return $value;
 }
 
-# Thanks to Yitzchak Scott-Thoennes for this mode of operation
-{
-    local $^W;
-    *UNIVERSAL::VERSION # Module::Build::ModuleInfo doesn't see this now
-      = sub {
-	my ($obj, $req) = @_;
-	my $class = ref($obj) || $obj;
+sub _VERSION {
+    my ($obj, $req) = @_;
+    my $class = ref($obj) || $obj;
 
-	no strict 'refs';
-	eval "require $class" unless %{"$class\::"}; # already existing
-	return undef if $@ =~ /Can't locate/ and not defined $req;
-	
-	if ( not %{"$class\::"} and $] >= 5.008) { # file but no package
+    no strict 'refs';
+    eval "require $class" unless %{"$class\::"}; # already existing
+    return undef if $@ =~ /Can't locate/ and not defined $req;
+    
+    if ( not %{"$class\::"} and $] >= 5.008) { # file but no package
+	require Carp;
+	Carp::croak( "$class defines neither package nor VERSION"
+	    ."--version check failed");
+    }
+    
+    my $version = eval "\$$class\::VERSION";
+    if ( defined $version ) {
+	local $^W if $] <= 5.008;
+	$version = version::vpp->new($version);
+    }
+
+    if ( defined $req ) {
+	unless ( defined $version ) {
 	    require Carp;
-	    Carp::croak( "$class defines neither package nor VERSION"
-		."--version check failed");
-	}
-	
-	my $version = eval "\$$class\::VERSION";
-	if ( defined $version ) {
-	    local $^W if $] <= 5.008;
-	    $version = version::vpp->new($version);
-	}
+	    my $msg =  $] < 5.006 
+	    ? "$class version $req required--this is only version "
+	    : "$class does not define \$$class\::VERSION"
+	      ."--version check failed";
 
-	if ( defined $req ) {
-	    unless ( defined $version ) {
-		require Carp;
-		my $msg =  $] < 5.006 
-		? "$class version $req required--this is only version "
-		: "$class does not define \$$class\::VERSION"
-		  ."--version check failed";
-
-		if ( $ENV{VERSION_DEBUG} ) {
-		    Carp::confess($msg);
-		}
-		else {
-		    Carp::croak($msg);
-		}
+	    if ( $ENV{VERSION_DEBUG} ) {
+		Carp::confess($msg);
 	    }
+	    else {
+		Carp::croak($msg);
+	    }
+	}
 
-	    $req = version::vpp->new($req);
+	$req = version::vpp->new($req);
 
-	    if ( $req > $version ) {
-		require Carp;
-		if ( $req->is_qv ) {
-		    Carp::croak( 
-			sprintf ("%s version %s required--".
-			    "this is only version %s", $class,
-			    $req->normal, $version->normal)
-		    );
-		}
-		else {
-		    Carp::croak( 
-			sprintf ("%s version %s required--".
-			    "this is only version %s", $class,
-			    $req->stringify, $version->stringify)
-		    );
-		}
+	if ( $req > $version ) {
+	    require Carp;
+	    if ( $req->is_qv ) {
+		Carp::croak( 
+		    sprintf ("%s version %s required--".
+			"this is only version %s", $class,
+			$req->normal, $version->normal)
+		);
 	    }
+	    else {
+		Carp::croak( 
+		    sprintf ("%s version %s required--".
+			"this is only version %s", $class,
+			$req->stringify, $version->stringify)
+		);
+	    }
 	}
+    }
 
-	return defined $version ? $version->stringify : undef;
-    };
+    return defined $version ? $version->stringify : undef;
 }
 
 1; #this line is important and will help the module return a true value
=== t/metadata.t
==================================================================
--- t/metadata.t	(revision 2576)
+++ t/metadata.t	(local)
@@ -165,8 +165,8 @@
 ---
   $dist->regen;
   my $provides = new_build()->prepare_metadata()->{provides};
-  is $provides->{'Simple'}{version}, '0.60.128', "Check version";
-  is $provides->{'Simple::Simon'}{version}, '0.61.129', "Check version";
+  is $provides->{'Simple'}{version}, 'v0.60.128', "Check version";
+  is $provides->{'Simple::Simon'}{version}, 'v0.61.129', "Check version";
   is ref($provides->{'Simple'}{version}), '', "Versions from prepare_metadata() aren't refs";
   is ref($provides->{'Simple::Simon'}{version}), '', "Versions from prepare_metadata() aren't refs";
 }

Reply via email to