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

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

use vars qw($VERSION);
$VERSION = '0.58_01';
$VERSION = eval $VERSION;

eval "use version 0.70";
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);

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

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

sub new
{
	my ($class, $value) = @_;
	my $self = bless ({}, ref ($class) || $class);
	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;
	    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 ($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) {
		    require Carp;
		    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
	}

	$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) ) {
				require Carp;
				Carp::croak("Integer overflow in version");
			    }
			    $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) ) {
				require Carp;
				Carp::croak("Integer overflow in version");
			    }
			}
		    }
		}

		# 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
	    warn "Version string '$value' contains invalid data; ".
	         "ignoring: '".substr($value,$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");
    }
    if ( exists $self->{qv} ) {
	return $self->normal;
    }
    else {
	return $self->numify;
    }
}

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/;
    return version->new($value); # always use base class
}

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("%vd",$value);
	if ( $tvalue =~ /^\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->numify, $version->numify)
		    );
		}
	    }
	}

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