miyagawa · SineSwiper · May 17, 2017 · May 17, 2017 · May 17, 2017
diff --git a/fatlib/version.pm b/fatlib/version.pm
@@ -10,13 +10,14 @@ if ($] >= 5.015) {
 
 use vars qw(@ISA $VERSION $CLASS $STRICT $LAX *declare *qv);
 
-$VERSION = 0.9912;
+$VERSION = 0.9918;
 $CLASS = 'version';
 
 # !!!!Delete this next block completely when adding to Perl core!!!!
 {
     local $SIG{'__DIE__'};
-    if (1) { # always pretend there's no XS
+    eval "use version::vxs $VERSION";
+    if ( $@ ) { # don't have the XS version installed
 	eval "use version::vpp $VERSION"; # don't tempt fate
 	die "$@" if ( $@ );
 	push @ISA, "version::vpp";
@@ -33,6 +34,7 @@ $CLASS = 'version';
 	    *version::stringify = \&version::vpp::stringify;
 	    *{'version::(""'} = \&version::vpp::stringify;
 	    *{'version::(<=>'} = \&version::vpp::vcmp;
+	    *{'version::(cmp'} = \&version::vpp::vcmp;
 	    *version::parse = \&version::vpp::parse;
 	}
     }
@@ -51,6 +53,7 @@ $CLASS = 'version';
 	    *version::stringify = \&version::vxs::stringify;
 	    *{'version::(""'} = \&version::vxs::stringify;
 	    *{'version::(<=>'} = \&version::vxs::VCMP;
+	    *{'version::(cmp'} = \&version::vxs::VCMP;
 	    *version::parse = \&version::vxs::parse;
 	}
     }
@@ -61,7 +64,11 @@ require version::regex;
 *version::is_lax = \&version::regex::is_lax;
 *version::is_strict = \&version::regex::is_strict;
 *LAX = \$version::regex::LAX;
+*LAX_DECIMAL_VERSION = \$version::regex::LAX_DECIMAL_VERSION;
+*LAX_DOTTED_DECIMAL_VERSION = \$version::regex::LAX_DOTTED_DECIMAL_VERSION;
 *STRICT = \$version::regex::STRICT;
