view release on metacpan or  search on metacpan

inc/inc_Module-Build/Module/Build/Version.pm  view on Meta::CPAN

$VERSION = eval $VERSION;

push @REGEXS, qr/
	^v?	# optional leading 'v'
	(\d*)	# major revision not required
	\.	# requires at least one decimal
	(?:(\d+)\.?){1,}
	/x;

use overload (
    '""'       => \&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;
	}

	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
	    push @{$self->{version}}, 0;
	    $self->{original} = "0";
	    return ($self);
	}

	if ( $#_ == 2 ) { # must be CVS-style
	    $value = 'v'.$_[2];
	}

	$value = _un_vstring($value);

	# exponential notation
	if ( $value =~ /\d+.?\d*e[-+]?\d+/ ) {
	    $value = sprintf("%.9f",$value);
	    $value =~ s/(0+)$//; # trim trailing zeros
	}

	# 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 $qv = 0;
	my $alpha = 0;
	my $width = 3;
	my $saw_period = 0;
	my $vinf = 0;
	my ($start, $last, $pos, $s);
	$s = 0;

	while ( substr($value,$s,1) =~ /\s/ ) { # leading whitespace is OK
	    $s++;
	}

	if (substr($value,$s,1) eq 'v') {
	    $s++;    # get past 'v'
	    $qv = 1; # force quoted version processing
	}

	$start = $last = $pos = $s;

	# pre-scan the input string to check for decimals/underbars
	while ( substr($value,$pos,1) =~ /[._\d,]/ ) {
	    if ( substr($value,$pos,1) eq '.' ) {
		if ($alpha) {
		    Carp::croak("Invalid version format ".
		      "(underscores before decimal)");
		}
		$saw_period++;
		$last = $pos;
	    }
	    elsif ( substr($value,$pos,1) eq '_' ) {
		if ($alpha) {
		    require Carp;
		    Carp::croak("Invalid version format ".
			"(multiple underscores)");
		}
		$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++;
	}