|
|
@@ -30,7 +30,6 @@ our @EXPORT = qw(version_compare version_compare_op
|
|
|
version_normalize_cmp_op version_compare_string
|
|
|
version_compare_part version_split_digits version_check
|
|
|
CMP_OP_LT CMP_OP_LE CMP_OP_EQ CMP_OP_GE CMP_OP_GT);
|
|
|
-our @EXPORT_OK = qw(vercmp compare_versions check_version parseversion);
|
|
|
|
|
|
use constant {
|
|
|
CMP_OP_LT => '<<',
|
|
|
@@ -354,178 +353,6 @@ sub version_check($) {
|
|
|
return 1;
|
|
|
}
|
|
|
|
|
|
-
|
|
|
-sub parseversion ($)
|
|
|
-{
|
|
|
- my $ver = shift;
|
|
|
- my %verhash;
|
|
|
- if ($ver =~ /:/)
|
|
|
- {
|
|
|
- $ver =~ /^(\d+):(.+)/ or die "bad version number '$ver'";
|
|
|
- $verhash{epoch} = $1;
|
|
|
- $ver = $2;
|
|
|
- }
|
|
|
- else
|
|
|
- {
|
|
|
- $verhash{epoch} = 0;
|
|
|
- $verhash{no_epoch} = 1;
|
|
|
- }
|
|
|
- if ($ver =~ /(.+)-(.*)$/)
|
|
|
- {
|
|
|
- $verhash{version} = $1;
|
|
|
- $verhash{revision} = $2;
|
|
|
- }
|
|
|
- else
|
|
|
- {
|
|
|
- $verhash{version} = $ver;
|
|
|
- $verhash{revision} = 0;
|
|
|
- $verhash{no_revision} = 1;
|
|
|
- }
|
|
|
- return %verhash;
|
|
|
-}
|
|
|
-
|
|
|
-# verrevcmp
|
|
|
-
|
|
|
-# This function is almost exactly equivalent
|
|
|
-# to dpkg's verrevcmp function, including the
|
|
|
-# order subroutine which it uses.
|
|
|
-
|
|
|
-sub verrevcmp($$)
|
|
|
-{
|
|
|
-
|
|
|
- sub _order{
|
|
|
- my ($x) = @_;
|
|
|
- ##define order(x) ((x) == '~' ? -1 \
|
|
|
- # : cisdigit((x)) ? 0 \
|
|
|
- # : !(x) ? 0 \
|
|
|
- # : cisalpha((x)) ? (x) \
|
|
|
- # : (x) + 256)
|
|
|
- # This comparison is out of dpkg's order to avoid
|
|
|
- # comparing things to undef and triggering warnings.
|
|
|
- if (not defined $x or not length $x) {
|
|
|
- return 0;
|
|
|
- }
|
|
|
- elsif ($x eq '~') {
|
|
|
- return -1;
|
|
|
- }
|
|
|
- elsif ($x =~ /^\d$/) {
|
|
|
- return 0;
|
|
|
- }
|
|
|
- elsif ($x =~ /^[A-Za-z]$/) {
|
|
|
- return ord($x);
|
|
|
- }
|
|
|
- else {
|
|
|
- return ord($x) + 256;
|
|
|
- }
|
|
|
- }
|
|
|
-
|
|
|
- my ($val, $ref) = @_;
|
|
|
- $val = "" if not defined $val;
|
|
|
- $ref = "" if not defined $ref;
|
|
|
- my @val = split //,$val;
|
|
|
- my @ref = split //,$ref;
|
|
|
- my $vc = shift @val;
|
|
|
- my $rc = shift @ref;
|
|
|
- while (defined $vc or defined $rc) {
|
|
|
- my $first_diff = 0;
|
|
|
- while ((defined $vc and $vc !~ /^\d$/) or
|
|
|
- (defined $rc and $rc !~ /^\d$/)) {
|
|
|
- my $vo = _order($vc); my $ro = _order($rc);
|
|
|
- # Unlike dpkg's verrevcmp, we only return 1 or -1 here.
|
|
|
- return (($vo - $ro > 0) ? 1 : -1) if $vo != $ro;
|
|
|
- $vc = shift @val; $rc = shift @ref;
|
|
|
- }
|
|
|
- while (defined $vc and $vc eq '0') {
|
|
|
- $vc = shift @val;
|
|
|
- }
|
|
|
- while (defined $rc and $rc eq '0') {
|
|
|
- $rc = shift @ref;
|
|
|
- }
|
|
|
- while (defined $vc and $vc =~ /^\d$/ and
|
|
|
- defined $rc and $rc =~ /^\d$/) {
|
|
|
- $first_diff = ord($vc) - ord($rc) if !$first_diff;
|
|
|
- $vc = shift @val; $rc = shift @ref;
|
|
|
- }
|
|
|
- return 1 if defined $vc and $vc =~ /^\d$/;
|
|
|
- return -1 if defined $rc and $rc =~ /^\d$/;
|
|
|
- return (($first_diff > 0) ? 1 : -1) if $first_diff;
|
|
|
- }
|
|
|
- return 0;
|
|
|
-}
|
|
|
-
|
|
|
-=item vercmp
|
|
|
-
|
|
|
-Compare the two arguments as dpkg-style version numbers. Returns -1 if the
|
|
|
-first argument represents a lower version number than the second, 1 if the
|
|
|
-first argument represents a higher version number than the second, and 0 if
|
|
|
-the two arguments represent equal version numbers.
|
|
|
-
|
|
|
-=cut
|
|
|
-
|
|
|
-sub vercmp ($$)
|
|
|
-{
|
|
|
- my %version = parseversion $_[0];
|
|
|
- my %refversion = parseversion $_[1];
|
|
|
- return 1 if $version{epoch} > $refversion{epoch};
|
|
|
- return -1 if $version{epoch} < $refversion{epoch};
|
|
|
- my $r = verrevcmp($version{version}, $refversion{version});
|
|
|
- return $r if $r;
|
|
|
- return verrevcmp($version{revision}, $refversion{revision});
|
|
|
-}
|
|
|
-
|
|
|
-=item compare_versions
|
|
|
-
|
|
|
-Emulates dpkg --compare-versions. Takes two versions as arguments
|
|
|
-one and three and one operator as argument two. Supports the following
|
|
|
-operators: 'gt', 'ge', 'eq', 'le', 'lt', and '>>', '>=', '=', '<=', '<<'.
|
|
|
-Returns a true value if the specified condition is true, a false value
|
|
|
-otherwise.
|
|
|
-
|
|
|
-=cut
|
|
|
-
|
|
|
-sub compare_versions ($$$)
|
|
|
-{
|
|
|
- my $rel = $_[1];
|
|
|
- my $res = vercmp($_[0], $_[2]);
|
|
|
-
|
|
|
- warning("operator %s is deprecated in compare_versions(): use %s or %s",
|
|
|
- $rel, "$rel$rel", "$rel=") if ($rel eq '>' or $rel eq '<');
|
|
|
-
|
|
|
- if ($rel eq 'gt' or $rel eq '>>') {
|
|
|
- return $res > 0;
|
|
|
- } elsif ($rel eq 'ge' or $rel eq '>=' or $rel eq '>') {
|
|
|
- return $res >= 0;
|
|
|
- } elsif ($rel eq 'eq' or $rel eq '=') {
|
|
|
- return $res == 0;
|
|
|
- } elsif ($rel eq 'le' or $rel eq '<=' or $rel eq '<') {
|
|
|
- return $res <= 0;
|
|
|
- } elsif ($rel eq 'lt' or $rel eq '<<') {
|
|
|
- return $res < 0;
|
|
|
- } else {
|
|
|
- die "bad relation '$rel'";
|
|
|
- }
|
|
|
-}
|
|
|
-
|
|
|
-=item check_version($version, $die)
|
|
|
-
|
|
|
-If $die is false (or unset), returns true if the version is valid and
|
|
|
-false if it contains illegal characters. If $die is true, it dies with
|
|
|
-an error message if it contains illegal characters, otherwise it returns
|
|
|
-true.
|
|
|
-
|
|
|
-=cut
|
|
|
-
|
|
|
-sub check_version ($;$) {
|
|
|
- my ($version, $die) = @_;
|
|
|
- $version ||= "";
|
|
|
-
|
|
|
- if ($version =~ m/[^-+:.0-9a-zA-Z~]/o) {
|
|
|
- error(_g("version number contains illegal character `%s'"), $&) if $die;
|
|
|
- return 0;
|
|
|
- }
|
|
|
- return 1;
|
|
|
-}
|
|
|
-
|
|
|
=back
|
|
|
|
|
|
=head1 AUTHOR
|