+*STRICT_DECIMAL_VERSION = \$version::regex::STRICT_DECIMAL_VERSION;
+*STRICT_DOTTED_DECIMAL_VERSION = \$version::regex::STRICT_DOTTED_DECIMAL_VERSION;
 
 sub import {
     no strict 'refs';

diff --git a/fatlib/version/regex.pm b/fatlib/version/regex.pm
@@ -2,9 +2,13 @@ package version::regex;
 
 use strict;
 
-use vars qw($VERSION $CLASS $STRICT $LAX);
+use vars qw(
+    $VERSION $CLASS $STRICT $LAX
+    $STRICT_DECIMAL_VERSION $STRICT_DOTTED_DECIMAL_VERSION
+    $LAX_DECIMAL_VERSION $LAX_DOTTED_DECIMAL_VERSION
+);
 
-$VERSION = 0.9912;
+$VERSION = 0.9918;
 
 #--------------------------------------------------------------------------#
 # Version regexp components
@@ -57,13 +61,13 @@ my $LAX_ALPHA_PART = qr/_[0-9]+/;
 
 # Strict decimal version number.
 
-my $STRICT_DECIMAL_VERSION =
+$STRICT_DECIMAL_VERSION =
     qr/ $STRICT_INTEGER_PART $FRACTION_PART? /x;
 
 # Strict dotted-decimal version number.  Must have both leading "v" and
 # at least three parts, to avoid confusion with decimal syntax.
 
-my $STRICT_DOTTED_DECIMAL_VERSION =
+$STRICT_DOTTED_DECIMAL_VERSION =
     qr/ v $STRICT_INTEGER_PART $STRICT_DOTTED_DECIMAL_PART{2,} /x;
 
 # Complete strict version number syntax -- should generally be used
@@ -80,8 +84,8 @@ $STRICT =
 # allowing an alpha suffix or allowing a leading or trailing
 # decimal-point
 
-my $LAX_DECIMAL_VERSION =
-    qr/ $LAX_INTEGER_PART (?: \. | $FRACTION_PART $LAX_ALPHA_PART? )?
+$LAX_DECIMAL_VERSION =
+    qr/ $LAX_INTEGER_PART (?: $FRACTION_PART | \. )? $LAX_ALPHA_PART?
 	|
 	$FRACTION_PART $LAX_ALPHA_PART?
     /x;
@@ -92,7 +96,7 @@ my $LAX_DECIMAL_VERSION =
 # enough, without the leading "v", Perl takes .1.2 to mean v0.1.2,
 # so when there is no "v", the leading part is optional
 
-my $LAX_DOTTED_DECIMAL_VERSION =
+$LAX_DOTTED_DECIMAL_VERSION =
     qr/
 	v $LAX_INTEGER_PART (?: $LAX_DOTTED_DECIMAL_PART+ $LAX_ALPHA_PART? )?
 	|
@@ -106,7 +110,7 @@ my $LAX_DOTTED_DECIMAL_VERSION =
 # of return values from ExtUtils::MM->parse_version
 
 $LAX =
-    qr/ undef | $LAX_DECIMAL_VERSION | $LAX_DOTTED_DECIMAL_VERSION /x;
+    qr/ undef | $LAX_DOTTED_DECIMAL_VERSION | $LAX_DECIMAL_VERSION /x;
 
 #--------------------------------------------------------------------------#
 

diff --git a/fatlib/version/vpp.pm b/fatlib/version/vpp.pm
@@ -123,7 +123,7 @@ use warnings::register;
 
 use Config;
 use vars qw($VERSION $CLASS @ISA $LAX $STRICT $WARN_CATEGORY);
-$VERSION = 0.9912;
+$VERSION = 0.9918;
 $CLASS = 'version::vpp';
 if ($] > 5.015) {
     warnings::register_categories(qw/version/);
@@ -500,7 +500,7 @@ sub scan_version {
 	$$rv->{width} = $width;
     }
 
-    while (isDIGIT($pos)) {
+    while (isDIGIT($pos) || $pos eq '_') {
 	$pos++;
     }
     if (!isALPHA($pos)) {
@@ -521,6 +521,7 @@ sub scan_version {
  		if ( !$qv && $s > $start && $saw_decimal == 1 ) {
 		    $mult *= 100;
  		    while ( $s < $end ) {
+			next if $s eq '_';
 			$orev = $rev;
  			$rev += $s * $mult;
  			$mult /= 10;
@@ -540,6 +541,7 @@ sub scan_version {
   		}
  		else {
  		    while (--$end >= $s) {
+			next if $end eq '_';
 			$orev = $rev;
  			$rev += $end * $mult;
  			$mult *= 10;
@@ -561,14 +563,7 @@ sub scan_version {
 		last;
 	    }
 	    elsif ( $pos eq '.' ) {
-		$pos++;
-		if ($qv) {
-		    # skip leading zeros
-		    while ($pos eq '0') {
-			$pos++;
-		    }
-		}
-		$s = $pos;
+		$s = ++$pos;
 	    }
 	    elsif ( $pos eq '_' && isDIGIT($pos+1) ) {
 		$s = ++$pos;
@@ -584,7 +579,7 @@ sub scan_version {
 		last;
 	    }
 	    if ( $qv ) {
-		while ( isDIGIT($pos) ) {
+		while ( isDIGIT($pos) || $pos eq '_') {
 		    $pos++;
 		}
 	    }
@@ -704,7 +699,7 @@ sub new {
     my $s = scan_version($value, \$self, $qv);
 
     if ($s) { # must be something left over
-	warn("Version string '%s' contains invalid data; "
+	warn(sprintf "Version string '%s' contains invalid data; "
 		   ."ignoring: '%s'", $value, $s);
     }
 
@@ -719,7 +714,6 @@ sub numify {
 	require Carp;
 	Carp::croak("Invalid version object");
     }
-    my $width = $self->{width} || 3;
     my $alpha = $self->{alpha} || "";
     my $len = $#{$self->{version}};
     my $digit = $self->{version}[0];
@@ -729,28 +723,12 @@ sub numify {
 	warnings::warn($WARN_CATEGORY, 'alpha->numify() is lossy');
     }
 
-    for ( my $i = 1 ; $i < $len ; $i++ ) {
+    for ( my $i = 1 ; $i <= $len ; $i++ ) {
 	$digit = $self->{version}[$i];
-	if ( $width < 3 ) {
-	    my $denom = 10**(3-$width);
-	    my $quot = int($digit/$denom);
-	    my $rem = $digit - ($quot * $denom);
-	    $string .= sprintf("%0".$width."d_%d", $quot, $rem);
-	}
-	else {
-	    $string .= sprintf("%03d", $digit);
-	}
+	$string .= sprintf("%03d", $digit);
     }
 
-    if ( $len > 0 ) {
-	$digit = $self->{version}[$len];
-	if ( $alpha && $width == 3 ) {
-	    $string .= "_";
-	}
-	$string .= sprintf("%0".$width."d", $digit);
-    }
-    else # $len = 0
-    {
+    if ( $len == 0 ) {
 	$string .= sprintf("000");
     }
 
@@ -763,28 +741,16 @@ sub normal {
 	require Carp;
 	Carp::croak("Invalid version object");
     }
-    my $alpha = $self->{alpha} || "";
-    my $qv = $self->{qv} || "";
 
     my $len = $#{$self->{version}};
     my $digit = $self->{version}[0];
     my $string = sprintf("v%d", $digit );
 
-    for ( my $i = 1 ; $i < $len ; $i++ ) {
+    for ( my $i = 1 ; $i <= $len ; $i++ ) {
 	$digit = $self->{version}[$i];
 	$string .= sprintf(".%d", $digit);
     }
 
-    if ( $len > 0 ) {
-	$digit = $self->{version}[$len];
-	if ( $alpha ) {
-	    $string .= sprintf("_%0d", $digit);
-	}
-	else {
-	    $string .= sprintf(".%0d", $digit);
-	}
-    }
-
     if ( $len <= 2 ) {
 	for ( $len = 2 - $len; $len != 0; $len-- ) {
 	    $string .= sprintf(".%0d", 0);
@@ -808,7 +774,6 @@ sub stringify {
 }
 
 sub vcmp {
-    require UNIVERSAL;
     my ($left,$right,$swap) = @_;
     my $class = ref($left);
     unless ( UNIVERSAL::isa($right, $class) ) {
@@ -838,20 +803,6 @@ sub vcmp {
 	$i++;
     }
 
-    # tiebreaker for alpha with identical terms
-    if ( $retval == 0
-	&& $l == $r
-	&& $left->{version}[$m] == $right->{version}[$m]
-	&& ( $lalpha || $ralpha ) ) {
-
-	if ( $lalpha && !$ralpha ) {
-	    $retval = -1;
-	}
-	elsif ( $ralpha && !$lalpha) {
-	    $retval = +1;
-	}
-    }
-
     # possible match except for trailing 0's
     if ( $retval == 0 && $l != $r ) {
 	if ( $l < $r ) {
@@ -973,6 +924,7 @@ sub _find_magic_vstring {
 	    $magic = $magic->MOREMAGIC;
 	}
     }
+    $tvalue =~ tr/_//d;
     return $tvalue;
 }
 

diff --git a/fatlib/version/vxs.pm b/fatlib/version/vxs.pm
@@ -0,0 +1,25 @@
+#!perl -w
+package version::vxs;
+
+use v5.10;
+use strict;
+
+use vars qw(@ISA $VERSION $CLASS );
+$VERSION = 0.9918;
+$CLASS = 'version::vxs';
+
+eval {
+    require XSLoader;
+    local $^W; # shut up the 'redefined' warning for UNIVERSAL::VERSION
+    XSLoader::load('version::vxs', $VERSION);
+    1;
+} or do {
+    require DynaLoader;
+    push @ISA, 'DynaLoader'; 
+    local $^W; # shut up the 'redefined' warning for UNIVERSAL::VERSION
+    bootstrap version::vxs $VERSION;
+};
+
+# Preloaded methods go here.
+
+1;
diff --git a/lib/App/cpanminus/script.pm b/lib/App/cpanminus/script.pm
@@ -508,21 +508,21 @@ sub version_to_query {
 
     if ($req =~ s/^==\s*//) {
         return {
-            term => { 'module.version' => $req },
+            term => { 'module.version_numified' => $self->numify_ver($req) },
         };
     } elsif ($req !~ /\s/) {
         return {
-            range => { 'module.version_numified' => { 'gte' => $self->numify_ver_metacpan($req) } },
+            range => { 'module.version_numified' => { 'gte' => $self->numify_ver($req) } },
         };
     } else {
         my %ops = qw(< lt <= lte > gt >= gte);
         my(%range, @exclusion);
         my @requirements = split /,\s*/, $req;
         for my $r (@requirements) {
             if ($r =~ s/^([<>]=?)\s*//) {
-                $range{$ops{$1}} = $self->numify_ver_metacpan($r);
+                $range{$ops{$1}} = $self->numify_ver($r);
             } elsif ($r =~ s/\!=\s*//) {
-                push @exclusion, $self->numify_ver_metacpan($r);
+                push @exclusion, $self->numify_ver($r);
             }
         }
 
@@ -532,22 +532,15 @@ sub version_to_query {
 
         if (@exclusion) {
             push @filters, {
-                not => { or => [ map { +{ term => { 'module.version_numified' => $self->numify_ver_metacpan($_) } } } @exclusion ] },
+                not => { or => [ map { +{ term => { 'module.version_numified' => $self->numify_ver($_) } } } @exclusion ] },
             };
         }
 
         return @filters;
     }
 }
 
-# Apparently MetaCPAN numifies devel releases by stripping _ first
-sub numify_ver_metacpan {
-    my($self, $ver) = @_;
-    $ver =~ s/_//g;
-    version->new($ver)->numify;
-}
-
-# version->new("1.00_00")->numify => "1.00_00" :/
+# version->new("1.02_03")->numify => "1.020300"
 sub numify_ver {
     my($self, $ver) = @_;
     eval version->new($ver)->numify;

diff --git a/xt/version_exact_alpha.t b/xt/version_exact_alpha.t
@@ -0,0 +1,15 @@
+use strict;
+use Test::More;
+use xt::Run;
+
+{
+    run 'Perl::Version~==v1.13.30';
+    like last_build_log, qr/Successfully (?:re)?installed/, 'Normalized alpha version matched';
+}
+
+{
+    run 'Perl::Version~==1.013_03';
+    like last_build_log, qr/Successfully (?:re)?installed/, 'Underscored alpha version matched';
+}
+
+done_testing;