[p5sagit/p5-mst-13.2.git] / lib / Module / Build / Version.pm

package Module::Build::Version;
use strict;

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
    delete $version::{$_} foreach keys %version::;

    # first we get the stub version module
    my $version;
    while (<DATA>) {
	s/(\$VERSION)\s=\s\d+/\$VERSION = 0/;
	$version .= $_ if $_;
	last if /^1;$/;
    }

    # and now get the current version::vpp code
    my $vpp;
    while (<DATA>) {
	s/(\$VERSION)\s=\s\d+/\$VERSION = 0/;
	$vpp .= $_ if $_;
	last if /^1;$/;
    }

    # but we eval them in reverse order since version depends on
    # version::vpp to already exist
    eval $vpp; die $@ if $@;
    $INC{'version/vpp.pm'} = 'inside Module::Build::Version';
    eval $version; die $@ if $@;
    $INC{'version.pm'} = 'inside Module::Build::Version';
}

# now we can safely subclass version, installed or not
use vars qw(@ISA);
@ISA = qw(version);

1;
__DATA__
# stub version module to make everything else happy
package version;

use 5.005_04;
use strict;

use vars qw(@ISA $VERSION $CLASS *qv);

$VERSION = 0.000;

$CLASS = 'version';

push @ISA, "version::vpp";
*version::qv = \&version::vpp::qv;

# Preloaded methods go here.
sub import {
    my ($class) = @_;
    my $callpkg = caller();
    no strict 'refs';
    
    *{$callpkg."::qv"} = 
	    sub {return bless version::qv(shift), $class }
	unless defined(&{"$callpkg\::qv"});

}

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.74;

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

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

	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+)$//;
	}
	
	# 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 $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
	    }
	    $pos++;
	}

	if ( $alpha && !$saw_period ) {
	    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 ) {
	    $self->{qv} = 1;
	}

	if ( $alpha ) {
	    $self->{alpha} = 1;
	}

	if ( !$qv && $width < 3 ) {
	    $self->{width} = $width;
	}

	while ( substr($value,$pos,1) =~ /\d/ ) {
	    $pos++;
	}

	if ( substr($value,$pos,1) !~ /[a-z]/ ) { ### FIX THIS ###
	    my $rev;

	    while (1) {
		$rev = 0;
		{

		    # this is atoi() that delimits on underscores
		    my $end = $pos;
		    my $mult = 1;
		    my $orev;

		    # the following if() will only be true after the decimal
		    # point of a version originally created with a bare
		    # floating point number, i.e. not quoted in any way
		    if ( !$qv && $s > $start && $saw_period == 1 ) {
			$mult *= 100;
			while ( $s < $end ) {
			    $orev = $rev;
			    $rev += substr($value,$s,1) * $mult;
			    $mult /= 10;
			    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 '_' ) {
				$s++;
			    }
			}
		    }
		    else {
			while (--$end >= $s) {
			    $orev = $rev;
			    $rev += substr($value,$end,1) * $mult;
			    $mult *= 10;
			    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;
			    }
			}
		    }
		}

		# Append revision
		push @{$self->{version}}, $rev;
		if ( substr($value,$pos,1) eq '.' 
		    && 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;
		}
		else {
		    $s = $pos;
		    last;
		}
		if ( $qv ) {
		    while ( substr($value,$pos,1) =~ /\d/ ) {
			$pos++;
		    }
		}
		else {
		    my $digits = 0;
		    while (substr($value,$pos,1) =~ /[\d_]/ && $digits < 3) {
			if ( substr($value,$pos,1) ne '_' ) {
			    $digits++;
			}
			$pos++;
		    }
		}
	    }
	}
	if ( $qv ) { # quoted versions always get at least three terms
	    my $len = scalar @{$self->{version}};
	    $len = 3 - $len;
	    while ($len-- > 0) {
		push @{$self->{version}}, 0;
	    }
	}

	if ( substr($value,$pos) ) { # any remaining text
	    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);
}

sub numify 
{
    my ($self) = @_;
    unless (_verify($self)) {
	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];
    my $string = sprintf("%d.", $digit );

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

    if ( $len > 0 ) {
	$digit = $self->{version}[$len];
	if ( $alpha && $width == 3 ) {
	    $string .= "_";
	}
	$string .= sprintf("%0".$width."d", $digit);
    }
    else # $len = 0
    {
	$string .= sprintf("000");
    }

    return $string;
}

