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";
}
