From 10badb3c2de113f0129988529b1e9386ed5ab0a6 Mon Sep 17 00:00:00 2001 From: Raphaël Hertzog Date: Tue, 29 Sep 2009 01:06:50 +0200 Subject: Update all Perl modules and scripts to use the new Dpkg::Version API --- scripts/Dpkg/Changelog.pm | 10 +++--- scripts/Dpkg/Deps.pm | 65 ++++++++++++++++++++------------------- scripts/Dpkg/Shlibs/SymbolFile.pm | 8 ++--- scripts/Dpkg/Source/Package.pm | 11 ++++--- scripts/dpkg-buildpackage.pl | 5 +-- scripts/dpkg-genchanges.pl | 12 +++++--- scripts/dpkg-scanpackages.pl | 14 +++------ scripts/dpkg-shlibdeps.pl | 11 ++++--- scripts/dpkg-source.pl | 5 +-- 9 files changed, 72 insertions(+), 69 deletions(-) (limited to 'scripts') diff --git a/scripts/Dpkg/Changelog.pm b/scripts/Dpkg/Changelog.pm index 202b8fbc1..2fd5813f7 100644 --- a/scripts/Dpkg/Changelog.pm +++ b/scripts/Dpkg/Changelog.pm @@ -42,7 +42,7 @@ use Dpkg; use Dpkg::Gettext; use Dpkg::ErrorHandling qw(:DEFAULT report); use Dpkg::Control; -use Dpkg::Version qw(compare_versions); +use Dpkg::Version; use Dpkg::Vendor qw(run_vendor_hook); use base qw(Exporter); @@ -257,7 +257,7 @@ sub __sanity_check_range { warning(_g("'%s' option specifies non-existing version"), "since"); warning(_g("use newest entry that is smaller than the one specified")); foreach my $v (@versions) { - if (compare_versions($v, "<<", $$since)) { + if (version_compare_op($v, CMP_OP_LT, $$since)) { $$since = $v; last; } @@ -274,7 +274,7 @@ sub __sanity_check_range { warning(_g("use oldest entry that is bigger than the one specified")); my $oldest; foreach my $v (@versions) { - if (compare_versions($v, ">>", $$from)) { + if (version_compare_op($v, CMP_OP_GT, $$from)) { $oldest = $v; } } @@ -290,7 +290,7 @@ sub __sanity_check_range { warning(_g("use oldest entry that is bigger than the one specified")); my $oldest; foreach my $v (@versions) { - if (compare_versions($v, ">>", $$until)) { + if (version_compare_op($v, CMP_OP_GT, $$until)) { $oldest = $v; } } @@ -305,7 +305,7 @@ sub __sanity_check_range { warning(_g("'%s' option specifies non-existing version"), "to"); warning(_g("use newest entry that is smaller than the one specified")); foreach my $v (@versions) { - if (compare_versions($v, "<<", $$to)) { + if (version_compare_op($v, CMP_OP_LT, $$to)) { $$to = $v; last; } diff --git a/scripts/Dpkg/Deps.pm b/scripts/Dpkg/Deps.pm index 3162d9723..38a697b86 100644 --- a/scripts/Dpkg/Deps.pm +++ b/scripts/Dpkg/Deps.pm @@ -45,7 +45,7 @@ objects depending on the case. use strict; use warnings; -use Dpkg::Version qw(compare_versions); +use Dpkg::Version; use Dpkg::Arch qw(get_host_arch); use Dpkg::ErrorHandling; use Dpkg::Gettext; @@ -142,24 +142,30 @@ This functions returns 1 if the "p" dependency implies the "q" dependency. It returns 0 if the "p" dependency implies that "q" is not satisfied. It returns undef when there's no implication. +The $v_p and $v_q parameter should be Dpkg::Version objects. + =cut sub version_implies { my ($rel_p, $v_p, $rel_q, $v_q) = @_; + # If versions are not valid, we can't decide of any implication + return 0 unless ref($v_p) and $v_p->isa("Dpkg::Version"); + return 0 unless ref($v_q) and $v_q->isa("Dpkg::Version"); + # q wants an exact version, so p must provide that exact version. p # disproves q if q's version is outside the range enforced by p. if ($rel_q eq '=') { if ($rel_p eq '<<') { - return compare_versions($v_p, '<=', $v_q) ? 0 : undef; + return ($v_p <= $v_q) ? 0 : undef; } elsif ($rel_p eq '<=') { - return compare_versions($v_p, '<<', $v_q) ? 0 : undef; + return ($v_p < $v_q) ? 0 : undef; } elsif ($rel_p eq '>>') { - return compare_versions($v_p, '>=', $v_q) ? 0 : undef; + return ($v_p >= $v_q) ? 0 : undef; } elsif ($rel_p eq '>=') { - return compare_versions($v_p, '>>', $v_q) ? 0 : undef; + return ($v_p > $v_q) ? 0 : undef; } elsif ($rel_p eq '=') { - return compare_versions($v_p, '=', $v_q); + return ($v_p == $v_q); } } @@ -168,13 +174,13 @@ sub version_implies { # p's clause is <<, <=, or =, the version must be <= q's to imply q. if ($rel_q eq '<=') { if ($rel_p eq '>>') { - return compare_versions($v_p, '>=', $v_q) ? 0 : undef; + return ($v_p >= $v_q) ? 0 : undef; } elsif ($rel_p eq '>=') { - return compare_versions($v_p, '>>', $v_q) ? 0 : undef; + return ($v_p > $v_q) ? 0 : undef; } elsif ($rel_p eq '=') { - return compare_versions($v_p, '<=', $v_q) ? 1 : 0; + return ($v_p <= $v_q) ? 1 : 0; } else { # <<, <= - return compare_versions($v_p, '<=', $v_q) ? 1 : undef; + return ($v_p <= $v_q) ? 1 : undef; } } @@ -182,37 +188,37 @@ sub version_implies { # version if the p relation is <= or =. if ($rel_q eq '<<') { if ($rel_p eq '>>' or $rel_p eq '>=') { - return compare_versions($v_p, '>=', $v_p) ? 0 : undef; + return ($v_p >= $v_p) ? 0 : undef; } elsif ($rel_p eq '<<') { - return compare_versions($v_p, '<=', $v_q) ? 1 : undef; + return ($v_p <= $v_q) ? 1 : undef; } elsif ($rel_p eq '=') { - return compare_versions($v_p, '<<', $v_q) ? 1 : 0; + return ($v_p < $v_q) ? 1 : 0; } else { # <<, <= - return compare_versions($v_p, '<<', $v_q) ? 1 : undef; + return ($v_p < $v_q) ? 1 : undef; } } # Same logic as above, only inverted. if ($rel_q eq '>=') { if ($rel_p eq '<<') { - return compare_versions($v_p, '<=', $v_q) ? 0 : undef; + return ($v_p <= $v_q) ? 0 : undef; } elsif ($rel_p eq '<=') { - return compare_versions($v_p, '<<', $v_q) ? 0 : undef; + return ($v_p < $v_q) ? 0 : undef; } elsif ($rel_p eq '=') { - return compare_versions($v_p, '>=', $v_q) ? 1 : 0; + return ($v_p >= $v_q) ? 1 : 0; } else { # >>, >= - return compare_versions($v_p, '>=', $v_q) ? 1 : undef; + return ($v_p >= $v_q) ? 1 : undef; } } if ($rel_q eq '>>') { if ($rel_p eq '<<' or $rel_p eq '<=') { - return compare_versions($v_p, '<=', $v_q) ? 0 : undef; + return ($v_p <= $v_q) ? 0 : undef; } elsif ($rel_p eq '>>') { - return compare_versions($v_p, '>=', $v_q) ? 1 : undef; + return ($v_p >= $v_q) ? 1 : undef; } elsif ($rel_p eq '=') { - return compare_versions($v_p, '>>', $v_q) ? 1 : 0; + return ($v_p > $v_q) ? 1 : 0; } else { - return compare_versions($v_p, '>>', $v_q) ? 1 : undef; + return ($v_p > $v_q) ? 1 : undef; } } @@ -475,7 +481,7 @@ use strict; use warnings; use Dpkg::Arch qw(debarch_is); -use Dpkg::Version qw(compare_versions); +use Dpkg::Version; use Dpkg::ErrorHandling; use Dpkg::Gettext; @@ -512,16 +518,13 @@ sub parse { \s*$ # trailing spaces at end /x; $self->{package} = $1; - $self->{relation} = $2; - $self->{version} = $3; + $self->{relation} = version_normalize_cmp_op($2) if defined($2); + if (defined($3)) { + $self->{version} = Dpkg::Version->new($3) || $3; + } if (defined($4)) { $self->{arches} = [ split(/\s+/, $4) ]; } - # Standardize relation field - if (defined($self->{relation})) { - $self->{relation} = '<<' if ($self->{relation} eq '<'); - $self->{relation} = '>>' if ($self->{relation} eq '>'); - } } sub dump { @@ -661,7 +664,7 @@ sub get_evaluation { return 0; } else { if (defined($param)) { - if (compare_versions($param, $self->{relation}, $self->{version})) { + if (version_compare_op($param, $self->{relation}, $self->{version})) { return 1; } else { return 0; diff --git a/scripts/Dpkg/Shlibs/SymbolFile.pm b/scripts/Dpkg/Shlibs/SymbolFile.pm index 22208ae4c..41e170257 100644 --- a/scripts/Dpkg/Shlibs/SymbolFile.pm +++ b/scripts/Dpkg/Shlibs/SymbolFile.pm @@ -21,7 +21,7 @@ use strict; use warnings; use Dpkg::Gettext; use Dpkg::ErrorHandling; -use Dpkg::Version qw(vercmp); +use Dpkg::Version; use Dpkg::Control::Fields; use Dpkg::Shlibs::Symbol; use Dpkg::Arch qw(get_host_arch); @@ -294,7 +294,7 @@ sub merge_symbols { } else { # We assume that the right dependency information is already # there. - if (vercmp($minver, $sym->{minver}) < 0) { + if (version_compare($minver, $sym->{minver}) < 0) { $sym->{minver} = $minver; } } @@ -329,7 +329,7 @@ sub merge_symbols { # Bump deprecated if the symbol is optional so that it # keeps reappering in the diff while it's missing $sym->{deprecated} = $minver if $sym->is_optional(); - } elsif (vercmp($minver, $sym->{minver}) > 0) { + } elsif (version_compare($minver, $sym->{minver}) > 0) { $sym->{deprecated} = $minver; } } @@ -384,7 +384,7 @@ sub get_smallest_version { foreach my $sym (values %{$so_object->{syms}}) { next if $dep_id != $sym->{dep_id}; $minver = $sym->{minver} unless defined($minver); - if (vercmp($minver, $sym->{minver}) > 0) { + if (version_compare($minver, $sym->{minver}) > 0) { $minver = $sym->{minver}; } } diff --git a/scripts/Dpkg/Source/Package.pm b/scripts/Dpkg/Source/Package.pm index 6b41fb8f6..9227da826 100644 --- a/scripts/Dpkg/Source/Package.pm +++ b/scripts/Dpkg/Source/Package.pm @@ -23,7 +23,7 @@ use Dpkg::Gettext; use Dpkg::ErrorHandling; use Dpkg::Control; use Dpkg::Checksums; -use Dpkg::Version qw(parseversion check_version); +use Dpkg::Version; use Dpkg::Compression; use Dpkg::Exit; use Dpkg::Path qw(check_files_are_the_same); @@ -233,10 +233,10 @@ sub get_basename { unless (exists $f->{'Source'} and exists $f->{'Version'}) { error(_g("source and version are required to compute the source basename")); } - my %v = parseversion($f->{'Version'}); - my $basename = $f->{'Source'} . "_" . $v{"version"}; + my $v = Dpkg::Version->new($f->{'Version'}); + my $basename = $f->{'Source'} . "_" . $v->version(); if ($with_revision and $f->{'Version'} =~ /-/) { - $basename .= "-" . $v{'revision'}; + $basename .= "-" . $v->revision(); } return $basename; } @@ -325,7 +325,8 @@ sub extract { my $self = shift; my $newdirectory = $_[0]; - check_version($self->{'fields'}{'Version'}, 1); + my ($ok, $error) = version_check($self->{'fields'}{'Version'}); + error($error) unless $ok; # Copy orig tarballs if ($self->{'options'}{'copy_orig_tarballs'}) { diff --git a/scripts/dpkg-buildpackage.pl b/scripts/dpkg-buildpackage.pl index bdab775f6..6e383c615 100755 --- a/scripts/dpkg-buildpackage.pl +++ b/scripts/dpkg-buildpackage.pl @@ -12,7 +12,7 @@ use Dpkg::Gettext; use Dpkg::ErrorHandling; use Dpkg::BuildOptions; use Dpkg::Compression; -use Dpkg::Version qw(check_version); +use Dpkg::Version; use Dpkg::Changelog qw(parse_changelog); use Dpkg::Arch qw(get_build_arch debarch_to_gnutriplet); @@ -282,7 +282,8 @@ my $changelog = parse_changelog(); my $pkg = mustsetvar($changelog->{source}, _g('source package')); my $version = mustsetvar($changelog->{version}, _g('source version')); -check_version($version, 1); +my ($ok, $error) = version_check($version); +error($error) unless $ok; my $maintainer; if ($changedby) { diff --git a/scripts/dpkg-genchanges.pl b/scripts/dpkg-genchanges.pl index b13ce23c0..0fc323865 100755 --- a/scripts/dpkg-genchanges.pl +++ b/scripts/dpkg-genchanges.pl @@ -18,7 +18,7 @@ use Dpkg::Control; use Dpkg::Substvars; use Dpkg::Vars; use Dpkg::Changelog qw(parse_changelog); -use Dpkg::Version qw(parseversion compare_versions); +use Dpkg::Version; textdomain("dpkg-dev"); @@ -203,7 +203,9 @@ $substvars->set_arch_substvars(); $substvars->parse($varlistfile) if -e $varlistfile; if (defined($prev_changelog) and - compare_versions($changelog->{"Version"}, '<<', $prev_changelog->{"Version"})) { + version_compare_op($changelog->{"Version"}, CMP_OP_LT, + $prev_changelog->{"Version"})) +{ warning(_g("the current version (%s) is smaller than the previous one (%s)"), $changelog->{"Version"}, $prev_changelog->{"Version"}) # ~bpo and ~vola are backports and have lower version number by definition @@ -424,9 +426,9 @@ if (!is_binaryonly) { # the .orig tarballs must be included my $include_tarball; if (defined($prev_changelog)) { - my %cur = parseversion($changelog->{"Version"}); - my %prev = parseversion($prev_changelog->{"Version"}); - $include_tarball = ($cur{"version"} ne $prev{"version"}) ? 1 : 0; + my $cur = Dpkg::Version->new($changelog->{"Version"}); + my $prev = Dpkg::Version->new($prev_changelog->{"Version"}); + $include_tarball = ($cur->version() ne $prev->version()) ? 1 : 0; } else { if ($bad_parser) { # The parser doesn't support extracting a previous version diff --git a/scripts/dpkg-scanpackages.pl b/scripts/dpkg-scanpackages.pl index 6d06f511c..6b9789ac1 100755 --- a/scripts/dpkg-scanpackages.pl +++ b/scripts/dpkg-scanpackages.pl @@ -9,7 +9,7 @@ use Dpkg; use Dpkg::Gettext; use Dpkg::ErrorHandling; use Dpkg::Control; -use Dpkg::Version qw(compare_versions); +use Dpkg::Version; use Dpkg::Checksums; use Dpkg::Source::CompressedFile; @@ -167,14 +167,6 @@ defined($override) and (-e $override or $pathprefix = '' if not defined $pathprefix; -my %vercache; -sub vercmp { - my ($a,$b)=@_; - return $vercache{$a}{$b} if exists $vercache{$a}{$b}; - $vercache{$a}{$b} = compare_versions($a, 'gt', $b); - return $vercache{$a}{$b}; -} - my $find_h = new IO::Handle; open($find_h,'-|','find',"$binarydir/",@find_args,'-print') or syserr(_g("Couldn't open %s for reading"), $binarydir); @@ -211,7 +203,9 @@ FILE: if (defined($packages{$p}) and not $options{multiversion}) { foreach (@{$packages{$p}}) { - if (vercmp($fields->{'Version'}, $_->{'Version'})) { + if (version_compare_op($fields->{'Version'}, CMP_OP_GT, + $_->{'Version'})) + { warning(_g("Package %s (filename %s) is repeat but newer version;"), $p, $fn); warning(_g("used that one and ignored data from %s!"), diff --git a/scripts/dpkg-shlibdeps.pl b/scripts/dpkg-shlibdeps.pl index d18ae97d1..56c5ea191 100755 --- a/scripts/dpkg-shlibdeps.pl +++ b/scripts/dpkg-shlibdeps.pl @@ -13,7 +13,7 @@ use Dpkg::Gettext; use Dpkg::ErrorHandling; use Dpkg::Path qw(relative_to_pkg_root guess_pkg_root_dir check_files_are_the_same); -use Dpkg::Version qw(compare_versions); +use Dpkg::Version; use Dpkg::Shlibs qw(find_library @librarypaths); use Dpkg::Shlibs::Objdump; use Dpkg::Shlibs::SymbolFile; @@ -452,7 +452,8 @@ sub filter_deps { $stronger = 0; # If the dep is unversionned } elsif ($depseen{$dep} eq '') { $stronger = 1; # If the dep seen is unversionned - } elsif (compare_versions($depseen{$dep}, '>>', $dependencies{$field}{$dep})) { + } elsif (version_compare_op($depseen{$dep}, CMP_OP_GT, + $dependencies{$field}{$dep})) { # The version of the dep seen is stronger... $stronger = 0; } else { @@ -561,7 +562,7 @@ sub get_min_version_from_deps { my $minver = get_min_version_from_deps($subdep, $pkg); next if not defined $minver; if (defined $res) { - if (compare_versions($minver, '>>', $res)) { + if (version_compare_op($minver, CMP_OP_GT, $res)) { $res = $minver; } } else { @@ -580,8 +581,8 @@ sub update_dependency_version { defined($dependencies{$cur_field}{$subdep})) { if ($dependencies{$cur_field}{$subdep} eq '' or - compare_versions($minver, '>>', - $dependencies{$cur_field}{$subdep})) + version_compare_op($minver, CMP_OP_GT, + $dependencies{$cur_field}{$subdep})) { $dependencies{$cur_field}{$subdep} = $minver; } diff --git a/scripts/dpkg-source.pl b/scripts/dpkg-source.pl index 745955092..1d9e1a647 100755 --- a/scripts/dpkg-source.pl +++ b/scripts/dpkg-source.pl @@ -13,7 +13,7 @@ use Dpkg::Compression; use Dpkg::Control::Info; use Dpkg::Control::Fields; use Dpkg::Substvars; -use Dpkg::Version qw(check_version); +use Dpkg::Version; use Dpkg::Vars; use Dpkg::Changelog qw(parse_changelog); use Dpkg::Source::Compressor; @@ -223,7 +223,8 @@ if ($options{'opmode'} eq 'build') { set_source_package($v); $fields->{$_} = $v; } elsif (m/^Version$/) { - check_version($v, 1); + my ($ok, $error) = version_check($v); + error($error) unless $ok; $fields->{$_} = $v; } elsif (m/^Maintainer$/i) { # Do not replace the field coming from the source entry -- cgit v1.2.3