sub normal 
{
    my ($self) = @_;
    unless (_verify($self)) {
	require Carp;
	Carp::croak("Invalid version object");
    }
    my $alpha = $self->{alpha} || "";
    my $len = $#{$self->{version}};
    my $digit = $self->{version}[0];
    my $string = sprintf("v%d", $digit );

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

    return $string;
}

sub stringify
{
    my ($self) = @_;
    unless (_verify($self)) {
	require Carp;
	Carp::croak("Invalid version object");
    }
    return $self->{original};
}

sub vcmp
{
    require UNIVERSAL;
    my ($left,$right,$swap) = @_;
    my $class = ref($left);
    unless ( UNIVERSAL::isa($right, $class) ) {
	$right = $class->new($right);
    }

    if ( $swap ) {
	($left, $right) = ($right, $left);
    }
    unless (_verify($left)) {
	require Carp;
	Carp::croak("Invalid version object");
    }
    unless (_verify($right)) {
	require Carp;
	Carp::croak("Invalid version object");
    }
    my $l = $#{$left->{version}};
    my $r = $#{$right->{version}};
    my $m = $l < $r ? $l : $r;
    my $lalpha = $left->is_alpha;
    my $ralpha = $right->is_alpha;
    my $retval = 0;
    my $i = 0;
    while ( $i <= $m && $retval == 0 ) {
	$retval = $left->{version}[$i] <=> $right->{version}[$i];
	$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 ) {
	    while ( $i <= $r && $retval == 0 ) {
		if ( $right->{version}[$i] != 0 ) {
		    $retval = -1; # not a match after all
		}
		$i++;
	    }
	}
	else {
	    while ( $i <= $l && $retval == 0 ) {
		if ( $left->{version}[$i] != 0 ) {
		    $retval = +1; # not a match after all
		}
		$i++;
	    }
	}
    }

    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) = @_;

    $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 ( ref($self)
	&& eval { exists $self->{version} }
	&& ref($self->{version}) eq 'ARRAY'
	) {
	return 1;
    }
    else {
	return 0;
    }
}

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 {
	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
	    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;
		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);
		}
	    }

	    $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)
		    );
		}
	    }
	}

	return defined $version ? $version->stringify : undef;
    };
}

1; #this line is important and will help the module return a true value
Commit	Line	Data
9acf5c35	1	package Module::Build::Version;
0ec9ad96	2	use strict;
0ec9ad96	3
60ca10cf	4	use vars qw($VERSION);
738349a8	5	$VERSION = 0.74;
7a827510	6
	7	eval "use version $VERSION";
	8	if ($@) { # can't locate version files, use our own
	9
	10	# Avoid redefined warnings if an old version.pm was available
	11	delete $version::{$_} foreach keys %version::;
	12
	13	# first we get the stub version module
	14	my $version;
	15	while (<DATA>) {
	16	s/(\$VERSION)\s=\s\d+/\$VERSION = 0/;
	17	$version .= $_ if $_;
	18	last if /^1;$/;
	19	}
	20
	21	# and now get the current version::vpp code
	22	my $vpp;
	23	while (<DATA>) {
	24	s/(\$VERSION)\s=\s\d+/\$VERSION = 0/;
	25	$vpp .= $_ if $_;
	26	last if /^1;$/;
	27	}
	28
	29	# but we eval them in reverse order since version depends on
	30	# version::vpp to already exist
	31	eval $vpp; die $@ if $@;
	32	$INC{'version/vpp.pm'} = 'inside Module::Build::Version';
	33	eval $version; die $@ if $@;
	34	$INC{'version.pm'} = 'inside Module::Build::Version';
	35	}
	36
	37	# now we can safely subclass version, installed or not
	38	use vars qw(@ISA);
	39	@ISA = qw(version);
	40
	41	1;
	42	__DATA__
	43	# stub version module to make everything else happy
	44	package version;
	45
	46	use 5.005_04;
	47	use strict;
	48
	49	use vars qw(@ISA $VERSION $CLASS *qv);
	50
	51	$VERSION = 0.000;
	52
	53	$CLASS = 'version';
	54
	55	push @ISA, "version::vpp";
	56	*version::qv = \&version::vpp::qv;
	57
	58	# Preloaded methods go here.
	59	sub import {
	60	my ($class) = @_;
	61	my $callpkg = caller();
	62	no strict 'refs';
	63
	64	*{$callpkg."::qv"} =
	65	sub {return bless version::qv(shift), $class }
	66	unless defined(&{"$callpkg\::qv"});
	67
	68	}
	69
