Bug#497887: lintian: check for unnecessary versioned dependencies on Perl core modules
On Wed, Sep 10, 2008 at 02:55:41PM -0700, Russ Allbery wrote:
> Frank Lichtenheld <djpig@debian.org> writes:
>
> > Hmm, I'm not entirely sure it's worth to implement
> > Lintian::Data::WithValues as a subclass instead of just triggering the
> > behaviour on the presence of a separator option to the new call.
>
> The latter was how I was going to implement it (I was going to write that
> same function for another purpose).
Yeah, it was just my dislike for positional parameters in public interfaces.
New patch set attached. I also removed traces of the obsolete
libversion-perl package and lowered the severity as suggested.
--
Niko
>From b9e720ca6296e894b24fb497d4dc3b15e7e74838 Mon Sep 17 00:00:00 2001
From: Niko Tyni <ntyni@debian.org>
Date: Thu, 11 Sep 2008 09:21:07 +0300
Subject: [PATCH] Extend Lintian::Data to handle key/value pairs.
The new value() method offers a way to fetch the data
attached to a given keyword.
---
lib/Lintian/Data.pm | 50 +++++++++++++++++++++++++++++++++++++++++---------
1 files changed, 41 insertions(+), 9 deletions(-)
diff --git a/lib/Lintian/Data.pm b/lib/Lintian/Data.pm
index a8c176d..e119488 100644
--- a/lib/Lintian/Data.pm
+++ b/lib/Lintian/Data.pm
@@ -29,7 +29,7 @@ use Carp qw(croak);
{
my %data;
sub new {
- my ($class, $type) = @_;
+ my ($class, $type, $separator) = @_;
croak('no data type specified') unless $type;
unless (exists $data{$type}) {
my $dir = $ENV{LINTIAN_ROOT} . '/data';
@@ -41,7 +41,13 @@ use Carp qw(croak);
s/^\s+//;
next if /^\#/;
next if /^$/;
- $data{$type}{$_} = 1;
+ my ($key, $val);
+ if (defined $separator) {
+ ($key, $val) = split(/$separator/, $_, 2);
+ } else {
+ ($key, $val) = ($_ => 1);
+ }
+ $data{$type}{$key} = $val;
}
}
my $self = { data => $data{$type} };
@@ -56,6 +62,15 @@ sub known {
return (exists $self->{data}{$keyword}) ? 1 : undef;
}
+
+# Query a data object for the value attached to a particular keyword.
+sub value {
+ my ($self, $keyword) = @_;
+ return (exists $self->{data}{$keyword}) ? $self->{data}{$keyword} : undef;
+}
+
+1;
+
=head1 NAME
Lintian::Data - Lintian interface to query lists of keywords
@@ -66,15 +81,23 @@ Lintian::Data - Lintian interface to query lists of keywords
if ($list->known($keyword)) {
# do something ...
}
+ my $hash = Lintian::Data->new('another-type', '\s+');
+ if ($list->value($keyword) > 1) {
+ # do something ...
+ }
=head1 DESCRIPTION
-Lintian::Data provides a way of loading a list of keywords from a file in
-the Lintian root and then querying that list. The lists are stored in the
-F<data> directory of the Lintian root and consist of one keyword per line.
-Blank lines and lines beginning with C<#> are ignored. Leading and
-trailing whitespace is stripped; other than that, keywords are taken
-verbatim as they are listed in the file and may include spaces.
+Lintian::Data provides a way of loading a list of keywords or key/value
+pairs from a file in the Lintian root and then querying that list.
+The lists are stored in the F<data> directory of the Lintian root and
+consist of one keyword or key/value pair per line. Blank lines and
+lines beginning with C<#> are ignored. Leading and trailing whitespace
+is stripped.
+
+If requested, the lines are split into key/value pairs with a given
+separator regular expression. Otherwise, keywords are taken verbatim
+as they are listed in the file and may include spaces.
This module allows lists such as menu sections, doc-base sections,
obsolete packages, package fields, and so forth to be stored in simple,
@@ -84,7 +107,7 @@ easily editable files.
=over 4
-=item new(TYPE)
+=item new(TYPE [,SEPARATOR])
Creates a new Lintian::Data object for the given TYPE. TYPE is a partial
path relative to the F<data> directory and should correspond to a file in
@@ -92,6 +115,9 @@ that directory. The contents of that file will be loaded into memory and
returned as part of the newly created object. On error, new() throws an
exception.
+If SEPARATOR is given, it will be used as a regular expression for splitting
+the lines into key/value pairs.
+
A given file will only be loaded once. If new() is called again with the
same TYPE argument, the data previously loaded will be reused, avoiding
multiple file reads.
@@ -107,6 +133,12 @@ multiple file reads.
Returns true if KEYWORD was listed in the data file represented by this
Lintian::Data instance and false otherwise.
+=item value(KEYWORD)
+
+Returns the value attached to KEYWORD if it was listed in the data
+file represented by this Lintian::Data instance and the undefined value
+otherwise. If SEPARATOR was not given, the value will '1'.
+
=back
=head1 DIAGNOSTICS
--
1.5.6.3
>From 7d83ff47b0eb560701d2e714f17afafb1e314757 Mon Sep 17 00:00:00 2001
From: Niko Tyni <ntyni@debian.org>
Date: Wed, 10 Sep 2008 21:39:46 +0300
Subject: [PATCH] Incorporate static data about packages in the Perl core
The new file, data/fields/perl-provides, contains information on
modules included in the Perl core packages that also have a separate
binary package available.
The 'refresh-perl-provides' target in debian/rules provides a way to
semi-automatically refresh the data, and the 'build' target issues
a warning if the data is clearly stale.
---
data/fields/perl-provides | 24 +++++++++
debian/copyright | 1 +
debian/rules | 11 ++++-
private/refresh-perl-provides | 116 +++++++++++++++++++++++++++++++++++++++++
4 files changed, 151 insertions(+), 1 deletions(-)
create mode 100644 data/fields/perl-provides
create mode 100755 private/refresh-perl-provides
diff --git a/data/fields/perl-provides b/data/fields/perl-provides
new file mode 100644
index 0000000..f80962c
--- /dev/null
+++ b/data/fields/perl-provides
@@ -0,0 +1,24 @@
+# virtual packages provided by the Perl core packages that also have a
+# separate binary package available
+#
+# the listed version is the one included in the Perl core
+#
+# regenerate by running
+# debian/rules refresh-perl-provides
+# in the lintian source tree
+#
+# last updated for PERL_VERSION=5.010000
+libtime-piece-perl 1.12
+libdigest-sha-perl 5.45
+libtest-simple-perl 0.72
+libtest-harness-perl 2.64
+libpod-simple-perl 3.05
+libparams-check-perl 0.26
+libmodule-pluggable-perl 3.6
+libmodule-load-conditional-perl 0.22
+libmodule-corelist-perl 2.12
+libmodule-build-perl 0.2808.01
+libio-zlib-perl 1.07
+libfile-temp-perl 0.18
+libextutils-parsexs-perl 2.18.02
+libextutils-cbuilder-perl 0.21
diff --git a/debian/copyright b/debian/copyright
index 13c6b03..449c970 100644
--- a/debian/copyright
+++ b/debian/copyright
@@ -34,6 +34,7 @@ Portions Copyright (C) 2005 René van Bevern
Portions Copyright (C) 2006 Adeodato Simó
Portions Copyright (C) 2007, 2008 Russ Allbery
Portions Copyright (C) 2008 Patrick Schoenfeld
+Portions Copyright (C) 2008 Niko Tyni
This program is free software; you may redistribute it and/or modify
it under the terms of the GNU General Public License as published by
diff --git a/debian/rules b/debian/rules
index 33afeee..945d329 100755
--- a/debian/rules
+++ b/debian/rules
@@ -10,6 +10,7 @@ allchecks := $(wildcard checks/*)
allcollect := $(wildcard collection/*)
tagfiles := $(wildcard testset/tags.* t/*/tags)
testfiles := $(wildcard t/tests/*.desc)
+perlprovides := data/fields/perl-provides
onlyrun =
runtests: $(neededfiles) $(allchecks) $(allcollect) $(tagfiles) $(testfiles)
@@ -19,6 +20,10 @@ runtests: $(neededfiles) $(allchecks) $(allcollect) $(tagfiles) $(testfiles)
LINTIAN_ROOT="" $(PERL) t/runtests -k t debian/tests $(onlyrun)
if [ "$(onlyrun)" = "" ]; then touch $@; fi
+# this target is only run manually
+refresh-perl-provides:
+ perl private/refresh-perl-provides > $(perlprovides)
+
build: build-stamp
build-stamp: $(neededfiles) $(docsource)
@echo .... running build ....
@@ -28,6 +33,10 @@ build-stamp: $(neededfiles) $(docsource)
LINTIAN_ROOT="" ./frontend/lintian --help \
| tail -n +3 | $(PERL) -n -e 'print " $$_"' >doc/help.tmp
$(PERL) -p -e 'BEGIN { open HELP, "<", "doc/help.tmp" or die; local $$/ = undef; $$h = <HELP> }; s/%LINTIAN_HELP%/$$h/' doc/README.in >doc/README
+
+ # check that the static data about perl core modules is up to date
+ $(PERL) -ne '/PERL_VERSION=(.+)/ and $$] > $$1 and warn q{*}x60 . qq{\n$(perlprovides) needs an update, please run\n debian/rules refresh-perl-provides\n(which needs the libapt-pkg-perl package)\n} . q{*}x60 . qq{\n}' $(perlprovides)
+
touch $@
clean: $(neededfiles)
@@ -66,5 +75,5 @@ binary-arch:
binary: binary-indep binary-arch
-.PHONY: build binary binary-arch binary-indep clean
+.PHONY: build binary binary-arch binary-indep clean refresh-perl-provides
.DELETE_ON_ERROR: runtests
diff --git a/private/refresh-perl-provides b/private/refresh-perl-provides
new file mode 100755
index 0000000..e2b5d33
--- /dev/null
+++ b/private/refresh-perl-provides
@@ -0,0 +1,116 @@
+#!/usr/bin/perl -w
+use strict;
+
+# Generate a list of packages that are provided by the Perl core packages
+# and also packaged separately at a (hopefully) newer version.
+# The list will have the package name and the upstream version of the
+# corresponding module integrated in the currently installed Perl version.
+
+# Copyright (C) 2008 Niko Tyni
+#
+# 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, see <http://www.gnu.org/licenses/>.
+
+# from /usr/share/doc/libapt-pkg-perl/examples/apt-cache
+use AptPkg::Config '$_config';
+use AptPkg::System '$_system';
+use AptPkg::Cache;
+
+(my $self = $0) =~ s#.*/##;
+
+# initialise the global config object with the default values and
+# setup the $_system object
+$_config->init;
+$_system = $_config->system;
+
+# supress cache building messages
+$_config->{quiet} = 2;
+
+# set up the cache
+my $cache = AptPkg::Cache->new;
+# end from /usr/share/doc/libapt-pkg-perl/examples/apt-cache
+
+use Module::CoreList;
+my $versioning = $_system->versioning;
+
+# we look at packages provided by these
+my @core_packages = (qw(perl-base perl perl-modules));
+
+# check we have a cache of Debian sid packages available
+warn("Warning: this list should only be updated on a system with an up to date APT cache of the Debian unstable distribution")
+ if !grep { defined $_->{Origin} &&
+ defined $_->{Archive} &&
+ $_->{Origin} eq "Debian" &&
+ $_->{Archive} eq "unstable" }
+ @{$cache->files};
+
+print <<EOF;
+# virtual packages provided by the Perl core packages that also have a
+# separate binary package available
+#
+# the listed version is the one included in the Perl core
+#
+# regenerate by running
+# debian/rules refresh-perl-provides
+# in the lintian source tree
+#
+# last updated for PERL_VERSION=$]
+EOF
+
+for my $pkg (@core_packages) {
+ my $cached_versions = $cache->{$pkg}
+ or die("no such binary package found in the APT cache: $pkg");
+ my $latest = bin_latest($cached_versions);
+
+ for my $provides (@{$latest->{ProvidesList}}) {
+ my $name = $provides->{Name};
+ # skip virtual-only packages
+ next if (!$cache->{$name}{VersionList});
+ my $version = find_core_version($name);
+ next if !$version;
+
+ # the underscore notates a CPAN development version;
+ # these may need special casing with some packages
+ $version =~ s/_/./g;
+ print "$name $version\n";
+ }
+}
+
+# look up the version of a package in the core
+sub find_core_version {
+ my $module = shift;
+ my $ret;
+ return if $module =~ /^perl(5|api)/;
+
+ # mangle the package name into the module name
+ $module =~ s/^lib//;
+ $module =~ s/-perl$//;
+ $module =~ s/-/::/g;
+
+ for (Module::CoreList->find_modules(qr/^\Q$module\E$/i, 0+$])) {
+ $ret = $Module::CoreList::version{0+$]}{$_};
+ last;
+ }
+
+ return $ret;
+}
+
+sub bin_latest {
+ my $p = shift;
+ return (sort bin_byversion @{$p->{VersionList}})[-1];
+}
+
+sub bin_byversion {
+ return $versioning->compare($a->{VerStr}, $b->{VerStr});
+}
+
--
1.5.6.3
>From db001eade7af4c1b687cca422fa9fecdc9152e16 Mon Sep 17 00:00:00 2001
From: Niko Tyni <ntyni@debian.org>
Date: Wed, 10 Sep 2008 20:53:00 +0300
Subject: [PATCH] Check for unnecessary versioned dependencies on Perl core modules. (Closes: #497887)
Add a warning about unnecessary versioned dependencies on packages
also provided by the perl core packages at a recent enough version.
In the case of alternate dependencies, only the first alternative is
examined. This allows the recommended idiom of specifying the perl core
package as the preferred alternative and the versioned dependency on
the real package as a secondary one.
---
checks/fields | 22 ++++++++++++++++++++++
checks/fields.desc | 21 +++++++++++++++++++++
2 files changed, 43 insertions(+), 0 deletions(-)
diff --git a/checks/fields b/checks/fields
index a67bf6a..07895be 100644
--- a/checks/fields
+++ b/checks/fields
@@ -117,6 +117,9 @@ my @global_clean_bypass = (
'^\s+dh\s+'
);
+# Load package versions provided by the Perl core modules
+my $perl_core_provides = Lintian::Data->new ('fields/perl-provides', '\s+');
+
sub run {
my $pkg = shift;
@@ -518,6 +521,11 @@ if (($type eq "binary") || ($type eq 'udeb')) {
if ($d_pkg eq 'python' && $d_version->[0] eq '<<' && &$is_dep_field($field)
&& $arch_indep && $pkg =~ /^python-/ && ! defined $info->field('python-version'));
+ # only trigger this for the the preferred alternative
+ tag "versioned-dependency-satisfied-by-perl", "$field: $part_d_orig"
+ if $alternatives[0][-1] eq $part_d_orig
+ && perl_core_has_version($d_pkg, $d_version->[0], $d_version->[1]);
+
tag "depends-exclusively-on-makedev", "$field",
if ($field eq 'depends' && $d_pkg eq 'makedev' && @alternatives == 1);
}
@@ -699,6 +707,11 @@ if ($type eq "source") {
tag "bad-relation", "$field: $part_d_orig"
if $rest;
+
+ # only trigger this for the the preferred alternative
+ tag "versioned-dependency-satisfied-by-perl", "$field: $part_d_orig"
+ if $alternatives[0][-1] eq $part_d_orig
+ && perl_core_has_version($d_pkg, $d_version->[0], $d_version->[1]);
}
for my $pkg (@seen_obsolete_packages) {
@@ -930,6 +943,15 @@ sub _valid_version {
}
}
+sub perl_core_has_version {
+ my ($package, $op, $version) = @_;
+ my $core_version = $perl_core_provides->value($package);
+ return 0 if !defined $core_version;
+ my @version = _valid_version($version);
+ return 0 if !@version;
+ return Dep::get_version_cmp($core_version, $op, $version);
+}
+
sub unfold {
my $field = shift;
my $line = shift;
diff --git a/checks/fields.desc b/checks/fields.desc
index 9be226b..145d37f 100644
--- a/checks/fields.desc
+++ b/checks/fields.desc
@@ -993,3 +993,24 @@ Info: The maintainer value also appears on the <tt>Uploaders</tt> field.
first introduced, but those have long-since been fixed and there is no
longer any need to list the maintainer in Uploaders. The duplicate
information should probably be removed.
+
+Tag: versioned-dependency-satisfied-by-perl
+Type: warning
+Severity: normal
+Certainty: certain
+Info: This package declares an unnecessary versioned dependency
+ on a package that is also provided by one of the Perl core packages
+ (perl, perl-base, perl-modules) with at least the required version.
+ .
+ As versioned dependencies are not satisfied by provided packages,
+ this unnecessarily pulls in a separately packaged newer version
+ of the module.
+ .
+ The recommended way to express the dependency without needless
+ complications on backporting packages is to use alternative dependencies.
+ The Perl core package should be the preferred alternative and the
+ versioned dependency a secondary one.
+ .
+ Example: perl-modules (>= 5.10.0) | libmodule-build-perl (>= 0.26)
+Ref: policy 7.5
+
--
1.5.6.3
Reply to: