Author: djpig
Date: 2007-07-08 20:16:33 +0000 (Sun, 08 Jul 2007)
New Revision: 851
Modified:
branches/dpkg-shlibdeps-buxy/scripts/Dpkg/Shlibs/SymbolFile.pm
branches/dpkg-shlibdeps-buxy/scripts/Dpkg/Version.pm
branches/dpkg-shlibdeps-buxy/scripts/dpkg-gensymbols.pl
branches/dpkg-shlibdeps-buxy/scripts/dpkg-shlibdeps.pl
Log:
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
Modified: branches/dpkg-shlibdeps-buxy/scripts/Dpkg/Shlibs/SymbolFile.pm
===================================================================
--- branches/dpkg-shlibdeps-buxy/scripts/Dpkg/Shlibs/SymbolFile.pm
2007-07-08 19:56:04 UTC (rev 850)
+++ branches/dpkg-shlibdeps-buxy/scripts/Dpkg/Shlibs/SymbolFile.pm
2007-07-08 20:16:33 UTC (rev 851)
@@ -18,7 +18,7 @@
require 'dpkg-gettext.pl';
-use Dpkg::Version qw(compare_versions);
+use Dpkg::Version qw(vercmp);
sub new {
my $this = shift;
@@ -136,7 +136,7 @@
}
# 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 {
Modified: branches/dpkg-shlibdeps-buxy/scripts/Dpkg/Version.pm
===================================================================
--- branches/dpkg-shlibdeps-buxy/scripts/Dpkg/Version.pm 2007-07-08
19:56:04 UTC (rev 850)
+++ branches/dpkg-shlibdeps-buxy/scripts/Dpkg/Version.pm 2007-07-08
20:16:33 UTC (rev 851)
@@ -1,3 +1,21 @@
+# Copyright Colin Watson <[EMAIL PROTECTED]>
+# Copyright Ian Jackson <[EMAIL PROTECTED]>
+# Copyright 2007 by Don Armstrong <[EMAIL PROTECTED]>.
+
+# 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;
@@ -3,14 +21,154 @@
use warnings;
-use Exporter 'import';
-our @EXPORT_OK = qw(compare_versions);
+use Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(vercmp);
-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;
+=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 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 <[EMAIL PROTECTED]> and Colin Watson
+E<lt>[EMAIL PROTECTED]<gt>, based on the implementation in
+C<dpkg/lib/vercmp.c> by Ian Jackson and others.
+
+=cut
+
1;
Modified: branches/dpkg-shlibdeps-buxy/scripts/dpkg-gensymbols.pl
===================================================================
--- branches/dpkg-shlibdeps-buxy/scripts/dpkg-gensymbols.pl 2007-07-08
19:56:04 UTC (rev 850)
+++ branches/dpkg-shlibdeps-buxy/scripts/dpkg-gensymbols.pl 2007-07-08
20:16:33 UTC (rev 851)
@@ -12,7 +12,6 @@
}
require 'controllib.pl';
-use Dpkg::Version qw(compare_versions);
use Dpkg::Shlibs qw(@librarypaths);
use Dpkg::Shlibs::Objdump;
use Dpkg::Shlibs::SymbolFile;
Modified: branches/dpkg-shlibdeps-buxy/scripts/dpkg-shlibdeps.pl
===================================================================
--- branches/dpkg-shlibdeps-buxy/scripts/dpkg-shlibdeps.pl 2007-07-08
19:56:04 UTC (rev 850)
+++ branches/dpkg-shlibdeps-buxy/scripts/dpkg-shlibdeps.pl 2007-07-08
20:16:33 UTC (rev 851)
@@ -16,7 +16,7 @@
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 @@
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 @@
# 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}{$_};
--
To UNSUBSCRIBE, email to [EMAIL PROTECTED]
with a subject of "unsubscribe". Trouble? Contact [EMAIL PROTECTED]