70	1;
71	# replace everything from here to the end with the current version/vpp.pm
7a827510	72	package version::vpp;
	73	use strict;
	74
	75	use locale;
	76	use vars qw ($VERSION @ISA @REGEXS);
738349a8	77	$VERSION = 0.74;
7a827510	78
	79	push @REGEXS, qr/
	80	^v? # optional leading 'v'
	81	(\d*) # major revision not required
	82	\. # requires at least one decimal
	83	(?:(\d+)\.?){1,}
	84	/x;
	85
	86	use overload (
	87	'""' => \&stringify,
	88	'0+' => \&numify,
	89	'cmp' => \&vcmp,
	90	'<=>' => \&vcmp,
	91	'bool' => \&vbool,
	92	'nomethod' => \&vnoop,
	93	);
	94
738349a8	95	my $VERSION_MAX = 0x7FFFFFFF;
	96
	97	eval "use warnings";
	98	if ($@) {
	99	eval '
	100	package warnings;
	101	sub enabled {return $^W;}
	102	1;
	103	';
	104	}
	105
7a827510	106	sub new
	107	{
	108	my ($class, $value) = @_;
	109	my $self = bless ({}, ref ($class) \|\| $class);
	110
	111	if ( ref($value) && eval("$value->isa('version')") ) {
	112	# Can copy the elements directly
	113	$self->{version} = [ @{$value->{version} } ];
	114	$self->{qv} = 1 if $value->{qv};
	115	$self->{alpha} = 1 if $value->{alpha};
	116	$self->{original} = ''.$value->{original};
	117	return $self;
	118	}
	119
	120	require POSIX;
	121	my $currlocale = POSIX::setlocale(&POSIX::LC_ALL);
	122	my $radix_comma = ( POSIX::localeconv()->{decimal_point} eq ',' );
	123
	124	if ( not defined $value or $value =~ /^undef$/ ) {
	125	# RT #19517 - special case for undef comparison
	126	# or someone forgot to pass a value
	127	push @{$self->{version}}, 0;
	128	$self->{original} = "0";
	129	return ($self);
	130	}
	131
	132	if ( $#_ == 2 ) { # must be CVS-style
	133	$value = 'v'.$_[2];
	134	}
	135
	136	$value = _un_vstring($value);
	137
	138	# exponential notation
	139	if ( $value =~ /\d+.?\d*e-?\d+/ ) {
	140	$value = sprintf("%.9f",$value);
	141	$value =~ s/(0+)$//;
	142	}
	143
	144	# if the original locale used commas for decimal points, we
	145	# just replace commas with decimal places, rather than changing
	146	# locales
	147	if ( $radix_comma ) {
	148	$value =~ tr/,/./;
	149	}
	150
	151	# This is not very efficient, but it is morally equivalent
	152	# to the XS code (as that is the reference implementation).
	153	# See vutil/vutil.c for details
	154	my $qv = 0;
	155	my $alpha = 0;
	156	my $width = 3;
	157	my $saw_period = 0;
738349a8	158	my $vinf = 0;
7a827510	159	my ($start, $last, $pos, $s);
	160	$s = 0;
	161
	162	while ( substr($value,$s,1) =~ /\s/ ) { # leading whitespace is OK
	163	$s++;
	164	}
	165
	166	if (substr($value,$s,1) eq 'v') {
	167	$s++; # get past 'v'
	168	$qv = 1; # force quoted version processing
	169	}
	170
	171	$start = $last = $pos = $s;
	172
	173	# pre-scan the input string to check for decimals/underbars
	174	while ( substr($value,$pos,1) =~ /[._\d]/ ) {
	175	if ( substr($value,$pos,1) eq '.' ) {
	176	if ($alpha) {
7a827510	177	Carp::croak("Invalid version format ".
738349a8	178	"(underscores before decimal)");
7a827510	179	}
	180	$saw_period++;
	181	$last = $pos;
	182	}
	183	elsif ( substr($value,$pos,1) eq '_' ) {
	184	if ($alpha) {
	185	require Carp;
	186	Carp::croak("Invalid version format ".
738349a8	187	"(multiple underscores)");
7a827510	188	}
	189	$alpha = 1;
	190	$width = $pos - $last - 1; # natural width of sub-version
	191	}
	192	$pos++;
	193	}
	194
	195	if ( $alpha && !$saw_period ) {
	196	require Carp;
738349a8	197	Carp::croak("Invalid version format ".
738349a8	198	"(alpha without decimal)");
7a827510	199	}
	200
	201	if ( $alpha && $saw_period && $width == 0 ) {
	202	require Carp;
738349a8	203	Carp::croak("Invalid version format ".
738349a8	204	"(misplaced _ in number)");
7a827510	205	}
	206
	207	if ( $saw_period > 1 ) {
	208	$qv = 1; # force quoted version processing
	209	}
	210
738349a8	211	$last = $pos;
7a827510	212	$pos = $s;
	213
	214	if ( $qv ) {
	215	$self->{qv} = 1;
	216	}
	217
	218	if ( $alpha ) {
	219	$self->{alpha} = 1;
	220	}
	221
	222	if ( !$qv && $width < 3 ) {
	223	$self->{width} = $width;
	224	}
	225
	226	while ( substr($value,$pos,1) =~ /\d/ ) {
	227	$pos++;
	228	}
	229
	230	if ( substr($value,$pos,1) !~ /[a-z]/ ) { ### FIX THIS ###
	231	my $rev;
	232
	233	while (1) {
	234	$rev = 0;
	235	{
	236
	237	# this is atoi() that delimits on underscores
	238	my $end = $pos;
	239	my $mult = 1;
	240	my $orev;
	241
	242	# the following if() will only be true after the decimal
	243	# point of a version originally created with a bare
	244	# floating point number, i.e. not quoted in any way
	245	if ( !$qv && $s > $start && $saw_period == 1 ) {
	246	$mult *= 100;
	247	while ( $s < $end ) {
	248	$orev = $rev;
	249	$rev += substr($value,$s,1) * $mult;
	250	$mult /= 10;
738349a8	251	if ( abs($orev) > abs($rev)
	252	\|\| abs($rev) > abs($VERSION_MAX) ) {
	253	if ( warnings::enabled("overflow") ) {
	254	require Carp;
	255	Carp::carp("Integer overflow in version");
	256	}
	257	$s = $end - 1;
	258	$rev = $VERSION_MAX;
7a827510	259	}
	260	$s++;
	261	if ( substr($value,$s,1) eq '_' ) {
	262	$s++;
	263	}
	264	}
	265	}
	266	else {
	267	while (--$end >= $s) {
	268	$orev = $rev;
	269	$rev += substr($value,$end,1) * $mult;
	270	$mult *= 10;
738349a8	271	if ( abs($orev) > abs($rev)
	272	\|\| abs($rev) > abs($VERSION_MAX) ) {
	273	if ( warnings::enabled("overflow") ) {
	274	require Carp;
	275	Carp::carp("Integer overflow in version");
	276	}
	277	$end = $s - 1;
	278	$rev = $VERSION_MAX;
7a827510	279	}
	280	}
	281	}
	282	}
	283
	284	# Append revision
	285	push @{$self->{version}}, $rev;
	286	if ( substr($value,$pos,1) eq '.'
	287	&& substr($value,$pos+1,1) =~ /\d/ ) {
	288	$s = ++$pos;
	289	}
	290	elsif ( substr($value,$pos,1) eq '_'
	291	&& substr($value,$pos+1,1) =~ /\d/ ) {
	292	$s = ++$pos;
	293	}
	294	elsif ( substr($value,$pos,1) =~ /\d/ ) {
	295	$s = $pos;
	296	}
	297	else {
	298	$s = $pos;
	299	last;
	300	}
	301	if ( $qv ) {
	302	while ( substr($value,$pos,1) =~ /\d/ ) {
	303	$pos++;
	304	}
	305	}
	306	else {
	307	my $digits = 0;
	308	while (substr($value,$pos,1) =~ /[\d_]/ && $digits < 3) {
	309	if ( substr($value,$pos,1) ne '_' ) {
	310	$digits++;
	311	}
	312	$pos++;
	313	}
	314	}
	315	}
	316	}
	317	if ( $qv ) { # quoted versions always get at least three terms
	318	my $len = scalar @{$self->{version}};
	319	$len = 3 - $len;
	320	while ($len-- > 0) {
	321	push @{$self->{version}}, 0;
	322	}
	323	}
	324
	325	if ( substr($value,$pos) ) { # any remaining text
738349a8	326	if ( warnings::enabled("misc") ) {
	327	require Carp;
	328	Carp::carp("Version string '$value' contains invalid data; ".
	329	"ignoring: '".substr($value,$pos)."'");
	330	}
7a827510	331	}
	332
	333	# cache the original value for use when stringification
738349a8	334	if ( $vinf ) {
	335	$self->{vinf} = 1;
	336	$self->{original} = 'v.Inf';
	337	}
	338	else {
	339	$self->{original} = substr($value,0,$pos);
	340	}
7a827510	341
	342	return ($self);
	343	}
	344
	345	sub numify
	346	{
	347	my ($self) = @_;
	348	unless (_verify($self)) {
	349	require Carp;
	350	Carp::croak("Invalid version object");
	351	}
	352	my $width = $self->{width} \|\| 3;
	353	my $alpha = $self->{alpha} \|\| "";
	354	my $len = $#{$self->{version}};
	355	my $digit = $self->{version}[0];
	356	my $string = sprintf("%d.", $digit );
	357
	358	for ( my $i = 1 ; $i < $len ; $i++ ) {
	359	$digit = $self->{version}[$i];
	360	if ( $width < 3 ) {
	361	my $denom = 10**(3-$width);
	362	my $quot = int($digit/$denom);
	363	my $rem = $digit - ($quot * $denom);
	364	$string .= sprintf("%0".$width."d_%d", $quot, $rem);
	365	}
	366	else {
	367	$string .= sprintf("%03d", $digit);
	368	}
	369	}
	370
	371	if ( $len > 0 ) {
	372	$digit = $self->{version}[$len];
	373	if ( $alpha && $width == 3 ) {
	374	$string .= "_";
	375	}
	376	$string .= sprintf("%0".$width."d", $digit);
	377	}
	378	else # $len = 0
	379	{
	380	$string .= sprintf("000");
	381	}
	382
	383	return $string;
	384	}
	385
	386	sub normal
	387	{
	388	my ($self) = @_;
	389	unless (_verify($self)) {
	390	require Carp;
	391	Carp::croak("Invalid version object");
	392	}
	393	my $alpha = $self->{alpha} \|\| "";
	394	my $len = $#{$self->{version}};
	395	my $digit = $self->{version}[0];
	396	my $string = sprintf("v%d", $digit );
	397
	398	for ( my $i = 1 ; $i < $len ; $i++ ) {
	399	$digit = $self->{version}[$i];
	400	$string .= sprintf(".%d", $digit);
	401	}
	402
	403	if ( $len > 0 ) {
	404	$digit = $self->{version}[$len];
405	if ( $alpha ) {
406	$string .= sprintf("_%0d", $digit);
407	}
408	else {
409	$string .= sprintf(".%0d", $digit);
410	}
411	}
412
413	if ( $len <= 2 ) {
414	for ( $len = 2 - $len; $len != 0; $len-- ) {
415	$string .= sprintf(".%0d", 0);
416	}
417	}
418
419	return $string;
420	}
421
422	sub stringify
423	{
424	my ($self) = @_;
425	unless (_verify($self)) {
426	require Carp;
427	Carp::croak("Invalid version object");
428	}
429	return $self->{original};
430	}
431
432	sub vcmp
433	{
434	require UNIVERSAL;
435	my ($left,$right,$swap) = @_;
436	my $class = ref($left);
437	unless ( UNIVERSAL::isa($right, $class) ) {
438	$right = $class->new($right);
439	}
440
441	if ( $swap ) {
442	($left, $right) = ($right, $left);
443	}
444	unless (_verify($left)) {
445	require Carp;
446	Carp::croak("Invalid version object");
447	}
448	unless (_verify($right)) {
449	require Carp;
450	Carp::croak("Invalid version object");
451	}
452	my $l = $#{$left->{version}};
453	my $r = $#{$right->{version}};
454	my $m = $l < $r ? $l : $r;
455	my $lalpha = $left->is_alpha;
456	my $ralpha = $right->is_alpha;
457	my $retval = 0;
458	my $i = 0;
459	while ( $i <= $m && $retval == 0 ) {
460	$retval = $left->{version}[$i] <=> $right->{version}[$i];
461	$i++;
462	}
463
464	# tiebreaker for alpha with identical terms
465	if ( $retval == 0
466	&& $l == $r
467	&& $left->{version}[$m] == $right->{version}[$m]
468	&& ( $lalpha \|\| $ralpha ) ) {
469
470	if ( $lalpha && !$ralpha ) {
471	$retval = -1;
472	}
473	elsif ( $ralpha && !$lalpha) {
474	$retval = +1;
475	}
476	}
477
478	# possible match except for trailing 0's
479	if ( $retval == 0 && $l != $r ) {
480	if ( $l < $r ) {
481	while ( $i <= $r && $retval == 0 ) {
482	if ( $right->{version}[$i] != 0 ) {
483	$retval = -1; # not a match after all
484	}
485	$i++;
486	}
487	}
488	else {
489	while ( $i <= $l && $retval == 0 ) {
490	if ( $left->{version}[$i] != 0 ) {
491	$retval = +1; # not a match after all
492	}
493	$i++;
494	}
495	}
496	}
497
498	return $retval;
499	}
500
501	sub vbool {
502	my ($self) = @_;
503	return vcmp($self,$self->new("0"),1);
504	}
505
506	sub vnoop {
507	require Carp;
508	Carp::croak("operation not supported with version object");
509	}
510
511	sub is_alpha {
512	my ($self) = @_;
513	return (exists $self->{alpha});
514	}
515
516	sub qv {
517	my ($value) = @_;
518
519	$value = _un_vstring($value);
520	$value = 'v'.$value unless $value =~ /(^v\|\d+\.\d+\.\d)/;
521	my $version = version->new($value); # always use base class
522	return $version;
523	}
524
525	sub is_qv {
526	my ($self) = @_;
527	return (exists $self->{qv});
528	}
529
530
531	sub _verify {
532	my ($self) = @_;
533	if ( ref($self)
534	&& eval { exists $self->{version} }
535	&& ref($self->{version}) eq 'ARRAY'
536	) {
537	return 1;
538	}
539	else {
540	return 0;
541	}
542	}
543
544	sub _un_vstring {
545	my $value = shift;
546	# may be a v-string
547	if ( $] >= 5.006_000 && length($value) >= 3 && $value !~ /[._]/ ) {
548	my $tvalue = sprintf("v%vd",$value);
549	if ( $tvalue =~ /^v\d+\.\d+\.\d+$/ ) {
550	# must be a v-string
551	$value = $tvalue;
552	}
553	}
554	return $value;
555	}
556
557	# Thanks to Yitzchak Scott-Thoennes for this mode of operation
558	{
559	local $^W;
560	*UNIVERSAL::VERSION = sub {
561	my ($obj, $req) = @_;
562	my $class = ref($obj) \|\| $obj;
563
564	no strict 'refs';
565	eval "require $class" unless %{"$class\::"}; # already existing
566	return undef if $@ =~ /Can't locate/ and not defined $req;
567
568	if ( not %{"$class\::"} and $] >= 5.008) { # file but no package
569	require Carp;
570	Carp::croak( "$class defines neither package nor VERSION"
571	."--version check failed");
572	}
573
574	my $version = eval "\$$class\::VERSION";
575	if ( defined $version ) {
576	local $^W if $] <= 5.008;
577	$version = version::vpp->new($version);
578	}
579
580	if ( defined $req ) {
581	unless ( defined $version ) {
582	require Carp;
583	my $msg = $] < 5.006
584	? "$class version $req required--this is only version "
585	: "$class does not define \$$class\::VERSION"
586	."--version check failed";
587
588	if ( $ENV{VERSION_DEBUG} ) {
589	Carp::confess($msg);
590	}
591	else {
592	Carp::croak($msg);
593	}
594	}
595
596	$req = version::vpp->new($req);
597
598	if ( $req > $version ) {
599	require Carp;
600	if ( $req->is_qv ) {
601	Carp::croak(
602	sprintf ("%s version %s required--".
603	"this is only version %s", $class,
604	$req->normal, $version->normal)
605	);
606	}
607	else {
608	Carp::croak(
609	sprintf ("%s version %s required--".
610	"this is only version %s", $class,
611	$req->stringify, $version->stringify)
612	);
613	}
614	}
615	}
616
617	return defined $version ? $version->stringify : undef;
618	};
619	}
620
621	1; #this line is important and will help the module return a true value