From: Frank Lichtenheld Date: Sun, 8 Jul 2007 20:16:33 +0000 (+0000) Subject: Use a pure-perl implementation of version comparison X-Git-Url: https://err.no/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=1d3477e3ef92d6e8e0e174d3003663f026417143;p=dpkg Use a pure-perl implementation of version comparison Imported from the Debbugs bzr (after comparing it with my own implementation available with packages.d.o, I preferred the one from Debbugs). Adapted all callers --- diff --git a/scripts/Dpkg/Shlibs/SymbolFile.pm b/scripts/Dpkg/Shlibs/SymbolFile.pm index e9c9b16c..43c17e1e 100644 --- a/scripts/Dpkg/Shlibs/SymbolFile.pm +++ b/scripts/Dpkg/Shlibs/SymbolFile.pm @@ -18,7 +18,7 @@ package Dpkg::Shlibs::SymbolFile; require 'dpkg-gettext.pl'; -use Dpkg::Version qw(compare_versions); +use Dpkg::Version qw(vercmp); sub new { my $this = shift; @@ -136,7 +136,7 @@ sub merge_symbols { } # We assume that the right dependency information is already # there. - if (compare_versions($minver, "lt", $info->{minver})) { + if (vercmp($minver, $info->{minver}) < 0) { $info->{minver} = $minver; } } else { diff --git a/scripts/Dpkg/Version.pm b/scripts/Dpkg/Version.pm index 7dd4e9d4..6a9a1681 100644 --- a/scripts/Dpkg/Version.pm +++ b/scripts/Dpkg/Version.pm @@ -1,17 +1,175 @@ +# Copyright Colin Watson +# Copyright Ian Jackson +# Copyright 2007 by Don Armstrong . + +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. + +# You should have received a copy of the GNU General Public License along +# with this program; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + package Dpkg::Version; use strict; use warnings; -use Exporter 'import'; -our @EXPORT_OK = qw(compare_versions); +use Exporter; +our @ISA = qw(Exporter); +our @EXPORT_OK = qw(vercmp); + +=head1 NAME + +Dpkg::Version - pure-Perl dpkg-style version comparison + +=head1 DESCRIPTION + +The Dpkg::Version module provides pure-Perl routines to compare +dpkg-style version numbers, as used in Debian packages. If you have the +libapt-pkg Perl bindings available (Debian package libapt-pkg-perl), they +may offer better performance. + +=head1 METHODS + +=over 8 + +=cut + +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; + } + if ($ver =~ /(.+)-(.+)$/) + { + $verhash{version} = $1; + $verhash{revision} = $2; + } + else + { + $verhash{version} = $ver; + $verhash{revision} = 0; + } + 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) { + return 0; + } + elsif ($x eq '~') { + return -1; + } + elsif ($x =~ /^\d$/) { + return 0; + } + elsif ($x =~ /^[A-Z]$/i) { + return ord($x); + } + else { + return ord($x) + 256; + } + } -sub compare_versions { - my ($a, $op, $b) = @_; - # TODO: maybe replace by a real full-perl versions - system("dpkg", "--compare-versions", $a, $op, $b) == 0 - or return 0; - return 1; + sub next_elem(\@){ + my $a = shift; + return @{$a} ? shift @{$a} : undef; + } + my ($val, $ref) = @_; + $val = "" if not defined $val; + $ref = "" if not defined $ref; + my @val = split //,$val; + my @ref = split //,$ref; + my $vc = next_elem @val; + my $rc = next_elem @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 = next_elem @val; $rc = next_elem @ref; + } + while (defined $vc and $vc eq '0') { + $vc = next_elem @val; + } + while (defined $rc and $rc eq '0') { + $rc = next_elem @ref; + } + while (defined $vc and $vc =~ /^\d$/ and + defined $rc and $rc =~ /^\d$/) { + $first_diff = ord($vc) - ord($rc) if !$first_diff; + $vc = next_elem @val; $rc = next_elem @ref; + } + return 1 if defined $vc and $vc =~ /^\d$/; + return -1 if defined $rc and $rc =~ /^\d$/; + return $first_diff 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}); +} + +=back + +=head1 AUTHOR + +Don Armstrong and Colin Watson +Ecjwatson@debian.orgE, based on the implementation in +C by Ian Jackson and others. + +=cut + 1; diff --git a/scripts/dpkg-gensymbols.pl b/scripts/dpkg-gensymbols.pl index c1066e04..4dbae9b2 100755 --- a/scripts/dpkg-gensymbols.pl +++ b/scripts/dpkg-gensymbols.pl @@ -12,7 +12,6 @@ BEGIN { } require 'controllib.pl'; -use Dpkg::Version qw(compare_versions); use Dpkg::Shlibs qw(@librarypaths); use Dpkg::Shlibs::Objdump; use Dpkg::Shlibs::SymbolFile; diff --git a/scripts/dpkg-shlibdeps.pl b/scripts/dpkg-shlibdeps.pl index 52a7b097..28087dfd 100755 --- a/scripts/dpkg-shlibdeps.pl +++ b/scripts/dpkg-shlibdeps.pl @@ -16,7 +16,7 @@ BEGIN { push(@INC,$dpkglibdir); } -use Dpkg::Version qw(compare_versions); +use Dpkg::Version qw(vercmp); use Dpkg::Shlibs qw(find_library); use Dpkg::Shlibs::Objdump; use Dpkg::Shlibs::SymbolFile; @@ -166,7 +166,7 @@ foreach my $file (keys %exec) { defined($dependencies{$cur_field}{$subdep})) { if ($dependencies{$cur_field}{$subdep} eq '' or - compare_versions($m, "gt", $dependencies{$cur_field}{$subdep})) + vercmp($m, $dependencies{$cur_field}{$subdep}) > 0) { $dependencies{$cur_field}{$subdep} = $m; } @@ -240,8 +240,7 @@ foreach my $field (reverse @depfields) { # Since dependencies can be versionned, we have to # verify if the dependency is stronger than the # previously seen one - if (compare_versions($depseen{$_}, "gt", - $dependencies{$field}{$_})) { + if (vercmp($depseen{$_}, $dependencies{$field}{$_}) > 0) { 0; } else { $depseen{$_} = $dependencies{$field}{$_};