package Module::Build::Version;
use strict;
-eval "use version 0.661";
+use vars qw($VERSION);
+$VERSION = 0.74;
+
+eval "use version $VERSION";
if ($@) { # can't locate version files, use our own
# Avoid redefined warnings if an old version.pm was available
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
1;
# replace everything from here to the end with the current version/vpp.pm
-
package version::vpp;
use strict;
-use Scalar::Util;
+use locale;
use vars qw ($VERSION @ISA @REGEXS);
-$VERSION = 0.67;
+$VERSION = 0.76;
push @REGEXS, qr/
^v? # optional leading 'v'
/x;
use overload (
- '""' => \&stringify,
- 'cmp' => \&vcmp,
- '<=>' => \&vcmp,
+ '""' => \&stringify,
+ '0+' => \&numify,
+ 'cmp' => \&vcmp,
+ '<=>' => \&vcmp,
+ 'bool' => \&vbool,
+ '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 ',' );
if ( not defined $value or $value =~ /^undef$/ ) {
# RT #19517 - special case for undef comparison
# or someone forgot to pass a value
push @{$self->{version}}, 0;
+ $self->{original} = "0";
return ($self);
}
$value = 'v'.$_[2];
}
- # may be a v-string
- if ( $] >= 5.006_002 && length($value) >= 3 && $value !~ /[._]/ ) {
- my $tvalue = sprintf("%vd",$value);
- if ( $tvalue =~ /^\d+\.\d+\.\d+$/ ) {
- # must be a v-string
- $value = $tvalue;
- }
- }
+ $value = _un_vstring($value);
# exponential notation
- if ( $value =~ /\d+e-?\d+/ ) {
+ if ( $value =~ /\d+.?\d*e-?\d+/ ) {
$value = sprintf("%.9f",$value);
$value =~ s/(0+)$//;
}
+ # 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
my $alpha = 0;
my $width = 3;
my $saw_period = 0;
+ my $vinf = 0;
my ($start, $last, $pos, $s);
$s = 0;
# pre-scan the input string to check for decimals/underbars
while ( substr($value,$pos,1) =~ /[._\d]/ ) {
if ( substr($value,$pos,1) eq '.' ) {
- die "Invalid version format (underscores before decimal)"
- if $alpha;
+ if ($alpha) {
+ Carp::croak("Invalid version format ".
+ "(underscores before decimal)");
+ }
$saw_period++;
$last = $pos;
}
elsif ( substr($value,$pos,1) eq '_' ) {
- die "Invalid version format (multiple underscores)"
- if $alpha;
+ if ($alpha) {
+ require Carp;
+ Carp::croak("Invalid version format ".
+ "(multiple underscores)");
+ }
$alpha = 1;
$width = $pos - $last - 1; # natural width of sub-version
}
}
if ( $alpha && !$saw_period ) {
- die "Invalid version format (alpha without decimal)";
+ require Carp;
+ Carp::croak("Invalid version format ".
+ "(alpha without decimal)");
+ }
+
+ if ( $alpha && $saw_period && $width == 0 ) {
+ require Carp;
+ Carp::croak("Invalid version format ".
+ "(misplaced _ in number)");
}
if ( $saw_period > 1 ) {
$qv = 1; # force quoted version processing
}
+ $last = $pos;
$pos = $s;
if ( $qv ) {
$orev = $rev;
$rev += substr($value,$s,1) * $mult;
$mult /= 10;
- if ( abs($orev) > abs($rev) ) {
- die "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 '_' ) {
$orev = $rev;
$rev += substr($value,$end,1) * $mult;
$mult *= 10;
- if ( abs($orev) > abs($rev) ) {
- die "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;
}
}
}
}
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);
{
my ($self) = @_;
unless (_verify($self)) {
- die "Invalid version object";
+ require Carp;
+ Carp::croak("Invalid version object");
}
my $width = $self->{width} || 3;
my $alpha = $self->{alpha} || "";
{
my ($self) = @_;
unless (_verify($self)) {
- die "Invalid version object";
+ require Carp;
+ Carp::croak("Invalid version object");
}
my $alpha = $self->{alpha} || "";
my $len = $#{$self->{version}};
{
my ($self) = @_;
unless (_verify($self)) {
- die "Invalid version object";
- }
- if ( exists $self->{qv} ) {
- return $self->normal;
- }
- else {
- return $self->numify;
+ require Carp;
+ Carp::croak("Invalid version object");
}
+ return exists $self->{original}
+ ? $self->{original}
+ : exists $self->{qv}
+ ? $self->normal
+ : $self->numify;
}
sub vcmp
($left, $right) = ($right, $left);
}
unless (_verify($left)) {
- die "Invalid version object";
+ require Carp;
+ Carp::croak("Invalid version object");
}
unless (_verify($right)) {
- die "Invalid version object";
+ require Carp;
+ Carp::croak("Invalid version object");
}
my $l = $#{$left->{version}};
my $r = $#{$right->{version}};
return $retval;
}
+sub vbool {
+ my ($self) = @_;
+ return vcmp($self,$self->new("0"),1);
+}
+
+sub vnoop {
+ require Carp;
+ Carp::croak("operation not supported with version object");
+}
+
sub is_alpha {
my ($self) = @_;
return (exists $self->{alpha});
sub qv {
my ($value) = @_;
- my $eval = eval 'Scalar::Util::isvstring($value)';
- if ( !$@ and $eval ) {
- $value = sprintf("v%vd",$value);
- }
- else {
- $value = 'v'.$value unless $value =~ /^v/;
- }
- return version->new($value); # always use base class
+ $value = _un_vstring($value);
+ $value = 'v'.$value unless $value =~ /(^v|\d+\.\d+\.\d)/;
+ my $version = version->new($value); # always use base class
+ return $version;
+}
+
+sub is_qv {
+ my ($self) = @_;
+ return (exists $self->{qv});
}
+
sub _verify {
my ($self) = @_;
- if ( Scalar::Util::reftype($self) eq 'HASH'
- && exists $self->{version}
+ if ( ref($self)
+ && eval { exists $self->{version} }
&& ref($self->{version}) eq 'ARRAY'
) {
return 1;
}
}
+sub _un_vstring {
+ my $value = shift;
+ # may be a v-string
+ if ( $] >= 5.006_000 && length($value) >= 3 && $value !~ /[._]/ ) {
+ my $tvalue = sprintf("v%vd",$value);
+ if ( $tvalue =~ /^v\d+\.\d+\.\d+$/ ) {
+ # must be a v-string
+ $value = $tvalue;
+ }
+ }
+ return $value;
+}
+
# 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;
no strict 'refs';
eval "require $class" unless %{"$class\::"}; # already existing
- die "$class defines neither package nor VERSION--version check failed"
- if $@ or not %{"$class\::"};
+ 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 ) {
- my $msg = "$class does not define ".
- "\$$class\::VERSION--version check failed";
+ 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} ) {
- require Carp;
Carp::confess($msg);
}
else {
- die($msg);
+ Carp::croak($msg);
}
}
$req = version::vpp->new($req);
if ( $req > $version ) {
- die sprintf ("%s version %s (%s) required--".
- "this is only version %s (%s)", $class,
- $req->numify, $req->normal,
- $version->numify, $version->normal);
+ 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->numify : undef;
+ return defined $version ? $version->stringify : undef;
};
}
projects / p5sagit/p5-mst-13.2.git / blobdiff