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