summaryrefslogtreecommitdiff
path: root/scripts
diff options
context:
space:
mode:
authorRaphaël Hertzog <hertzog@debian.org>2009-09-29 01:10:12 +0200
committerRaphaël Hertzog <hertzog@debian.org>2009-10-04 19:18:45 +0200
commitaf5a5349f99df7c8f4698ee0d92cd2c6824c428e (patch)
tree3e76be98895cb1a0ef50387790d25bfa6ce9b082 /scripts
parent10badb3c2de113f0129988529b1e9386ed5ab0a6 (diff)
downloaddpkg-af5a5349f99df7c8f4698ee0d92cd2c6824c428e.tar.gz
Dpkg::Version: drop the old API and implementation
Switch the non-regression tests to the new API.
Diffstat (limited to 'scripts')
-rw-r--r--scripts/Dpkg/Version.pm173
-rw-r--r--scripts/t/100_Dpkg_Version.t9
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");
}