diff options
-rw-r--r-- | scripts/Dpkg/Version.pm | 173 | ||||
-rw-r--r-- | scripts/t/100_Dpkg_Version.t | 9 |
2 files changed, 5 insertions, 177 deletions
diff --git a/scripts/Dpkg/Version.pm b/scripts/Dpkg/Version.pm index 382cb3763..a24999c5c 100644 --- a/scripts/Dpkg/Version.pm +++ b/scripts/Dpkg/Version.pm @@ -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 diff --git a/scripts/t/100_Dpkg_Version.t b/scripts/t/100_Dpkg_Version.t index b36db1ca8..2dc095751 100644 --- a/scripts/t/100_Dpkg_Version.t +++ b/scripts/t/100_Dpkg_Version.t @@ -36,7 +36,7 @@ sub obj_vercmp { return $a gt $b if $cmp eq "gt"; } -use_ok('Dpkg::Version', qw(vercmp compare_versions)); +use_ok('Dpkg::Version'); my $truth = { "-1" => { @@ -67,15 +67,16 @@ foreach my $case (@tests) { my $va = Dpkg::Version->new($a); my $vb = Dpkg::Version->new($b); - is(vercmp($a, $b), $res, "$a cmp $b => $res"); + is(version_compare($a, $b), $res, "$a cmp $b => $res"); is($va <=> $vb, $res, "Dpkg::Version($a) <=> Dpkg::Version($b) => $res"); foreach my $op (@ops) { + my $norm_op = version_normalize_cmp_op($op); if ($truth->{$res}{$op}) { - ok(compare_versions($a, $op, $b), "$a $op $b => true"); + ok(version_compare_op($a, $norm_op, $b), "$a $op $b => true"); ok(obj_vercmp($va, $op, $vb), "Dpkg::Version($a) $op Dpkg::Version($b) => true"); ok(dpkg_vercmp($a, $op, $b), "dpkg --compare-versions $a $op $b => true"); } else { - ok(!compare_versions($a, $op, $b), "$a $op $b => false"); + ok(!version_compare_op($a, $norm_op, $b), "$a $op $b => false"); ok(!obj_vercmp($va, $op, $vb), "Dpkg::Version($a) $op Dpkg::Version($b) => false"); ok(!dpkg_vercmp($a, $op, $b), "dpkg --compare-versions $a $op $b => false"); } |