Bug#497887: lintian: check for unnecessary versioned dependencies on Perl core modules
tag 497887 patch
thanks
On Fri, Sep 05, 2008 at 09:52:35AM +0300, Niko Tyni wrote:
> It would be useful if lintian could warn about unnecessary versioned
> dependencies on packages provided by the perl core packages.
Proposed patches for git consumption attached, these seem to work for me.
Comments welcome. The tag severity might be inflated.
--
Niko Tyni ntyni@debian.org
>From b2b9fed28b2a80a40b9443560eea0404f22b0265 Mon Sep 17 00:00:00 2001
From: Niko Tyni <ntyni@debian.org>
Date: Wed, 10 Sep 2008 16:38:57 +0300
Subject: [PATCH] Extend Lintian::Data for key => value support.
A minor refactoring in Lintian::Data makes it possible to
derive Lintian::Data::WithValues from it.
---
debian/copyright | 1 +
lib/Lintian/Data.pm | 9 +++-
lib/Lintian/Data/WithValues.pm | 120 ++++++++++++++++++++++++++++++++++++++++
3 files changed, 129 insertions(+), 1 deletions(-)
create mode 100644 lib/Lintian/Data/WithValues.pm
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/lib/Lintian/Data.pm b/lib/Lintian/Data.pm
index a8c176d..2a6569b 100644
--- a/lib/Lintian/Data.pm
+++ b/lib/Lintian/Data.pm
@@ -41,7 +41,8 @@ use Carp qw(croak);
s/^\s+//;
next if /^\#/;
next if /^$/;
- $data{$type}{$_} = 1;
+ my ($key, $val) = $class->_get_line_content($_);
+ $data{$type}{$key} = $val;
}
}
my $self = { data => $data{$type} };
@@ -50,6 +51,12 @@ use Carp qw(croak);
}
}
+# This is trivial, but derived classes can override it
+sub _get_line_content {
+ my ($class, $line) = @_;
+ return ($line => 1);
+}
+
# Query a data object for whether a particular keyword is valid.
sub known {
my ($self, $keyword) = @_;
diff --git a/lib/Lintian/Data/WithValues.pm b/lib/Lintian/Data/WithValues.pm
new file mode 100644
index 0000000..532a633
--- /dev/null
+++ b/lib/Lintian/Data/WithValues.pm
@@ -0,0 +1,120 @@
+package Lintian::Data::WithValues;
+
+# Lintian::Data -- interface to query key/value pairs
+
+# 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/>.
+
+use base q/Lintian::Data/;
+use Carp q/croak/;
+use strict;
+
+# this is global to the class, but it's only used in the initialization phase
+my $separator;
+
+sub new {
+ my ($class, $args) = @_;
+ croak("new() needs a hash reference")
+ if ref $args ne 'HASH';
+ $separator = exists $args->{separator} ?
+ $args->{separator} : undef;
+ $class->SUPER::new($args->{type});
+}
+
+sub _get_line_content {
+ my ($class, $line) = @_;
+ if (defined $separator) {
+ return split(/$separator/, $line, 2);
+ } else {
+ return ($line => 1);
+ }
+}
+
+# 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::WithValues - Lintian interface to query key/value pairs
+
+=head1 SYNOPSIS
+
+ my $hash = Lintian::Data::WithValues->new( {
+ type => 'type',
+ separator => '\s+'
+ });
+ if ($hash->value($keyword) eq 'whatever') {
+ # do something ...
+ }
+
+=head1 DESCRIPTION
+
+Lintian::Data::WithValues extends the Lintian::Data class to provide a way
+of loading key/value information instead of just a list of keywords.
+
+The input lines will be split with a given regular expression into
+key/value pairs that can be fetched with the value() instance method.
+
+=head1 CLASS METHODS
+
+=over 4
+
+=item new(ARGS)
+
+Creates a new Lintian::Data::WithValues object with the given properties.
+ARGS must be a hash reference. The hash must contain a key named 'type',
+which is used as the TYPE argument to Lintian::Data::new(). Additionally,
+a key named 'separator' specifies the regular expression used for splitting
+the input lines into key/value pairs.
+
+As a special case, when 'separator' is not specified, the whole input
+line is used as the keyword and the value is set to '1'.
+
+=back
+
+=head1 INSTANCE METHODS
+
+=over 4
+
+=item value(KEY)
+
+Returns the value attached to KEY in the data file represented by this
+Lintian::Data instance. If KEY is not present, the undefined value will
+be returned.
+
+=back
+
+=head1 DIAGNOSTICS
+
+=over 4
+
+=item new() needs a hash reference
+
+new() was called with an argument that is not a hash reference.
+
+=back
+
+=head1 AUTHOR
+
+Written by Niko Tyni <ntyni@debian.org> for Lintian.
+
+=head1 SEE ALSO
+
+Lintian::Data, lintian(1).
--
1.5.6.3
>From 25412798cba6260560a809fb50bcdaf367214f26 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 | 25 +++++++++
debian/rules | 11 ++++-
private/refresh-perl-provides | 119 +++++++++++++++++++++++++++++++++++++++++
3 files changed, 154 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..973415f
--- /dev/null
+++ b/data/fields/perl-provides
@@ -0,0 +1,25 @@
+# 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
+libversion-perl 0.7400
+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/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..c1c3c8c
--- /dev/null
+++ b/private/refresh-perl-provides
@@ -0,0 +1,119 @@
+#!/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
+# correspending 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;
+ }
+
+ # special cases like mangled version numbers can go here
+ $ret .= "00" if $module eq "version";
+
+ 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 67e3ffc244838d10b594a0e9819f7c61a80f7f96 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 | 26 ++++++++++++++++++++++++++
checks/fields.desc | 21 +++++++++++++++++++++
2 files changed, 47 insertions(+), 0 deletions(-)
diff --git a/checks/fields b/checks/fields
index 9b26ed6..33d2f2a 100644
--- a/checks/fields
+++ b/checks/fields
@@ -31,6 +31,7 @@ use Dep;
use Tags;
use Util;
use Lintian::Data;
+use Lintian::Data::WithValues;
# The allowed Python dependencies currently. This is the list of alternatives
# that, either directly or through transitive dependencies that can be relied
@@ -116,6 +117,12 @@ my @global_clean_bypass = (
'^\s+dh\s+'
);
+# Load package versions provided by the Perl core modules
+my $perl_core_provides = Lintian::Data::WithValues->new ({
+ type => 'fields/perl-provides',
+ separator => '\s+'
+});
+
sub run {
my $pkg = shift;
@@ -519,6 +526,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);
}
@@ -700,6 +712,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) {
@@ -931,6 +948,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..8cb9522 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: important
+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: