Jose Pedro Oliveira ebf9201
#line 1
Jose Pedro Oliveira ebf9201
#!perl -w
Jose Pedro Oliveira ebf9201
package version;
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
use 5.005_04;
Jose Pedro Oliveira ebf9201
use strict;
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
use vars qw(@ISA $VERSION $CLASS $STRICT $LAX *declare *qv);
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
$VERSION = 0.95;
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
$CLASS = 'version';
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
#--------------------------------------------------------------------------#
Jose Pedro Oliveira ebf9201
# Version regexp components
Jose Pedro Oliveira ebf9201
#--------------------------------------------------------------------------#
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
# Fraction part of a decimal version number.  This is a common part of
Jose Pedro Oliveira ebf9201
# both strict and lax decimal versions
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
my $FRACTION_PART = qr/\.[0-9]+/;
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
# First part of either decimal or dotted-decimal strict version number.
Jose Pedro Oliveira ebf9201
# Unsigned integer with no leading zeroes (except for zero itself) to
Jose Pedro Oliveira ebf9201
# avoid confusion with octal.
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
my $STRICT_INTEGER_PART = qr/0|[1-9][0-9]*/;
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
# First part of either decimal or dotted-decimal lax version number.
Jose Pedro Oliveira ebf9201
# Unsigned integer, but allowing leading zeros.  Always interpreted
Jose Pedro Oliveira ebf9201
# as decimal.  However, some forms of the resulting syntax give odd
Jose Pedro Oliveira ebf9201
# results if used as ordinary Perl expressions, due to how perl treats
Jose Pedro Oliveira ebf9201
# octals.  E.g.
Jose Pedro Oliveira ebf9201
#   version->new("010" ) == 10
Jose Pedro Oliveira ebf9201
#   version->new( 010  ) == 8
Jose Pedro Oliveira ebf9201
#   version->new( 010.2) == 82  # "8" . "2"
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
my $LAX_INTEGER_PART = qr/[0-9]+/;
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
# Second and subsequent part of a strict dotted-decimal version number.
Jose Pedro Oliveira ebf9201
# Leading zeroes are permitted, and the number is always decimal.
Jose Pedro Oliveira ebf9201
# Limited to three digits to avoid overflow when converting to decimal
Jose Pedro Oliveira ebf9201
# form and also avoid problematic style with excessive leading zeroes.
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
my $STRICT_DOTTED_DECIMAL_PART = qr/\.[0-9]{1,3}/;
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
# Second and subsequent part of a lax dotted-decimal version number.
Jose Pedro Oliveira ebf9201
# Leading zeroes are permitted, and the number is always decimal.  No
Jose Pedro Oliveira ebf9201
# limit on the numerical value or number of digits, so there is the
Jose Pedro Oliveira ebf9201
# possibility of overflow when converting to decimal form.
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
my $LAX_DOTTED_DECIMAL_PART = qr/\.[0-9]+/;
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
# Alpha suffix part of lax version number syntax.  Acts like a
Jose Pedro Oliveira ebf9201
# dotted-decimal part.
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
my $LAX_ALPHA_PART = qr/_[0-9]+/;
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
#--------------------------------------------------------------------------#
Jose Pedro Oliveira ebf9201
# Strict version regexp definitions
Jose Pedro Oliveira ebf9201
#--------------------------------------------------------------------------#
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
# Strict decimal version number.
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
my $STRICT_DECIMAL_VERSION =
Jose Pedro Oliveira ebf9201
    qr/ $STRICT_INTEGER_PART $FRACTION_PART? /x;
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
# Strict dotted-decimal version number.  Must have both leading "v" and
Jose Pedro Oliveira ebf9201
# at least three parts, to avoid confusion with decimal syntax.
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
my $STRICT_DOTTED_DECIMAL_VERSION =
Jose Pedro Oliveira ebf9201
    qr/ v $STRICT_INTEGER_PART $STRICT_DOTTED_DECIMAL_PART{2,} /x;
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
# Complete strict version number syntax -- should generally be used
Jose Pedro Oliveira ebf9201
# anchored: qr/ \A $STRICT \z /x
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
$STRICT =
Jose Pedro Oliveira ebf9201
    qr/ $STRICT_DECIMAL_VERSION | $STRICT_DOTTED_DECIMAL_VERSION /x;
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
#--------------------------------------------------------------------------#
Jose Pedro Oliveira ebf9201
# Lax version regexp definitions
Jose Pedro Oliveira ebf9201
#--------------------------------------------------------------------------#
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
# Lax decimal version number.  Just like the strict one except for
Jose Pedro Oliveira ebf9201
# allowing an alpha suffix or allowing a leading or trailing
Jose Pedro Oliveira ebf9201
# decimal-point
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
my $LAX_DECIMAL_VERSION =
Jose Pedro Oliveira ebf9201
    qr/ $LAX_INTEGER_PART (?: \. | $FRACTION_PART $LAX_ALPHA_PART? )?
Jose Pedro Oliveira ebf9201
	|
Jose Pedro Oliveira ebf9201
	$FRACTION_PART $LAX_ALPHA_PART?
Jose Pedro Oliveira ebf9201
    /x;
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
# Lax dotted-decimal version number.  Distinguished by having either
Jose Pedro Oliveira ebf9201
# leading "v" or at least three non-alpha parts.  Alpha part is only
Jose Pedro Oliveira ebf9201
# permitted if there are at least two non-alpha parts. Strangely
Jose Pedro Oliveira ebf9201
# enough, without the leading "v", Perl takes .1.2 to mean v0.1.2,
Jose Pedro Oliveira ebf9201
# so when there is no "v", the leading part is optional
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
my $LAX_DOTTED_DECIMAL_VERSION =
Jose Pedro Oliveira ebf9201
    qr/
Jose Pedro Oliveira ebf9201
	v $LAX_INTEGER_PART (?: $LAX_DOTTED_DECIMAL_PART+ $LAX_ALPHA_PART? )?
Jose Pedro Oliveira ebf9201
	|
Jose Pedro Oliveira ebf9201
	$LAX_INTEGER_PART? $LAX_DOTTED_DECIMAL_PART{2,} $LAX_ALPHA_PART?
Jose Pedro Oliveira ebf9201
    /x;
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
# Complete lax version number syntax -- should generally be used
Jose Pedro Oliveira ebf9201
# anchored: qr/ \A $LAX \z /x
Jose Pedro Oliveira ebf9201
#
Jose Pedro Oliveira ebf9201
# The string 'undef' is a special case to make for easier handling
Jose Pedro Oliveira ebf9201
# of return values from ExtUtils::MM->parse_version
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
$LAX =
Jose Pedro Oliveira ebf9201
    qr/ undef | $LAX_DECIMAL_VERSION | $LAX_DOTTED_DECIMAL_VERSION /x;
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
#--------------------------------------------------------------------------#
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
{
Jose Pedro Oliveira ebf9201
    local $SIG{'__DIE__'};
Jose Pedro Oliveira ebf9201
    eval "use version::vxs $VERSION";
Jose Pedro Oliveira ebf9201
    if ( $@ ) { # don't have the XS version installed
Jose Pedro Oliveira ebf9201
	eval "use version::vpp $VERSION"; # don't tempt fate
Jose Pedro Oliveira ebf9201
	die "$@" if ( $@ );
Jose Pedro Oliveira ebf9201
	push @ISA, "version::vpp";
Jose Pedro Oliveira ebf9201
	local $^W;
Jose Pedro Oliveira ebf9201
	*version::qv = \&version::vpp::qv;
Jose Pedro Oliveira ebf9201
	*version::declare = \&version::vpp::declare;
Jose Pedro Oliveira ebf9201
	*version::_VERSION = \&version::vpp::_VERSION;
Jose Pedro Oliveira ebf9201
	if ($] >= 5.009000) {
Jose Pedro Oliveira ebf9201
	    no strict 'refs';
Jose Pedro Oliveira ebf9201
	    *version::stringify = \&version::vpp::stringify;
Jose Pedro Oliveira ebf9201
	    *{'version::(""'} = \&version::vpp::stringify;
Jose Pedro Oliveira ebf9201
	    *version::new = \&version::vpp::new;
Jose Pedro Oliveira ebf9201
	    *version::parse = \&version::vpp::parse;
Jose Pedro Oliveira ebf9201
	}
Jose Pedro Oliveira ebf9201
    }
Jose Pedro Oliveira ebf9201
    else { # use XS module
Jose Pedro Oliveira ebf9201
	push @ISA, "version::vxs";
Jose Pedro Oliveira ebf9201
	local $^W;
Jose Pedro Oliveira ebf9201
	*version::declare = \&version::vxs::declare;
Jose Pedro Oliveira ebf9201
	*version::qv = \&version::vxs::qv;
Jose Pedro Oliveira ebf9201
	*version::_VERSION = \&version::vxs::_VERSION;
Jose Pedro Oliveira ebf9201
	*version::vcmp = \&version::vxs::VCMP;
Jose Pedro Oliveira ebf9201
	if ($] >= 5.009000) {
Jose Pedro Oliveira ebf9201
	    no strict 'refs';
Jose Pedro Oliveira ebf9201
	    *version::stringify = \&version::vxs::stringify;
Jose Pedro Oliveira ebf9201
	    *{'version::(""'} = \&version::vxs::stringify;
Jose Pedro Oliveira ebf9201
	    *version::new = \&version::vxs::new;
Jose Pedro Oliveira ebf9201
	    *version::parse = \&version::vxs::parse;
Jose Pedro Oliveira ebf9201
	}
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
    }
Jose Pedro Oliveira ebf9201
}
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
# Preloaded methods go here.
Jose Pedro Oliveira ebf9201
sub import {
Jose Pedro Oliveira ebf9201
    no strict 'refs';
Jose Pedro Oliveira ebf9201
    my ($class) = shift;
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
    # Set up any derived class
Jose Pedro Oliveira ebf9201
    unless ($class eq 'version') {
Jose Pedro Oliveira ebf9201
	local $^W;
Jose Pedro Oliveira ebf9201
	*{$class.'::declare'} =  \&version::declare;
Jose Pedro Oliveira ebf9201
	*{$class.'::qv'} = \&version::qv;
Jose Pedro Oliveira ebf9201
    }
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
    my %args;
Jose Pedro Oliveira ebf9201
    if (@_) { # any remaining terms are arguments
Jose Pedro Oliveira ebf9201
	map { $args{$_} = 1 } @_
Jose Pedro Oliveira ebf9201
    }
Jose Pedro Oliveira ebf9201
    else { # no parameters at all on use line
Jose Pedro Oliveira ebf9201
    	%args = 
Jose Pedro Oliveira ebf9201
	(
Jose Pedro Oliveira ebf9201
	    qv => 1,
Jose Pedro Oliveira ebf9201
	    'UNIVERSAL::VERSION' => 1,
Jose Pedro Oliveira ebf9201
	);
Jose Pedro Oliveira ebf9201
    }
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
    my $callpkg = caller();
Jose Pedro Oliveira ebf9201
    
Jose Pedro Oliveira ebf9201
    if (exists($args{declare})) {
Jose Pedro Oliveira ebf9201
	*{$callpkg.'::declare'} = 
Jose Pedro Oliveira ebf9201
	    sub {return $class->declare(shift) }
Jose Pedro Oliveira ebf9201
	  unless defined(&{$callpkg.'::declare'});
Jose Pedro Oliveira ebf9201
    }
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
    if (exists($args{qv})) {
Jose Pedro Oliveira ebf9201
	*{$callpkg.'::qv'} =
Jose Pedro Oliveira ebf9201
	    sub {return $class->qv(shift) }
Jose Pedro Oliveira ebf9201
	  unless defined(&{$callpkg.'::qv'});
Jose Pedro Oliveira ebf9201
    }
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
    if (exists($args{'UNIVERSAL::VERSION'})) {
Jose Pedro Oliveira ebf9201
	local $^W;
Jose Pedro Oliveira ebf9201
	*UNIVERSAL::VERSION 
Jose Pedro Oliveira ebf9201
		= \&version::_VERSION;
Jose Pedro Oliveira ebf9201
    }
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
    if (exists($args{'VERSION'})) {
Jose Pedro Oliveira ebf9201
	*{$callpkg.'::VERSION'} = \&version::_VERSION;
Jose Pedro Oliveira ebf9201
    }
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
    if (exists($args{'is_strict'})) {
Jose Pedro Oliveira ebf9201
	*{$callpkg.'::is_strict'} = \&version::is_strict
Jose Pedro Oliveira ebf9201
	  unless defined(&{$callpkg.'::is_strict'});
Jose Pedro Oliveira ebf9201
    }
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
    if (exists($args{'is_lax'})) {
Jose Pedro Oliveira ebf9201
	*{$callpkg.'::is_lax'} = \&version::is_lax
Jose Pedro Oliveira ebf9201
	  unless defined(&{$callpkg.'::is_lax'});
Jose Pedro Oliveira ebf9201
    }
Jose Pedro Oliveira ebf9201
}
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
sub is_strict	{ defined $_[0] && $_[0] =~ qr/ \A $STRICT \z /x }
Jose Pedro Oliveira ebf9201
sub is_lax	{ defined $_[0] && $_[0] =~ qr/ \A $LAX \z /x }
Jose Pedro Oliveira ebf9201
Jose Pedro Oliveira ebf9201
1;