Add ExtUtils::Miniperl to the list of core modules for all versions >= 5.00504
[p5sagit/p5-mst-13.2.git] / lib / Module / Build / Version.pm
index 00db2f6..8f4d78b 100644 (file)
@@ -2,10 +2,9 @@ package Module::Build::Version;
 use strict;
 
 use vars qw($VERSION);
-$VERSION = '0.58_01';
-$VERSION = eval $VERSION;
+$VERSION = 0.74;
 
-eval "use version 0.70";
+eval "use version $VERSION";
 if ($@) { # can't locate version files, use our own
 
     # Avoid redefined warnings if an old version.pm was available
@@ -39,28 +38,6 @@ if ($@) { # can't locate version files, use our own
 use vars qw(@ISA);
 @ISA = qw(version);
 
-use overload (
-    '""' => \&stringify,
-);
-
-sub new {
-    my ($class, $value) = @_;
-    my $self = $class->SUPER::new($value);
-    $self->original($value);
-    return $self;
-}
-
-sub original {
-    my $self = shift;
-    $self->{original} = shift if @_;
-    return $self->{original};
-}
-
-sub stringify {
-    my $self = shift;
-    return $self->original;
-}
-
 1;
 __DATA__
 # stub version module to make everything else happy
@@ -92,13 +69,12 @@ sub import {
 
 1;
 # replace everything from here to the end with the current version/vpp.pm
-
 package version::vpp;
 use strict;
 
 use locale;
 use vars qw ($VERSION @ISA @REGEXS);
-$VERSION = 0.71;
+$VERSION = 0.76;
 
 push @REGEXS, qr/
        ^v?     # optional leading 'v'
@@ -116,10 +92,31 @@ use overload (
     'nomethod' => \&vnoop,
 );
 
+my $VERSION_MAX = 0x7FFFFFFF;
+
+eval "use warnings";
+if ($@) {
+    eval '
+       package warnings;
+       sub enabled {return $^W;}
+       1;
+    ';
+}
+
 sub new
 {
        my ($class, $value) = @_;
        my $self = bless ({}, ref ($class) || $class);
+       
+       if ( ref($value) && eval("$value->isa('version')") ) {
+           # Can copy the elements directly
+           $self->{version} = [ @{$value->{version} } ];
+           $self->{qv} = 1 if $value->{qv};
+           $self->{alpha} = 1 if $value->{alpha};
+           $self->{original} = ''.$value->{original};
+           return $self;
+       }
+
        require POSIX;
        my $currlocale = POSIX::setlocale(&POSIX::LC_ALL);
        my $radix_comma = ( POSIX::localeconv()->{decimal_point} eq ',' );
@@ -128,6 +125,7 @@ sub new
            # RT #19517 - special case for undef comparison
            # or someone forgot to pass a value
            push @{$self->{version}}, 0;
+           $self->{original} = "0";
            return ($self);
        }
 
@@ -157,6 +155,7 @@ sub new
        my $alpha = 0;
        my $width = 3;
        my $saw_period = 0;
+       my $vinf = 0;
        my ($start, $last, $pos, $s);
        $s = 0;
 
@@ -175,9 +174,8 @@ sub new
        while ( substr($value,$pos,1) =~ /[._\d]/ ) {
            if ( substr($value,$pos,1) eq '.' ) {
                if ($alpha) {
-                   require Carp;
                    Carp::croak("Invalid version format ".
-                       "(underscores before decimal)");
+                     "(underscores before decimal)");
                }
                $saw_period++;
                $last = $pos;
@@ -186,7 +184,7 @@ sub new
                if ($alpha) {
                    require Carp;
                    Carp::croak("Invalid version format ".
-                       "(multiple underscores)");
+                       "(multiple underscores)");
                }
                $alpha = 1;
                $width = $pos - $last - 1; # natural width of sub-version
@@ -196,18 +194,21 @@ sub new
 
        if ( $alpha && !$saw_period ) {
            require Carp;
-           Carp::croak("Invalid version format (alpha without decimal)");
+           Carp::croak("Invalid version format ".
+               "(alpha without decimal)");
        }
 
        if ( $alpha && $saw_period && $width == 0 ) {
            require Carp;
-           Carp::croak("Invalid version format (misplaced _ in number)");
+           Carp::croak("Invalid version format ".
+               "(misplaced _ in number)");
        }
 
        if ( $saw_period > 1 ) {
            $qv = 1; # force quoted version processing
        }
 
+       $last = $pos;
        $pos = $s;
 
        if ( $qv ) {
@@ -247,9 +248,14 @@ sub new
                            $orev = $rev;
                            $rev += substr($value,$s,1) * $mult;
                            $mult /= 10;
-                           if ( abs($orev) > abs($rev) ) {
-                               require Carp;
-                               Carp::croak("Integer overflow in version");
+                           if (   abs($orev) > abs($rev) 
+                               || abs($rev) > abs($VERSION_MAX) ) {
+                               if ( warnings::enabled("overflow") ) {
+                                   require Carp;
+                                   Carp::carp("Integer overflow in version");
+                               }
+                               $s = $end - 1;
+                               $rev = $VERSION_MAX;
                            }
                            $s++;
                            if ( substr($value,$s,1) eq '_' ) {
@@ -262,9 +268,14 @@ sub new
                            $orev = $rev;
                            $rev += substr($value,$end,1) * $mult;
                            $mult *= 10;
-                           if ( abs($orev) > abs($rev) ) {
-                               require Carp;
-                               Carp::croak("Integer overflow in version");
+                           if (   abs($orev) > abs($rev) 
+                               || abs($rev) > abs($VERSION_MAX) ) {
+                               if ( warnings::enabled("overflow") ) {
+                                   require Carp;
+                                   Carp::carp("Integer overflow in version");
+                               }
+                               $end = $s - 1;
+                               $rev = $VERSION_MAX;
                            }
                        }
                    }
@@ -312,8 +323,20 @@ sub new
        }
 
        if ( substr($value,$pos) ) { # any remaining text
-           warn "Version string '$value' contains invalid data; ".
-                "ignoring: '".substr($value,$pos)."'";
+           if ( warnings::enabled("misc") ) {
+               require Carp;
+               Carp::carp("Version string '$value' contains invalid data; ".
+                    "ignoring: '".substr($value,$pos)."'");
+           }
+       }
+
+       # cache the original value for use when stringification
+       if ( $vinf ) {
+           $self->{vinf} = 1;
+           $self->{original} = 'v.Inf';
+       }
+       else {
+           $self->{original} = substr($value,0,$pos);
        }
 
        return ($self);
@@ -403,12 +426,11 @@ sub stringify
        require Carp;
        Carp::croak("Invalid version object");
     }
-    if ( exists $self->{qv} ) {
-       return $self->normal;
-    }
-    else {
-       return $self->numify;
-    }
+    return exists $self->{original} 
+       ? $self->{original} 
+       : exists $self->{qv} 
+           ? $self->normal
+           : $self->numify;
 }
 
 sub vcmp
@@ -499,8 +521,9 @@ sub qv {
     my ($value) = @_;
 
     $value = _un_vstring($value);
-    $value = 'v'.$value unless $value =~ /^v/;
-    return version->new($value); # always use base class
+    $value = 'v'.$value unless $value =~ /(^v|\d+\.\d+\.\d)/;
+    my $version = version->new($value); # always use base class
+    return $version;
 }
 
 sub is_qv {
@@ -526,8 +549,8 @@ sub _un_vstring {
     my $value = shift;
     # may be a v-string
     if ( $] >= 5.006_000 && length($value) >= 3 && $value !~ /[._]/ ) {
-       my $tvalue = sprintf("%vd",$value);
-       if ( $tvalue =~ /^\d+\.\d+\.\d+$/ ) {
+       my $tvalue = sprintf("v%vd",$value);
+       if ( $tvalue =~ /^v\d+\.\d+\.\d+$/ ) {
            # must be a v-string
            $value = $tvalue;
        }
@@ -538,7 +561,8 @@ sub _un_vstring {
 # Thanks to Yitzchak Scott-Thoennes for this mode of operation
 {
     local $^W;
-    *UNIVERSAL::VERSION = sub {
+    *UNIVERSAL::VERSION # Module::Build::ModuleInfo doesn't see this now
+      = sub {
        my ($obj, $req) = @_;
        my $class = ref($obj) || $obj;
 
@@ -589,13 +613,13 @@ sub _un_vstring {
                    Carp::croak( 
                        sprintf ("%s version %s required--".
                            "this is only version %s", $class,
-                           $req->numify, $version->numify)
+                           $req->stringify, $version->stringify)
                    );
                }
            }
        }
 
-       return defined $version ? $version->numify : undef;
+       return defined $version ? $version->stringify : undef;
     };
 }