Initial Commit
This commit is contained in:
699
database/perl/lib/version/Internals.pod
Normal file
699
database/perl/lib/version/Internals.pod
Normal file
@@ -0,0 +1,699 @@
|
||||
=head1 NAME
|
||||
|
||||
version::Internals - Perl extension for Version Objects
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Overloaded version objects for all modern versions of Perl. This documents
|
||||
the internal data representation and underlying code for version.pm. See
|
||||
F<version.pod> for daily usage. This document is only useful for users
|
||||
interested in the gory details.
|
||||
|
||||
=head1 WHAT IS A VERSION?
|
||||
|
||||
For the purposes of this module, a version "number" is a sequence of
|
||||
positive integer values separated by one or more decimal points and
|
||||
optionally a single underscore. This corresponds to what Perl itself
|
||||
uses for a version, as well as extending the "version as number" that
|
||||
is discussed in the various editions of the Camel book.
|
||||
|
||||
There are actually two distinct kinds of version objects:
|
||||
|
||||
=over 4
|
||||
|
||||
=item Decimal versions
|
||||
|
||||
Any version which "looks like a number", see L<Decimal Versions>. This
|
||||
also includes versions with a single decimal point and a single embedded
|
||||
underscore, see L<Alpha Versions>, even though these must be quoted
|
||||
to preserve the underscore formatting.
|
||||
|
||||
=item Dotted-Decimal versions
|
||||
|
||||
Also referred to as "Dotted-Integer", these contains more than one decimal
|
||||
point and may have an optional embedded underscore, see L<Dotted-Decimal
|
||||
Versions>. This is what is commonly used in most open source software as
|
||||
the "external" version (the one used as part of the tag or tarfile name).
|
||||
A leading 'v' character is now required and will warn if it missing.
|
||||
|
||||
=back
|
||||
|
||||
Both of these methods will produce similar version objects, in that
|
||||
the default stringification will yield the version L<Normal Form> only
|
||||
if required:
|
||||
|
||||
$v = version->new(1.002); # 1.002, but compares like 1.2.0
|
||||
$v = version->new(1.002003); # 1.002003
|
||||
$v2 = version->new("v1.2.3"); # v1.2.3
|
||||
|
||||
In specific, version numbers initialized as L<Decimal Versions> will
|
||||
stringify as they were originally created (i.e. the same string that was
|
||||
passed to C<new()>. Version numbers initialized as L<Dotted-Decimal Versions>
|
||||
will be stringified as L<Normal Form>.
|
||||
|
||||
=head2 Decimal Versions
|
||||
|
||||
These correspond to historical versions of Perl itself prior to 5.6.0,
|
||||
as well as all other modules which follow the Camel rules for the
|
||||
$VERSION scalar. A Decimal version is initialized with what looks like
|
||||
a floating point number. Leading zeros B<are> significant and trailing
|
||||
zeros are implied so that a minimum of three places is maintained
|
||||
between subversions. What this means is that any subversion (digits
|
||||
to the right of the decimal place) that contains less than three digits
|
||||
will have trailing zeros added to make up the difference, but only for
|
||||
purposes of comparison with other version objects. For example:
|
||||
|
||||
# Prints Equivalent to
|
||||
$v = version->new( 1.2); # 1.2 v1.200.0
|
||||
$v = version->new( 1.02); # 1.02 v1.20.0
|
||||
$v = version->new( 1.002); # 1.002 v1.2.0
|
||||
$v = version->new( 1.0023); # 1.0023 v1.2.300
|
||||
$v = version->new( 1.00203); # 1.00203 v1.2.30
|
||||
$v = version->new( 1.002003); # 1.002003 v1.2.3
|
||||
|
||||
All of the preceding examples are true whether or not the input value is
|
||||
quoted. The important feature is that the input value contains only a
|
||||
single decimal. See also L<Alpha Versions>.
|
||||
|
||||
IMPORTANT NOTE: As shown above, if your Decimal version contains more
|
||||
than 3 significant digits after the decimal place, it will be split on
|
||||
each multiple of 3, so 1.0003 is equivalent to v1.0.300, due to the need
|
||||
to remain compatible with Perl's own 5.005_03 == 5.5.30 interpretation.
|
||||
Any trailing zeros are ignored for mathematical comparison purposes.
|
||||
|
||||
=head2 Dotted-Decimal Versions
|
||||
|
||||
These are the newest form of versions, and correspond to Perl's own
|
||||
version style beginning with 5.6.0. Starting with Perl 5.10.0,
|
||||
and most likely Perl 6, this is likely to be the preferred form. This
|
||||
method normally requires that the input parameter be quoted, although
|
||||
Perl's after 5.8.1 can use v-strings as a special form of quoting, but
|
||||
this is highly discouraged.
|
||||
|
||||
Unlike L<Decimal Versions>, Dotted-Decimal Versions have more than
|
||||
a single decimal point, e.g.:
|
||||
|
||||
# Prints
|
||||
$v = version->new( "v1.200"); # v1.200.0
|
||||
$v = version->new("v1.20.0"); # v1.20.0
|
||||
$v = qv("v1.2.3"); # v1.2.3
|
||||
$v = qv("1.2.3"); # v1.2.3
|
||||
$v = qv("1.20"); # v1.20.0
|
||||
|
||||
In general, Dotted-Decimal Versions permit the greatest amount of freedom
|
||||
to specify a version, whereas Decimal Versions enforce a certain
|
||||
uniformity.
|
||||
|
||||
Just like L</Decimal Versions>, Dotted-Decimal Versions can be used as
|
||||
L</Alpha Versions>.
|
||||
|
||||
=head2 Alpha Versions
|
||||
|
||||
For module authors using CPAN, the convention has been to note unstable
|
||||
releases with an underscore in the version string. (See L<CPAN>.) version.pm
|
||||
follows this convention and alpha releases will test as being newer than the
|
||||
more recent stable release, and less than the next stable release. Only the
|
||||
last element may be separated by an underscore:
|
||||
|
||||
# Declaring
|
||||
use version 0.77; our $VERSION = version->declare("v1.2_3");
|
||||
|
||||
# Parsing
|
||||
$v1 = version->parse("v1.2_3");
|
||||
$v1 = version->parse("1.002_003");
|
||||
|
||||
Note that you B<must> quote the version when writing an alpha Decimal version.
|
||||
The stringified form of Decimal versions will always be the same string that
|
||||
was used to initialize the version object.
|
||||
|
||||
=head2 Regular Expressions for Version Parsing
|
||||
|
||||
A formalized definition of the legal forms for version strings is
|
||||
included in the C<version::regex> class. Primitives are included for
|
||||
common elements, although they are scoped to the file so they are useful
|
||||
for reference purposes only. There are two publicly accessible scalars
|
||||
that can be used in other code (not exported):
|
||||
|
||||
=over 4
|
||||
|
||||
=item C<$version::LAX>
|
||||
|
||||
This regexp covers all of the legal forms allowed under the current
|
||||
version string parser. This is not to say that all of these forms
|
||||
are recommended, and some of them can only be used when quoted.
|
||||
|
||||
For dotted decimals:
|
||||
|
||||
v1.2
|
||||
1.2345.6
|
||||
v1.23_4
|
||||
|
||||
The leading 'v' is optional if two or more decimals appear. If only
|
||||
a single decimal is included, then the leading 'v' is required to
|
||||
trigger the dotted-decimal parsing. A leading zero is permitted,
|
||||
though not recommended except when quoted, because of the risk that
|
||||
Perl will treat the number as octal. A trailing underscore plus one
|
||||
or more digits denotes an alpha or development release (and must be
|
||||
quoted to be parsed properly).
|
||||
|
||||
For decimal versions:
|
||||
|
||||
1
|
||||
1.2345
|
||||
1.2345_01
|
||||
|
||||
an integer portion, an optional decimal point, and optionally one or
|
||||
more digits to the right of the decimal are all required. A trailing
|
||||
underscore is permitted and a leading zero is permitted. Just like
|
||||
the lax dotted-decimal version, quoting the values is required for
|
||||
alpha/development forms to be parsed correctly.
|
||||
|
||||
=item C<$version::STRICT>
|
||||
|
||||
This regexp covers a much more limited set of formats and constitutes
|
||||
the best practices for initializing version objects. Whether you choose
|
||||
to employ decimal or dotted-decimal for is a personal preference however.
|
||||
|
||||
=over 4
|
||||
|
||||
=item v1.234.5
|
||||
|
||||
For dotted-decimal versions, a leading 'v' is required, with three or
|
||||
more sub-versions of no more than three digits. A leading 0 (zero)
|
||||
before the first sub-version (in the above example, '1') is also
|
||||
prohibited.
|
||||
|
||||
=item 2.3456
|
||||
|
||||
For decimal versions, an integer portion (no leading 0), a decimal point,
|
||||
and one or more digits to the right of the decimal are all required.
|
||||
|
||||
=back
|
||||
|
||||
=back
|
||||
|
||||
Both of the provided scalars are already compiled as regular expressions
|
||||
and do not contain either anchors or implicit groupings, so they can be
|
||||
included in your own regular expressions freely. For example, consider
|
||||
the following code:
|
||||
|
||||
($pkg, $ver) =~ /
|
||||
^[ \t]*
|
||||
use [ \t]+($PKGNAME)
|
||||
(?:[ \t]+($version::STRICT))?
|
||||
[ \t]*;
|
||||
/x;
|
||||
|
||||
This would match a line of the form:
|
||||
|
||||
use Foo::Bar::Baz v1.2.3; # legal only in Perl 5.8.1+
|
||||
|
||||
where C<$PKGNAME> is another regular expression that defines the legal
|
||||
forms for package names.
|
||||
|
||||
=head1 IMPLEMENTATION DETAILS
|
||||
|
||||
=head2 Equivalence between Decimal and Dotted-Decimal Versions
|
||||
|
||||
When Perl 5.6.0 was released, the decision was made to provide a
|
||||
transformation between the old-style decimal versions and new-style
|
||||
dotted-decimal versions:
|
||||
|
||||
5.6.0 == 5.006000
|
||||
5.005_04 == 5.5.40
|
||||
|
||||
The floating point number is taken and split first on the single decimal
|
||||
place, then each group of three digits to the right of the decimal makes up
|
||||
the next digit, and so on until the number of significant digits is exhausted,
|
||||
B<plus> enough trailing zeros to reach the next multiple of three.
|
||||
|
||||
This was the method that version.pm adopted as well. Some examples may be
|
||||
helpful:
|
||||
|
||||
equivalent
|
||||
decimal zero-padded dotted-decimal
|
||||
------- ----------- --------------
|
||||
1.2 1.200 v1.200.0
|
||||
1.02 1.020 v1.20.0
|
||||
1.002 1.002 v1.2.0
|
||||
1.0023 1.002300 v1.2.300
|
||||
1.00203 1.002030 v1.2.30
|
||||
1.002003 1.002003 v1.2.3
|
||||
|
||||
=head2 Quoting Rules
|
||||
|
||||
Because of the nature of the Perl parsing and tokenizing routines,
|
||||
certain initialization values B<must> be quoted in order to correctly
|
||||
parse as the intended version, especially when using the C<declare> or
|
||||
L</qv()> methods. While you do not have to quote decimal numbers when
|
||||
creating version objects, it is always safe to quote B<all> initial values
|
||||
when using version.pm methods, as this will ensure that what you type is
|
||||
what is used.
|
||||
|
||||
Additionally, if you quote your initializer, then the quoted value that goes
|
||||
B<in> will be exactly what comes B<out> when your $VERSION is printed
|
||||
(stringified). If you do not quote your value, Perl's normal numeric handling
|
||||
comes into play and you may not get back what you were expecting.
|
||||
|
||||
If you use a mathematic formula that resolves to a floating point number,
|
||||
you are dependent on Perl's conversion routines to yield the version you
|
||||
expect. You are pretty safe by dividing by a power of 10, for example,
|
||||
but other operations are not likely to be what you intend. For example:
|
||||
|
||||
$VERSION = version->new((qw$Revision: 1.4)[1]/10);
|
||||
print $VERSION; # yields 0.14
|
||||
$V2 = version->new(100/9); # Integer overflow in decimal number
|
||||
print $V2; # yields something like 11.111.111.100
|
||||
|
||||
Perl 5.8.1 and beyond are able to automatically quote v-strings but
|
||||
that is not possible in earlier versions of Perl. In other words:
|
||||
|
||||
$version = version->new("v2.5.4"); # legal in all versions of Perl
|
||||
$newvers = version->new(v2.5.4); # legal only in Perl >= 5.8.1
|
||||
|
||||
=head2 What about v-strings?
|
||||
|
||||
There are two ways to enter v-strings: a bare number with two or more
|
||||
decimal points, or a bare number with one or more decimal points and a
|
||||
leading 'v' character (also bare). For example:
|
||||
|
||||
$vs1 = 1.2.3; # encoded as \1\2\3
|
||||
$vs2 = v1.2; # encoded as \1\2
|
||||
|
||||
However, the use of bare v-strings to initialize version objects is
|
||||
B<strongly> discouraged in all circumstances. Also, bare
|
||||
v-strings are not completely supported in any version of Perl prior to
|
||||
5.8.1.
|
||||
|
||||
If you insist on using bare v-strings with Perl > 5.6.0, be aware of the
|
||||
following limitations:
|
||||
|
||||
1) For Perl releases 5.6.0 through 5.8.0, the v-string code merely guesses,
|
||||
based on some characteristics of v-strings. You B<must> use a three part
|
||||
version, e.g. 1.2.3 or v1.2.3 in order for this heuristic to be successful.
|
||||
|
||||
2) For Perl releases 5.8.1 and later, v-strings have changed in the Perl
|
||||
core to be magical, which means that the version.pm code can automatically
|
||||
determine whether the v-string encoding was used.
|
||||
|
||||
3) In all cases, a version created using v-strings will have a stringified
|
||||
form that has a leading 'v' character, for the simple reason that sometimes
|
||||
it is impossible to tell whether one was present initially.
|
||||
|
||||
=head2 Version Object Internals
|
||||
|
||||
version.pm provides an overloaded version object that is designed to both
|
||||
encapsulate the author's intended $VERSION assignment as well as make it
|
||||
completely natural to use those objects as if they were numbers (e.g. for
|
||||
comparisons). To do this, a version object contains both the original
|
||||
representation as typed by the author, as well as a parsed representation
|
||||
to ease comparisons. Version objects employ L<overload> methods to
|
||||
simplify code that needs to compare, print, etc the objects.
|
||||
|
||||
The internal structure of version objects is a blessed hash with several
|
||||
components:
|
||||
|
||||
bless( {
|
||||
'original' => 'v1.2.3_4',
|
||||
'alpha' => 1,
|
||||
'qv' => 1,
|
||||
'version' => [
|
||||
1,
|
||||
2,
|
||||
3,
|
||||
4
|
||||
]
|
||||
}, 'version' );
|
||||
|
||||
=over 4
|
||||
|
||||
=item original
|
||||
|
||||
A faithful representation of the value used to initialize this version
|
||||
object. The only time this will not be precisely the same characters
|
||||
that exist in the source file is if a short dotted-decimal version like
|
||||
v1.2 was used (in which case it will contain 'v1.2'). This form is
|
||||
B<STRONGLY> discouraged, in that it will confuse you and your users.
|
||||
|
||||
=item qv
|
||||
|
||||
A boolean that denotes whether this is a decimal or dotted-decimal version.
|
||||
See L<version/is_qv()>.
|
||||
|
||||
=item alpha
|
||||
|
||||
A boolean that denotes whether this is an alpha version. NOTE: that the
|
||||
underscore can only appear in the last position. See L<version/is_alpha()>.
|
||||
|
||||
=item version
|
||||
|
||||
An array of non-negative integers that is used for comparison purposes with
|
||||
other version objects.
|
||||
|
||||
=back
|
||||
|
||||
=head2 Replacement UNIVERSAL::VERSION
|
||||
|
||||
In addition to the version objects, this modules also replaces the core
|
||||
UNIVERSAL::VERSION function with one that uses version objects for its
|
||||
comparisons. The return from this operator is always the stringified form
|
||||
as a simple scalar (i.e. not an object), but the warning message generated
|
||||
includes either the stringified form or the normal form, depending on how
|
||||
it was called.
|
||||
|
||||
For example:
|
||||
|
||||
package Foo;
|
||||
$VERSION = 1.2;
|
||||
|
||||
package Bar;
|
||||
$VERSION = "v1.3.5"; # works with all Perl's (since it is quoted)
|
||||
|
||||
package main;
|
||||
use version;
|
||||
|
||||
print $Foo::VERSION; # prints 1.2
|
||||
|
||||
print $Bar::VERSION; # prints 1.003005
|
||||
|
||||
eval "use foo 10";
|
||||
print $@; # prints "foo version 10 required..."
|
||||
eval "use foo 1.3.5; # work in Perl 5.6.1 or better
|
||||
print $@; # prints "foo version 1.3.5 required..."
|
||||
|
||||
eval "use bar 1.3.6";
|
||||
print $@; # prints "bar version 1.3.6 required..."
|
||||
eval "use bar 1.004"; # note Decimal version
|
||||
print $@; # prints "bar version 1.004 required..."
|
||||
|
||||
|
||||
IMPORTANT NOTE: This may mean that code which searches for a specific
|
||||
string (to determine whether a given module is available) may need to be
|
||||
changed. It is always better to use the built-in comparison implicit in
|
||||
C<use> or C<require>, rather than manually poking at C<< class->VERSION >>
|
||||
and then doing a comparison yourself.
|
||||
|
||||
The replacement UNIVERSAL::VERSION, when used as a function, like this:
|
||||
|
||||
print $module->VERSION;
|
||||
|
||||
will also exclusively return the stringified form. See L</Stringification>
|
||||
for more details.
|
||||
|
||||
=head1 USAGE DETAILS
|
||||
|
||||
=head2 Using modules that use version.pm
|
||||
|
||||
As much as possible, the version.pm module remains compatible with all
|
||||
current code. However, if your module is using a module that has defined
|
||||
C<$VERSION> using the version class, there are a couple of things to be
|
||||
aware of. For purposes of discussion, we will assume that we have the
|
||||
following module installed:
|
||||
|
||||
package Example;
|
||||
use version; $VERSION = qv('1.2.2');
|
||||
...module code here...
|
||||
1;
|
||||
|
||||
=over 4
|
||||
|
||||
=item Decimal versions always work
|
||||
|
||||
Code of the form:
|
||||
|
||||
use Example 1.002003;
|
||||
|
||||
will always work correctly. The C<use> will perform an automatic
|
||||
C<$VERSION> comparison using the floating point number given as the first
|
||||
term after the module name (e.g. above 1.002.003). In this case, the
|
||||
installed module is too old for the requested line, so you would see an
|
||||
error like:
|
||||
|
||||
Example version 1.002003 (v1.2.3) required--this is only version 1.002002 (v1.2.2)...
|
||||
|
||||
=item Dotted-Decimal version work sometimes
|
||||
|
||||
With Perl >= 5.6.2, you can also use a line like this:
|
||||
|
||||
use Example 1.2.3;
|
||||
|
||||
and it will again work (i.e. give the error message as above), even with
|
||||
releases of Perl which do not normally support v-strings (see L<What about v-strings?> above). This has to do with that fact that C<use> only checks
|
||||
to see if the second term I<looks like a number> and passes that to the
|
||||
replacement L<UNIVERSAL::VERSION|UNIVERSAL/VERSION>. This is not true in Perl 5.005_04,
|
||||
however, so you are B<strongly encouraged> to always use a Decimal version
|
||||
in your code, even for those versions of Perl which support the Dotted-Decimal
|
||||
version.
|
||||
|
||||
=back
|
||||
|
||||
=head2 Object Methods
|
||||
|
||||
=over 4
|
||||
|
||||
=item new()
|
||||
|
||||
Like many OO interfaces, the new() method is used to initialize version
|
||||
objects. If two arguments are passed to C<new()>, the B<second> one will be
|
||||
used as if it were prefixed with "v". This is to support historical use of the
|
||||
C<qw> operator with the CVS variable $Revision, which is automatically
|
||||
incremented by CVS every time the file is committed to the repository.
|
||||
|
||||
In order to facilitate this feature, the following
|
||||
code can be employed:
|
||||
|
||||
$VERSION = version->new(qw$Revision: 2.7 $);
|
||||
|
||||
and the version object will be created as if the following code
|
||||
were used:
|
||||
|
||||
$VERSION = version->new("v2.7");
|
||||
|
||||
In other words, the version will be automatically parsed out of the
|
||||
string, and it will be quoted to preserve the meaning CVS normally
|
||||
carries for versions. The CVS $Revision$ increments differently from
|
||||
Decimal versions (i.e. 1.10 follows 1.9), so it must be handled as if
|
||||
it were a Dotted-Decimal Version.
|
||||
|
||||
A new version object can be created as a copy of an existing version
|
||||
object, either as a class method:
|
||||
|
||||
$v1 = version->new(12.3);
|
||||
$v2 = version->new($v1);
|
||||
|
||||
or as an object method:
|
||||
|
||||
$v1 = version->new(12.3);
|
||||
$v2 = $v1->new(12.3);
|
||||
|
||||
and in each case, $v1 and $v2 will be identical. NOTE: if you create
|
||||
a new object using an existing object like this:
|
||||
|
||||
$v2 = $v1->new();
|
||||
|
||||
the new object B<will not> be a clone of the existing object. In the
|
||||
example case, $v2 will be an empty object of the same type as $v1.
|
||||
|
||||
=back
|
||||
|
||||
=over 4
|
||||
|
||||
=item qv()
|
||||
|
||||
An alternate way to create a new version object is through the exported
|
||||
qv() sub. This is not strictly like other q? operators (like qq, qw),
|
||||
in that the only delimiters supported are parentheses (or spaces). It is
|
||||
the best way to initialize a short version without triggering the floating
|
||||
point interpretation. For example:
|
||||
|
||||
$v1 = qv(1.2); # v1.2.0
|
||||
$v2 = qv("1.2"); # also v1.2.0
|
||||
|
||||
As you can see, either a bare number or a quoted string can usually
|
||||
be used interchangeably, except in the case of a trailing zero, which
|
||||
must be quoted to be converted properly. For this reason, it is strongly
|
||||
recommended that all initializers to qv() be quoted strings instead of
|
||||
bare numbers.
|
||||
|
||||
To prevent the C<qv()> function from being exported to the caller's namespace,
|
||||
either use version with a null parameter:
|
||||
|
||||
use version ();
|
||||
|
||||
or just require version, like this:
|
||||
|
||||
require version;
|
||||
|
||||
Both methods will prevent the import() method from firing and exporting the
|
||||
C<qv()> sub.
|
||||
|
||||
=back
|
||||
|
||||
For the subsequent examples, the following three objects will be used:
|
||||
|
||||
$ver = version->new("1.2.3.4"); # see "Quoting Rules"
|
||||
$alpha = version->new("1.2.3_4"); # see "Alpha Versions"
|
||||
$nver = version->new(1.002); # see "Decimal Versions"
|
||||
|
||||
=over 4
|
||||
|
||||
=item Normal Form
|
||||
|
||||
For any version object which is initialized with multiple decimal
|
||||
places (either quoted or if possible v-string), or initialized using
|
||||
the L<qv()|version/qv()> operator, the stringified representation is returned in
|
||||
a normalized or reduced form (no extraneous zeros), and with a leading 'v':
|
||||
|
||||
print $ver->normal; # prints as v1.2.3.4
|
||||
print $ver->stringify; # ditto
|
||||
print $ver; # ditto
|
||||
print $nver->normal; # prints as v1.2.0
|
||||
print $nver->stringify; # prints as 1.002,
|
||||
# see "Stringification"
|
||||
|
||||
In order to preserve the meaning of the processed version, the
|
||||
normalized representation will always contain at least three sub terms.
|
||||
In other words, the following is guaranteed to always be true:
|
||||
|
||||
my $newver = version->new($ver->stringify);
|
||||
if ($newver eq $ver ) # always true
|
||||
{...}
|
||||
|
||||
=back
|
||||
|
||||
=over 4
|
||||
|
||||
=item Numification
|
||||
|
||||
Although all mathematical operations on version objects are forbidden
|
||||
by default, it is possible to retrieve a number which corresponds
|
||||
to the version object through the use of the $obj->numify
|
||||
method. For formatting purposes, when displaying a number which
|
||||
corresponds a version object, all sub versions are assumed to have
|
||||
three decimal places. So for example:
|
||||
|
||||
print $ver->numify; # prints 1.002003004
|
||||
print $nver->numify; # prints 1.002
|
||||
|
||||
Unlike the stringification operator, there is never any need to append
|
||||
trailing zeros to preserve the correct version value.
|
||||
|
||||
=back
|
||||
|
||||
=over 4
|
||||
|
||||
=item Stringification
|
||||
|
||||
The default stringification for version objects returns exactly the same
|
||||
string as was used to create it, whether you used C<new()> or C<qv()>,
|
||||
with one exception. The sole exception is if the object was created using
|
||||
C<qv()> and the initializer did not have two decimal places or a leading
|
||||
'v' (both optional), then the stringified form will have a leading 'v'
|
||||
prepended, in order to support round-trip processing.
|
||||
|
||||
For example:
|
||||
|
||||
Initialized as Stringifies to
|
||||
============== ==============
|
||||
version->new("1.2") 1.2
|
||||
version->new("v1.2") v1.2
|
||||
qv("1.2.3") 1.2.3
|
||||
qv("v1.3.5") v1.3.5
|
||||
qv("1.2") v1.2 ### exceptional case
|
||||
|
||||
See also L<UNIVERSAL::VERSION|UNIVERSAL/VERSION>, as this also returns the stringified form
|
||||
when used as a class method.
|
||||
|
||||
IMPORTANT NOTE: There is one exceptional cases shown in the above table
|
||||
where the "initializer" is not stringwise equivalent to the stringified
|
||||
representation. If you use the C<qv>() operator on a version without a
|
||||
leading 'v' B<and> with only a single decimal place, the stringified output
|
||||
will have a leading 'v', to preserve the sense. See the L</qv()> operator
|
||||
for more details.
|
||||
|
||||
IMPORTANT NOTE 2: Attempting to bypass the normal stringification rules by
|
||||
manually applying L<numify()|version/numify()> and L<normal()|version/normal()> will sometimes yield
|
||||
surprising results:
|
||||
|
||||
print version->new(version->new("v1.0")->numify)->normal; # v1.0.0
|
||||
|
||||
The reason for this is that the L<numify()|version/numify()> operator will turn "v1.0"
|
||||
into the equivalent string "1.000000". Forcing the outer version object
|
||||
to L<normal()|version/normal()> form will display the mathematically equivalent "v1.0.0".
|
||||
|
||||
As the example in L</new()> shows, you can always create a copy of an
|
||||
existing version object with the same value by the very compact:
|
||||
|
||||
$v2 = $v1->new($v1);
|
||||
|
||||
and be assured that both C<$v1> and C<$v2> will be completely equivalent,
|
||||
down to the same internal representation as well as stringification.
|
||||
|
||||
=back
|
||||
|
||||
=over 4
|
||||
|
||||
=item Comparison operators
|
||||
|
||||
Both C<cmp> and C<E<lt>=E<gt>> operators perform the same comparison between
|
||||
terms (upgrading to a version object automatically). Perl automatically
|
||||
generates all of the other comparison operators based on those two.
|
||||
In addition to the obvious equalities listed below, appending a single
|
||||
trailing 0 term does not change the value of a version for comparison
|
||||
purposes. In other words "v1.2" and "1.2.0" will compare as identical.
|
||||
|
||||
For example, the following relations hold:
|
||||
|
||||
As Number As String Truth Value
|
||||
------------- ---------------- -----------
|
||||
$ver > 1.0 $ver gt "1.0" true
|
||||
$ver < 2.5 $ver lt true
|
||||
$ver != 1.3 $ver ne "1.3" true
|
||||
$ver == 1.2 $ver eq "1.2" false
|
||||
$ver == 1.2.3.4 $ver eq "1.2.3.4" see discussion below
|
||||
|
||||
It is probably best to chose either the Decimal notation or the string
|
||||
notation and stick with it, to reduce confusion. Perl6 version objects
|
||||
B<may> only support Decimal comparisons. See also L<Quoting Rules>.
|
||||
|
||||
WARNING: Comparing version with unequal numbers of decimal points (whether
|
||||
explicitly or implicitly initialized), may yield unexpected results at
|
||||
first glance. For example, the following inequalities hold:
|
||||
|
||||
version->new(0.96) > version->new(0.95); # 0.960.0 > 0.950.0
|
||||
version->new("0.96.1") < version->new(0.95); # 0.096.1 < 0.950.0
|
||||
|
||||
For this reason, it is best to use either exclusively L<Decimal Versions> or
|
||||
L<Dotted-Decimal Versions> with multiple decimal points.
|
||||
|
||||
=back
|
||||
|
||||
=over 4
|
||||
|
||||
=item Logical Operators
|
||||
|
||||
If you need to test whether a version object
|
||||
has been initialized, you can simply test it directly:
|
||||
|
||||
$vobj = version->new($something);
|
||||
if ( $vobj ) # true only if $something was non-blank
|
||||
|
||||
You can also test whether a version object is an alpha version, for
|
||||
example to prevent the use of some feature not present in the main
|
||||
release:
|
||||
|
||||
$vobj = version->new("1.2_3"); # MUST QUOTE
|
||||
...later...
|
||||
if ( $vobj->is_alpha ) # True
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
John Peacock E<lt>jpeacock@cpan.orgE<gt>
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<perl>.
|
||||
|
||||
=cut
|
||||
115
database/perl/lib/version/regex.pm
Normal file
115
database/perl/lib/version/regex.pm
Normal file
@@ -0,0 +1,115 @@
|
||||
package version::regex;
|
||||
|
||||
use strict;
|
||||
|
||||
our $VERSION = 0.9928;
|
||||
|
||||
#--------------------------------------------------------------------------#
|
||||
# Version regexp components
|
||||
#--------------------------------------------------------------------------#
|
||||
|
||||
# Fraction part of a decimal version number. This is a common part of
|
||||
# both strict and lax decimal versions
|
||||
|
||||
my $FRACTION_PART = qr/\.[0-9]+/;
|
||||
|
||||
# First part of either decimal or dotted-decimal strict version number.
|
||||
# Unsigned integer with no leading zeroes (except for zero itself) to
|
||||
# avoid confusion with octal.
|
||||
|
||||
my $STRICT_INTEGER_PART = qr/0|[1-9][0-9]*/;
|
||||
|
||||
# First part of either decimal or dotted-decimal lax version number.
|
||||
# Unsigned integer, but allowing leading zeros. Always interpreted
|
||||
# as decimal. However, some forms of the resulting syntax give odd
|
||||
# results if used as ordinary Perl expressions, due to how perl treats
|
||||
# octals. E.g.
|
||||
# version->new("010" ) == 10
|
||||
# version->new( 010 ) == 8
|
||||
# version->new( 010.2) == 82 # "8" . "2"
|
||||
|
||||
my $LAX_INTEGER_PART = qr/[0-9]+/;
|
||||
|
||||
# Second and subsequent part of a strict dotted-decimal version number.
|
||||
# Leading zeroes are permitted, and the number is always decimal.
|
||||
# Limited to three digits to avoid overflow when converting to decimal
|
||||
# form and also avoid problematic style with excessive leading zeroes.
|
||||
|
||||
my $STRICT_DOTTED_DECIMAL_PART = qr/\.[0-9]{1,3}/;
|
||||
|
||||
# Second and subsequent part of a lax dotted-decimal version number.
|
||||
# Leading zeroes are permitted, and the number is always decimal. No
|
||||
# limit on the numerical value or number of digits, so there is the
|
||||
# possibility of overflow when converting to decimal form.
|
||||
|
||||
my $LAX_DOTTED_DECIMAL_PART = qr/\.[0-9]+/;
|
||||
|
||||
# Alpha suffix part of lax version number syntax. Acts like a
|
||||
# dotted-decimal part.
|
||||
|
||||
my $LAX_ALPHA_PART = qr/_[0-9]+/;
|
||||
|
||||
#--------------------------------------------------------------------------#
|
||||
# Strict version regexp definitions
|
||||
#--------------------------------------------------------------------------#
|
||||
|
||||
# Strict decimal version number.
|
||||
|
||||
our $STRICT_DECIMAL_VERSION =
|
||||
qr/ $STRICT_INTEGER_PART $FRACTION_PART? /x;
|
||||
|
||||
# Strict dotted-decimal version number. Must have both leading "v" and
|
||||
# at least three parts, to avoid confusion with decimal syntax.
|
||||
|
||||
our $STRICT_DOTTED_DECIMAL_VERSION =
|
||||
qr/ v $STRICT_INTEGER_PART $STRICT_DOTTED_DECIMAL_PART{2,} /x;
|
||||
|
||||
# Complete strict version number syntax -- should generally be used
|
||||
# anchored: qr/ \A $STRICT \z /x
|
||||
|
||||
our $STRICT =
|
||||
qr/ $STRICT_DECIMAL_VERSION | $STRICT_DOTTED_DECIMAL_VERSION /x;
|
||||
|
||||
#--------------------------------------------------------------------------#
|
||||
# Lax version regexp definitions
|
||||
#--------------------------------------------------------------------------#
|
||||
|
||||
# Lax decimal version number. Just like the strict one except for
|
||||
# allowing an alpha suffix or allowing a leading or trailing
|
||||
# decimal-point
|
||||
|
||||
our $LAX_DECIMAL_VERSION =
|
||||
qr/ $LAX_INTEGER_PART (?: $FRACTION_PART | \. )? $LAX_ALPHA_PART?
|
||||
|
|
||||
$FRACTION_PART $LAX_ALPHA_PART?
|
||||
/x;
|
||||
|
||||
# Lax dotted-decimal version number. Distinguished by having either
|
||||
# leading "v" or at least three non-alpha parts. Alpha part is only
|
||||
# permitted if there are at least two non-alpha parts. Strangely
|
||||
# enough, without the leading "v", Perl takes .1.2 to mean v0.1.2,
|
||||
# so when there is no "v", the leading part is optional
|
||||
|
||||
our $LAX_DOTTED_DECIMAL_VERSION =
|
||||
qr/
|
||||
v $LAX_INTEGER_PART (?: $LAX_DOTTED_DECIMAL_PART+ $LAX_ALPHA_PART? )?
|
||||
|
|
||||
$LAX_INTEGER_PART? $LAX_DOTTED_DECIMAL_PART{2,} $LAX_ALPHA_PART?
|
||||
/x;
|
||||
|
||||
# Complete lax version number syntax -- should generally be used
|
||||
# anchored: qr/ \A $LAX \z /x
|
||||
#
|
||||
# The string 'undef' is a special case to make for easier handling
|
||||
# of return values from ExtUtils::MM->parse_version
|
||||
|
||||
our $LAX =
|
||||
qr/ undef | $LAX_DOTTED_DECIMAL_VERSION | $LAX_DECIMAL_VERSION /x;
|
||||
|
||||
#--------------------------------------------------------------------------#
|
||||
|
||||
# Preloaded methods go here.
|
||||
sub is_strict { defined $_[0] && $_[0] =~ qr/ \A $STRICT \z /x }
|
||||
sub is_lax { defined $_[0] && $_[0] =~ qr/ \A $LAX \z /x }
|
||||
|
||||
1;
|
||||
992
database/perl/lib/version/vpp.pm
Normal file
992
database/perl/lib/version/vpp.pm
Normal file
@@ -0,0 +1,992 @@
|
||||
package charstar;
|
||||
# a little helper class to emulate C char* semantics in Perl
|
||||
# so that prescan_version can use the same code as in C
|
||||
|
||||
use overload (
|
||||
'""' => \&thischar,
|
||||
'0+' => \&thischar,
|
||||
'++' => \&increment,
|
||||
'--' => \&decrement,
|
||||
'+' => \&plus,
|
||||
'-' => \&minus,
|
||||
'*' => \&multiply,
|
||||
'cmp' => \&cmp,
|
||||
'<=>' => \&spaceship,
|
||||
'bool' => \&thischar,
|
||||
'=' => \&clone,
|
||||
);
|
||||
|
||||
sub new {
|
||||
my ($self, $string) = @_;
|
||||
my $class = ref($self) || $self;
|
||||
|
||||
my $obj = {
|
||||
string => [split(//,$string)],
|
||||
current => 0,
|
||||
};
|
||||
return bless $obj, $class;
|
||||
}
|
||||
|
||||
sub thischar {
|
||||
my ($self) = @_;
|
||||
my $last = $#{$self->{string}};
|
||||
my $curr = $self->{current};
|
||||
if ($curr >= 0 && $curr <= $last) {
|
||||
return $self->{string}->[$curr];
|
||||
}
|
||||
else {
|
||||
return '';
|
||||
}
|
||||
}
|
||||
|
||||
sub increment {
|
||||
my ($self) = @_;
|
||||
$self->{current}++;
|
||||
}
|
||||
|
||||
sub decrement {
|
||||
my ($self) = @_;
|
||||
$self->{current}--;
|
||||
}
|
||||
|
||||
sub plus {
|
||||
my ($self, $offset) = @_;
|
||||
my $rself = $self->clone;
|
||||
$rself->{current} += $offset;
|
||||
return $rself;
|
||||
}
|
||||
|
||||
sub minus {
|
||||
my ($self, $offset) = @_;
|
||||
my $rself = $self->clone;
|
||||
$rself->{current} -= $offset;
|
||||
return $rself;
|
||||
}
|
||||
|
||||
sub multiply {
|
||||
my ($left, $right, $swapped) = @_;
|
||||
my $char = $left->thischar();
|
||||
return $char * $right;
|
||||
}
|
||||
|
||||
sub spaceship {
|
||||
my ($left, $right, $swapped) = @_;
|
||||
unless (ref($right)) { # not an object already
|
||||
$right = $left->new($right);
|
||||
}
|
||||
return $left->{current} <=> $right->{current};
|
||||
}
|
||||
|
||||
sub cmp {
|
||||
my ($left, $right, $swapped) = @_;
|
||||
unless (ref($right)) { # not an object already
|
||||
if (length($right) == 1) { # comparing single character only
|
||||
return $left->thischar cmp $right;
|
||||
}
|
||||
$right = $left->new($right);
|
||||
}
|
||||
return $left->currstr cmp $right->currstr;
|
||||
}
|
||||
|
||||
sub bool {
|
||||
my ($self) = @_;
|
||||
my $char = $self->thischar;
|
||||
return ($char ne '');
|
||||
}
|
||||
|
||||
sub clone {
|
||||
my ($left, $right, $swapped) = @_;
|
||||
$right = {
|
||||
string => [@{$left->{string}}],
|
||||
current => $left->{current},
|
||||
};
|
||||
return bless $right, ref($left);
|
||||
}
|
||||
|
||||
sub currstr {
|
||||
my ($self, $s) = @_;
|
||||
my $curr = $self->{current};
|
||||
my $last = $#{$self->{string}};
|
||||
if (defined($s) && $s->{current} < $last) {
|
||||
$last = $s->{current};
|
||||
}
|
||||
|
||||
my $string = join('', @{$self->{string}}[$curr..$last]);
|
||||
return $string;
|
||||
}
|
||||
|
||||
package version::vpp;
|
||||
|
||||
use 5.006002;
|
||||
use strict;
|
||||
use warnings::register;
|
||||
|
||||
use Config;
|
||||
|
||||
our $VERSION = 0.9928;
|
||||
our $CLASS = 'version::vpp';
|
||||
our ($LAX, $STRICT, $WARN_CATEGORY);
|
||||
|
||||
if ($] > 5.015) {
|
||||
warnings::register_categories(qw/version/);
|
||||
$WARN_CATEGORY = 'version';
|
||||
} else {
|
||||
$WARN_CATEGORY = 'numeric';
|
||||
}
|
||||
|
||||
require version::regex;
|
||||
*version::vpp::is_strict = \&version::regex::is_strict;
|
||||
*version::vpp::is_lax = \&version::regex::is_lax;
|
||||
*LAX = \$version::regex::LAX;
|
||||
*STRICT = \$version::regex::STRICT;
|
||||
|
||||
use overload (
|
||||
'""' => \&stringify,
|
||||
'0+' => \&numify,
|
||||
'cmp' => \&vcmp,
|
||||
'<=>' => \&vcmp,
|
||||
'bool' => \&vbool,
|
||||
'+' => \&vnoop,
|
||||
'-' => \&vnoop,
|
||||
'*' => \&vnoop,
|
||||
'/' => \&vnoop,
|
||||
'+=' => \&vnoop,
|
||||
'-=' => \&vnoop,
|
||||
'*=' => \&vnoop,
|
||||
'/=' => \&vnoop,
|
||||
'abs' => \&vnoop,
|
||||
);
|
||||
|
||||
sub import {
|
||||
no strict 'refs';
|
||||
my ($class) = shift;
|
||||
|
||||
# Set up any derived class
|
||||
unless ($class eq $CLASS) {
|
||||
local $^W;
|
||||
*{$class.'::declare'} = \&{$CLASS.'::declare'};
|
||||
*{$class.'::qv'} = \&{$CLASS.'::qv'};
|
||||
}
|
||||
|
||||
my %args;
|
||||
if (@_) { # any remaining terms are arguments
|
||||
map { $args{$_} = 1 } @_
|
||||
}
|
||||
else { # no parameters at all on use line
|
||||
%args =
|
||||
(
|
||||
qv => 1,
|
||||
'UNIVERSAL::VERSION' => 1,
|
||||
);
|
||||
}
|
||||
|
||||
my $callpkg = caller();
|
||||
|
||||
if (exists($args{declare})) {
|
||||
*{$callpkg.'::declare'} =
|
||||
sub {return $class->declare(shift) }
|
||||
unless defined(&{$callpkg.'::declare'});
|
||||
}
|
||||
|
||||
if (exists($args{qv})) {
|
||||
*{$callpkg.'::qv'} =
|
||||
sub {return $class->qv(shift) }
|
||||
unless defined(&{$callpkg.'::qv'});
|
||||
}
|
||||
|
||||
if (exists($args{'UNIVERSAL::VERSION'})) {
|
||||
no warnings qw/redefine/;
|
||||
*UNIVERSAL::VERSION
|
||||
= \&{$CLASS.'::_VERSION'};
|
||||
}
|
||||
|
||||
if (exists($args{'VERSION'})) {
|
||||
*{$callpkg.'::VERSION'} = \&{$CLASS.'::_VERSION'};
|
||||
}
|
||||
|
||||
if (exists($args{'is_strict'})) {
|
||||
*{$callpkg.'::is_strict'} = \&{$CLASS.'::is_strict'}
|
||||
unless defined(&{$callpkg.'::is_strict'});
|
||||
}
|
||||
|
||||
if (exists($args{'is_lax'})) {
|
||||
*{$callpkg.'::is_lax'} = \&{$CLASS.'::is_lax'}
|
||||
unless defined(&{$callpkg.'::is_lax'});
|
||||
}
|
||||
}
|
||||
|
||||
my $VERSION_MAX = 0x7FFFFFFF;
|
||||
|
||||
# implement prescan_version as closely to the C version as possible
|
||||
use constant TRUE => 1;
|
||||
use constant FALSE => 0;
|
||||
|
||||
sub isDIGIT {
|
||||
my ($char) = shift->thischar();
|
||||
return ($char =~ /\d/);
|
||||
}
|
||||
|
||||
sub isALPHA {
|
||||
my ($char) = shift->thischar();
|
||||
return ($char =~ /[a-zA-Z]/);
|
||||
}
|
||||
|
||||
sub isSPACE {
|
||||
my ($char) = shift->thischar();
|
||||
return ($char =~ /\s/);
|
||||
}
|
||||
|
||||
sub BADVERSION {
|
||||
my ($s, $errstr, $error) = @_;
|
||||
if ($errstr) {
|
||||
$$errstr = $error;
|
||||
}
|
||||
return $s;
|
||||
}
|
||||
|
||||
sub prescan_version {
|
||||
my ($s, $strict, $errstr, $sqv, $ssaw_decimal, $swidth, $salpha) = @_;
|
||||
my $qv = defined $sqv ? $$sqv : FALSE;
|
||||
my $saw_decimal = defined $ssaw_decimal ? $$ssaw_decimal : 0;
|
||||
my $width = defined $swidth ? $$swidth : 3;
|
||||
my $alpha = defined $salpha ? $$salpha : FALSE;
|
||||
|
||||
my $d = $s;
|
||||
|
||||
if ($qv && isDIGIT($d)) {
|
||||
goto dotted_decimal_version;
|
||||
}
|
||||
|
||||
if ($d eq 'v') { # explicit v-string
|
||||
$d++;
|
||||
if (isDIGIT($d)) {
|
||||
$qv = TRUE;
|
||||
}
|
||||
else { # degenerate v-string
|
||||
# requires v1.2.3
|
||||
return BADVERSION($s,$errstr,"Invalid version format (dotted-decimal versions require at least three parts)");
|
||||
}
|
||||
|
||||
dotted_decimal_version:
|
||||
if ($strict && $d eq '0' && isDIGIT($d+1)) {
|
||||
# no leading zeros allowed
|
||||
return BADVERSION($s,$errstr,"Invalid version format (no leading zeros)");
|
||||
}
|
||||
|
||||
while (isDIGIT($d)) { # integer part
|
||||
$d++;
|
||||
}
|
||||
|
||||
if ($d eq '.')
|
||||
{
|
||||
$saw_decimal++;
|
||||
$d++; # decimal point
|
||||
}
|
||||
else
|
||||
{
|
||||
if ($strict) {
|
||||
# require v1.2.3
|
||||
return BADVERSION($s,$errstr,"Invalid version format (dotted-decimal versions require at least three parts)");
|
||||
}
|
||||
else {
|
||||
goto version_prescan_finish;
|
||||
}
|
||||
}
|
||||
|
||||
{
|
||||
my $i = 0;
|
||||
my $j = 0;
|
||||
while (isDIGIT($d)) { # just keep reading
|
||||
$i++;
|
||||
while (isDIGIT($d)) {
|
||||
$d++; $j++;
|
||||
# maximum 3 digits between decimal
|
||||
if ($strict && $j > 3) {
|
||||
return BADVERSION($s,$errstr,"Invalid version format (maximum 3 digits between decimals)");
|
||||
}
|
||||
}
|
||||
if ($d eq '_') {
|
||||
if ($strict) {
|
||||
return BADVERSION($s,$errstr,"Invalid version format (no underscores)");
|
||||
}
|
||||
if ( $alpha ) {
|
||||
return BADVERSION($s,$errstr,"Invalid version format (multiple underscores)");
|
||||
}
|
||||
$d++;
|
||||
$alpha = TRUE;
|
||||
}
|
||||
elsif ($d eq '.') {
|
||||
if ($alpha) {
|
||||
return BADVERSION($s,$errstr,"Invalid version format (underscores before decimal)");
|
||||
}
|
||||
$saw_decimal++;
|
||||
$d++;
|
||||
}
|
||||
elsif (!isDIGIT($d)) {
|
||||
last;
|
||||
}
|
||||
$j = 0;
|
||||
}
|
||||
|
||||
if ($strict && $i < 2) {
|
||||
# requires v1.2.3
|
||||
return BADVERSION($s,$errstr,"Invalid version format (dotted-decimal versions require at least three parts)");
|
||||
}
|
||||
}
|
||||
} # end if dotted-decimal
|
||||
else
|
||||
{ # decimal versions
|
||||
my $j = 0;
|
||||
# special $strict case for leading '.' or '0'
|
||||
if ($strict) {
|
||||
if ($d eq '.') {
|
||||
return BADVERSION($s,$errstr,"Invalid version format (0 before decimal required)");
|
||||
}
|
||||
if ($d eq '0' && isDIGIT($d+1)) {
|
||||
return BADVERSION($s,$errstr,"Invalid version format (no leading zeros)");
|
||||
}
|
||||
}
|
||||
|
||||
# and we never support negative version numbers
|
||||
if ($d eq '-') {
|
||||
return BADVERSION($s,$errstr,"Invalid version format (negative version number)");
|
||||
}
|
||||
|
||||
# consume all of the integer part
|
||||
while (isDIGIT($d)) {
|
||||
$d++;
|
||||
}
|
||||
|
||||
# look for a fractional part
|
||||
if ($d eq '.') {
|
||||
# we found it, so consume it
|
||||
$saw_decimal++;
|
||||
$d++;
|
||||
}
|
||||
elsif (!$d || $d eq ';' || isSPACE($d) || $d eq '}') {
|
||||
if ( $d == $s ) {
|
||||
# found nothing
|
||||
return BADVERSION($s,$errstr,"Invalid version format (version required)");
|
||||
}
|
||||
# found just an integer
|
||||
goto version_prescan_finish;
|
||||
}
|
||||
elsif ( $d == $s ) {
|
||||
# didn't find either integer or period
|
||||
return BADVERSION($s,$errstr,"Invalid version format (non-numeric data)");
|
||||
}
|
||||
elsif ($d eq '_') {
|
||||
# underscore can't come after integer part
|
||||
if ($strict) {
|
||||
return BADVERSION($s,$errstr,"Invalid version format (no underscores)");
|
||||
}
|
||||
elsif (isDIGIT($d+1)) {
|
||||
return BADVERSION($s,$errstr,"Invalid version format (alpha without decimal)");
|
||||
}
|
||||
else {
|
||||
return BADVERSION($s,$errstr,"Invalid version format (misplaced underscore)");
|
||||
}
|
||||
}
|
||||
elsif ($d) {
|
||||
# anything else after integer part is just invalid data
|
||||
return BADVERSION($s,$errstr,"Invalid version format (non-numeric data)");
|
||||
}
|
||||
|
||||
# scan the fractional part after the decimal point
|
||||
if ($d && !isDIGIT($d) && ($strict || ! ($d eq ';' || isSPACE($d) || $d eq '}') )) {
|
||||
# $strict or lax-but-not-the-end
|
||||
return BADVERSION($s,$errstr,"Invalid version format (fractional part required)");
|
||||
}
|
||||
|
||||
while (isDIGIT($d)) {
|
||||
$d++; $j++;
|
||||
if ($d eq '.' && isDIGIT($d-1)) {
|
||||
if ($alpha) {
|
||||
return BADVERSION($s,$errstr,"Invalid version format (underscores before decimal)");
|
||||
}
|
||||
if ($strict) {
|
||||
return BADVERSION($s,$errstr,"Invalid version format (dotted-decimal versions must begin with 'v')");
|
||||
}
|
||||
$d = $s; # start all over again
|
||||
$qv = TRUE;
|
||||
goto dotted_decimal_version;
|
||||
}
|
||||
if ($d eq '_') {
|
||||
if ($strict) {
|
||||
return BADVERSION($s,$errstr,"Invalid version format (no underscores)");
|
||||
}
|
||||
if ( $alpha ) {
|
||||
return BADVERSION($s,$errstr,"Invalid version format (multiple underscores)");
|
||||
}
|
||||
if ( ! isDIGIT($d+1) ) {
|
||||
return BADVERSION($s,$errstr,"Invalid version format (misplaced underscore)");
|
||||
}
|
||||
$width = $j;
|
||||
$d++;
|
||||
$alpha = TRUE;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
version_prescan_finish:
|
||||
while (isSPACE($d)) {
|
||||
$d++;
|
||||
}
|
||||
|
||||
if ($d && !isDIGIT($d) && (! ($d eq ';' || $d eq '}') )) {
|
||||
# trailing non-numeric data
|
||||
return BADVERSION($s,$errstr,"Invalid version format (non-numeric data)");
|
||||
}
|
||||
if ($saw_decimal > 1 && ($d-1) eq '.') {
|
||||
# no trailing period allowed
|
||||
return BADVERSION($s,$errstr,"Invalid version format (trailing decimal)");
|
||||
}
|
||||
|
||||
if (defined $sqv) {
|
||||
$$sqv = $qv;
|
||||
}
|
||||
if (defined $swidth) {
|
||||
$$swidth = $width;
|
||||
}
|
||||
if (defined $ssaw_decimal) {
|
||||
$$ssaw_decimal = $saw_decimal;
|
||||
}
|
||||
if (defined $salpha) {
|
||||
$$salpha = $alpha;
|
||||
}
|
||||
return $d;
|
||||
}
|
||||
|
||||
sub scan_version {
|
||||
my ($s, $rv, $qv) = @_;
|
||||
my $start;
|
||||
my $pos;
|
||||
my $last;
|
||||
my $errstr;
|
||||
my $saw_decimal = 0;
|
||||
my $width = 3;
|
||||
my $alpha = FALSE;
|
||||
my $vinf = FALSE;
|
||||
my @av;
|
||||
|
||||
$s = new charstar $s;
|
||||
|
||||
while (isSPACE($s)) { # leading whitespace is OK
|
||||
$s++;
|
||||
}
|
||||
|
||||
$last = prescan_version($s, FALSE, \$errstr, \$qv, \$saw_decimal,
|
||||
\$width, \$alpha);
|
||||
|
||||
if ($errstr) {
|
||||
# 'undef' is a special case and not an error
|
||||
if ( $s ne 'undef') {
|
||||
require Carp;
|
||||
Carp::croak($errstr);
|
||||
}
|
||||
}
|
||||
|
||||
$start = $s;
|
||||
if ($s eq 'v') {
|
||||
$s++;
|
||||
}
|
||||
$pos = $s;
|
||||
|
||||
if ( $qv ) {
|
||||
$$rv->{qv} = $qv;
|
||||
}
|
||||
if ( $alpha ) {
|
||||
$$rv->{alpha} = $alpha;
|
||||
}
|
||||
if ( !$qv && $width < 3 ) {
|
||||
$$rv->{width} = $width;
|
||||
}
|
||||
|
||||
while (isDIGIT($pos) || $pos eq '_') {
|
||||
$pos++;
|
||||
}
|
||||
if (!isALPHA($pos)) {
|
||||
my $rev;
|
||||
|
||||
for (;;) {
|
||||
$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_decimal == 1 ) {
|
||||
$mult *= 100;
|
||||
while ( $s < $end ) {
|
||||
next if $s eq '_';
|
||||
$orev = $rev;
|
||||
$rev += $s * $mult;
|
||||
$mult /= 10;
|
||||
if ( (abs($orev) > abs($rev))
|
||||
|| (abs($rev) > $VERSION_MAX )) {
|
||||
warn("Integer overflow in version %d",
|
||||
$VERSION_MAX);
|
||||
$s = $end - 1;
|
||||
$rev = $VERSION_MAX;
|
||||
$vinf = 1;
|
||||
}
|
||||
$s++;
|
||||
if ( $s eq '_' ) {
|
||||
$s++;
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
while (--$end >= $s) {
|
||||
next if $end eq '_';
|
||||
$orev = $rev;
|
||||
$rev += $end * $mult;
|
||||
$mult *= 10;
|
||||
if ( (abs($orev) > abs($rev))
|
||||
|| (abs($rev) > $VERSION_MAX )) {
|
||||
warn("Integer overflow in version");
|
||||
$end = $s - 1;
|
||||
$rev = $VERSION_MAX;
|
||||
$vinf = 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Append revision
|
||||
push @av, $rev;
|
||||
if ( $vinf ) {
|
||||
$s = $last;
|
||||
last;
|
||||
}
|
||||
elsif ( $pos eq '.' ) {
|
||||
$s = ++$pos;
|
||||
}
|
||||
elsif ( $pos eq '_' && isDIGIT($pos+1) ) {
|
||||
$s = ++$pos;
|
||||
}
|
||||
elsif ( $pos eq ',' && isDIGIT($pos+1) ) {
|
||||
$s = ++$pos;
|
||||
}
|
||||
elsif ( isDIGIT($pos) ) {
|
||||
$s = $pos;
|
||||
}
|
||||
else {
|
||||
$s = $pos;
|
||||
last;
|
||||
}
|
||||
if ( $qv ) {
|
||||
while ( isDIGIT($pos) || $pos eq '_') {
|
||||
$pos++;
|
||||
}
|
||||
}
|
||||
else {
|
||||
my $digits = 0;
|
||||
while ( ( isDIGIT($pos) || $pos eq '_' ) && $digits < 3 ) {
|
||||
if ( $pos ne '_' ) {
|
||||
$digits++;
|
||||
}
|
||||
$pos++;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
if ( $qv ) { # quoted versions always get at least three terms
|
||||
my $len = $#av;
|
||||
# This for loop appears to trigger a compiler bug on OS X, as it
|
||||
# loops infinitely. Yes, len is negative. No, it makes no sense.
|
||||
# Compiler in question is:
|
||||
# gcc version 3.3 20030304 (Apple Computer, Inc. build 1640)
|
||||
# for ( len = 2 - len; len > 0; len-- )
|
||||
# av_push(MUTABLE_AV(sv), newSViv(0));
|
||||
#
|
||||
$len = 2 - $len;
|
||||
while ($len-- > 0) {
|
||||
push @av, 0;
|
||||
}
|
||||
}
|
||||
|
||||
# need to save off the current version string for later
|
||||
if ( $vinf ) {
|
||||
$$rv->{original} = "v.Inf";
|
||||
$$rv->{vinf} = 1;
|
||||
}
|
||||
elsif ( $s > $start ) {
|
||||
$$rv->{original} = $start->currstr($s);
|
||||
if ( $qv && $saw_decimal == 1 && $start ne 'v' ) {
|
||||
# need to insert a v to be consistent
|
||||
$$rv->{original} = 'v' . $$rv->{original};
|
||||
}
|
||||
}
|
||||
else {
|
||||
$$rv->{original} = '0';
|
||||
push(@av, 0);
|
||||
}
|
||||
|
||||
# And finally, store the AV in the hash
|
||||
$$rv->{version} = \@av;
|
||||
|
||||
# fix RT#19517 - special case 'undef' as string
|
||||
if ($s eq 'undef') {
|
||||
$s += 5;
|
||||
}
|
||||
|
||||
return $s;
|
||||
}
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
unless (defined $class or $#_ > 1) {
|
||||
require Carp;
|
||||
Carp::croak('Usage: version::new(class, version)');
|
||||
}
|
||||
|
||||
my $self = bless ({}, ref ($class) || $class);
|
||||
my $qv = FALSE;
|
||||
|
||||
if ( $#_ == 1 ) { # must be CVS-style
|
||||
$qv = TRUE;
|
||||
}
|
||||
my $value = pop; # always going to be the last element
|
||||
|
||||
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;
|
||||
}
|
||||
|
||||
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 (ref($value) =~ m/ARRAY|HASH/) {
|
||||
require Carp;
|
||||
Carp::croak("Invalid version format (non-numeric data)");
|
||||
}
|
||||
|
||||
$value = _un_vstring($value);
|
||||
|
||||
if ($Config{d_setlocale}) {
|
||||
use POSIX qw/locale_h/;
|
||||
use if $Config{d_setlocale}, 'locale';
|
||||
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/,/./;
|
||||
}
|
||||
}
|
||||
|
||||
# exponential notation
|
||||
if ( $value =~ /\d+.?\d*e[-+]?\d+/ ) {
|
||||
$value = sprintf("%.9f",$value);
|
||||
$value =~ s/(0+)$//; # trim trailing zeros
|
||||
}
|
||||
|
||||
my $s = scan_version($value, \$self, $qv);
|
||||
|
||||
if ($s) { # must be something left over
|
||||
warn(sprintf "Version string '%s' contains invalid data; "
|
||||
."ignoring: '%s'", $value, $s);
|
||||
}
|
||||
|
||||
return ($self);
|
||||
}
|
||||
|
||||
*parse = \&new;
|
||||
|
||||
sub numify {
|
||||
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("%d.", $digit );
|
||||
|
||||
if ($alpha and warnings::enabled()) {
|
||||
warnings::warn($WARN_CATEGORY, 'alpha->numify() is lossy');
|
||||
}
|
||||
|
||||
for ( my $i = 1 ; $i <= $len ; $i++ ) {
|
||||
$digit = $self->{version}[$i];
|
||||
$string .= sprintf("%03d", $digit);
|
||||
}
|
||||
|
||||
if ( $len == 0 ) {
|
||||
$string .= sprintf("000");
|
||||
}
|
||||
|
||||
return $string;
|
||||
}
|
||||
|
||||
sub normal {
|
||||
my ($self) = @_;
|
||||
unless (_verify($self)) {
|
||||
require Carp;
|
||||
Carp::croak("Invalid version object");
|
||||
}
|
||||
|
||||
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 <= 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 exists $self->{original}
|
||||
? $self->{original}
|
||||
: exists $self->{qv}
|
||||
? $self->normal
|
||||
: $self->numify;
|
||||
}
|
||||
|
||||
sub vcmp {
|
||||
my ($left,$right,$swap) = @_;
|
||||
die "Usage: version::vcmp(lobj, robj, ...)" if @_ < 2;
|
||||
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 format");
|
||||
}
|
||||
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++;
|
||||
}
|
||||
|
||||
# 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 = shift;
|
||||
my $class = $CLASS;
|
||||
if (@_) {
|
||||
$class = ref($value) || $value;
|
||||
$value = shift;
|
||||
}
|
||||
|
||||
$value = _un_vstring($value);
|
||||
$value = 'v'.$value unless $value =~ /(^v|\d+\.\d+\.\d)/;
|
||||
my $obj = $CLASS->new($value);
|
||||
return bless $obj, $class;
|
||||
}
|
||||
|
||||
*declare = \&qv;
|
||||
|
||||
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 _is_non_alphanumeric {
|
||||
my $s = shift;
|
||||
$s = new charstar $s;
|
||||
while ($s) {
|
||||
return 0 if isSPACE($s); # early out
|
||||
return 1 unless (isALPHA($s) || isDIGIT($s) || $s =~ /[.-]/);
|
||||
$s++;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub _un_vstring {
|
||||
my $value = shift;
|
||||
# may be a v-string
|
||||
if ( length($value) >= 1 && $value !~ /[,._]/
|
||||
&& _is_non_alphanumeric($value)) {
|
||||
my $tvalue;
|
||||
if ( $] >= 5.008_001 ) {
|
||||
$tvalue = _find_magic_vstring($value);
|
||||
$value = $tvalue if length $tvalue;
|
||||
}
|
||||
elsif ( $] >= 5.006_000 ) {
|
||||
$tvalue = sprintf("v%vd",$value);
|
||||
if ( $tvalue =~ /^v\d+(\.\d+)*$/ ) {
|
||||
# must be a v-string
|
||||
$value = $tvalue;
|
||||
}
|
||||
}
|
||||
}
|
||||
return $value;
|
||||
}
|
||||
|
||||
sub _find_magic_vstring {
|
||||
my $value = shift;
|
||||
my $tvalue = '';
|
||||
require B;
|
||||
my $sv = B::svref_2object(\$value);
|
||||
my $magic = ref($sv) eq 'B::PVMG' ? $sv->MAGIC : undef;
|
||||
while ( $magic ) {
|
||||
if ( $magic->TYPE eq 'V' ) {
|
||||
$tvalue = $magic->PTR;
|
||||
$tvalue =~ s/^v?(.+)$/v$1/;
|
||||
last;
|
||||
}
|
||||
else {
|
||||
$magic = $magic->MOREMAGIC;
|
||||
}
|
||||
}
|
||||
$tvalue =~ tr/_//d;
|
||||
return $tvalue;
|
||||
}
|
||||
|
||||
sub _VERSION {
|
||||
my ($obj, $req) = @_;
|
||||
my $class = ref($obj) || $obj;
|
||||
|
||||
no strict 'refs';
|
||||
if ( exists $INC{"$class.pm"} and 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
|
||||
25
database/perl/lib/version/vxs.pm
Normal file
25
database/perl/lib/version/vxs.pm
Normal file
@@ -0,0 +1,25 @@
|
||||
#!perl -w
|
||||
package version::vxs;
|
||||
|
||||
use v5.10;
|
||||
use strict;
|
||||
|
||||
our $VERSION = 0.9928;
|
||||
our $CLASS = 'version::vxs';
|
||||
our @ISA;
|
||||
|
||||
eval {
|
||||
require XSLoader;
|
||||
local $^W; # shut up the 'redefined' warning for UNIVERSAL::VERSION
|
||||
XSLoader::load('version::vxs', $VERSION);
|
||||
1;
|
||||
} or do {
|
||||
require DynaLoader;
|
||||
push @ISA, 'DynaLoader';
|
||||
local $^W; # shut up the 'redefined' warning for UNIVERSAL::VERSION
|
||||
bootstrap version::vxs $VERSION;
|
||||
};
|
||||
|
||||
# Preloaded methods go here.
|
||||
|
||||
1;
|
||||
Reference in New Issue
Block a user