[SCM] Debian package checker branch, master, updated. 2.5.6-79-gdfe0efa
The following commit has been merged in the master branch:
commit dfe0efaa291da1d92e216400f522545a1afe31ff
Author: Niels Thykier <niels@thykier.net>
Date: Mon Apr 9 15:16:43 2012 +0200
L::Relation: Add empty() and matches(regex, rule) methods
Add method to match predicates or entire OR clauses against a regex
it. This is mostly useful when checking if a "pattern" package is in
the dependency (e.g. phpapi-$ver). Generally implies(_inverse) is a
better method, but it does not work if there is not an exact package
name.
Signed-off-by: Niels Thykier <niels@thykier.net>
diff --git a/checks/binaries b/checks/binaries
index 0fc426f..943c35b 100644
--- a/checks/binaries
+++ b/checks/binaries
@@ -24,6 +24,7 @@ use strict;
use warnings;
use Lintian::Check qw(check_spelling);
+use Lintian::Relation qw(:constants);
use Lintian::Tags qw(tag);
use Lintian::Output qw(debug_msg);
use Lintian::Util qw(fail slurp_entire_file);
@@ -456,22 +457,16 @@ foreach my $file (@{$info->sorted_index}) {
}
# Find the package dependencies, which is used by various checks.
-my $depends = '';
-if (defined $info->field('pre-depends')) {
- $depends = $info->field('pre-depends');
-}
-if (defined $info->field('depends')) {
- $depends .= ', ' if $depends;
- $depends .= $info->field('depends');
-}
-$depends =~ s/\n/ /g;
+my $depends = $info->relation ('strong');
# Check for a libc dependency.
if ($needs_depends_line) {
- if ($depends && $needs_libc && $pkg !~ /^libc[\d.]+(?:-|\z)/) {
+ if ($depends->empty) {
+ tag 'missing-depends-line';
+ } elsif ($needs_libc && $pkg !~ /^libc[\d.]+(?:-|\z)/) {
# Match libcXX or libcXX-*, but not libc3p0.
- my $re = qr/(?:^|,)\s*\Q$needs_libc\E\b/;
- if ($depends !~ /$re/) {
+ my $re = qr/^\Q$needs_libc\E$/;
+ if (!$depends->matches ($re)) {
my $others = '';
$needs_libc_count--;
if ($needs_libc_count > 0) {
@@ -480,22 +475,24 @@ if ($needs_depends_line) {
tag 'missing-dependency-on-libc',
"needed by $needs_libc_file$others";
}
- } elsif (!$depends) {
- tag 'missing-depends-line';
}
}
# Check for a Perl dependency.
if ($has_perl_lib) {
- my $re = qr/(?:^|,)\s*perlapi-[\d.]+(?:\s*\[[^\]]+\])?\s*(?:,|\z)/;
- unless ($depends =~ /$re/) {
+ # It is a virtual package, so no version is allowed and
+ # alternatives probably does not make sense here either.
+ my $re = qr/^perlapi-[\d.]+(?:\s*\[[^\]]+\])?$/;
+ unless ($depends->matches ($re, MATCH_OR_CLAUSE_FULL)) {
tag 'missing-dependency-on-perlapi';
}
}
# Check for a phpapi- dependency.
if ($has_php_ext) {
- unless ($depends =~ /(?:^|,)\s*phpapi-[\d\w+]+\s*(?:,|\z)/) {
+ # It is a virtual package, so no version is allowed and
+ # alternatives probably does not make sense here either.
+ unless ($depends->matches (qr/^phpapi-[\d\w+]+$/, MATCH_OR_CLAUSE_FULL)) {
tag 'missing-dependency-on-phpapi';
}
}
@@ -503,11 +500,13 @@ if ($has_php_ext) {
# Check for dependency on python-numpy-abiN dependency (or strict versioned
# dependency on python-numpy)
if ($uses_numpy_c_abi and $pkg ) {
+ # We do not allow alternatives as it would mostly likely defeat the purpose of this
+ # relation. Also, we do not allow versions for -abi as it is a virtual package.
tag 'missing-dependency-on-numpy-abi'
unless
- $depends =~ m/(?:^|,)\s*python-numpy-abi\d+\s*(?:,|\z)/ or (
- $depends =~ m/(?:^|,)\s*python-numpy\s+\(>[>=]/ and
- $depends =~ m/(?:^|,)\s*python-numpy\s+\(<[<=]/) or
+ $depends->matches (qr/^python-numpy-abi\d+$/, MATCH_OR_CLAUSE_FULL) or (
+ $depends->matches (qr/^python-numpy \(>[>=][^\|]+$/, MATCH_OR_CLAUSE_FULL) and
+ $depends->matches (qr/^python-numpy \(<[<=][^\|]+$/, MATCH_OR_CLAUSE_FULL)) or
$pkg eq 'python-numpy';
}
diff --git a/checks/scripts b/checks/scripts
index 0368a5c..8918d20 100644
--- a/checks/scripts
+++ b/checks/scripts
@@ -265,7 +265,6 @@ foreach (@{$info->sorted_index}) {
my $all_parsed = Lintian::Relation->and ($info->relation ('all'),
$info->relation ('provides'),
$pkg);
-my $all_deps = $all_parsed->unparse ();
my $str_deps = $info->relation('strong');
@@ -418,7 +417,8 @@ for my $filename (sort keys %{$info->scripts}) {
# Initialization files for csh.
} elsif ($base eq 'fish' && $filename =~ m,^etc/fish\.d/,) {
# Initialization files for fish.
- } elsif ($base eq 'ocamlrun' && $all_deps =~ /\bocaml(-base)?(-nox)?-\d\.[\d.]+/) {
+ } elsif ($base eq 'ocamlrun' &&
+ $all_parsed->matches (qr/^ocaml(?:-base)?(?:-nox)?-\d\.[\d.]+/)) {
# ABI-versioned virtual packages for ocaml
} else {
tag 'missing-dep-for-interpreter', "$base => $depends",
diff --git a/lib/Lintian/Relation.pm b/lib/Lintian/Relation.pm
index 3de9670..2709a08 100644
--- a/lib/Lintian/Relation.pm
+++ b/lib/Lintian/Relation.pm
@@ -24,6 +24,21 @@ use warnings;
use Lintian::Relation::Version;
+use constant {
+ MATCH_PRED_NAME => 0,
+ MATCH_PRED_FULL => 1,
+ MATCH_OR_CLAUSE_FULL => 3,
+};
+use base 'Exporter';
+our (@EXPORT, @EXPORT_OK, %EXPORT_TAGS);
+@EXPORT = ();
+%EXPORT_TAGS = (
+ constants => [qw(MATCH_PRED_NAME MATCH_PRED_FULL MATCH_OR_CLAUSE_FULL)],
+);
+@EXPORT_OK = (
+ @{ $EXPORT_TAGS{constants} }
+);
+
=head1 NAME
Lintian::Relation - Lintian operations on dependencies and relationships
@@ -657,6 +672,113 @@ sub unparse {
}
}
+=item matches (REGEX[, RULE])
+
+Check if one of the predicates in this relation matches REGEX. RULE
+determines what is tested against REGEX and if not given, defaults to
+MATCH_PRED_NAME.
+
+This method will return a truth value if REGEX matches at least one
+predicate or clause (as defined by the RULE parameter - see below).
+
+NOTE: Often L</implies> (or L</implies_inverse>) is a better choice
+than this method. This method should generally only be used when
+checking for a "pattern" package (e.g. phpapi-[\d\w+]+).
+
+
+RULE can be one of:
+
+=over 4
+
+=item MATCH_PRED_NAME
+
+Match REGEX against the package name in each predicate (i.e. version
+and architecture constrains are ignored). Each predicate is tested in
+isolation. As an example:
+
+ my $rel = Lintian::Relation->new ('somepkg | pkg-0 (>= 1)');
+ # Will match (version is ignored)
+ $rel->matches (qr/^pkg-\d$/, MATCH_PRED_NAME);
+
+=item MATCH_PRED_FULL
+
+Match REGEX against the full (normalized) predicate (i.e. including
+version and architecture). Each predicate is testing in isolation.
+As an example:
+
+ my $vrel = Lintian::Relation->new ('somepkg | pkg-0 (>= 1)');
+ my $uvrel = Lintian::Relation->new ('somepkg | pkg-0');
+
+ # Will NOT match (does not match with version)
+ $vrel->matches (qr/^pkg-\d$/, MATCH_PRED_FULL);
+ # Will match (this relation does not have a version)
+ $uvrel->matches (qr/^pkg-\d$/, MATCH_PRED_FULL);
+
+ # Will match (but only because there is a version)
+ $vrel->matches (qr/^pkg-\d \(.*\)$/, MATCH_PRED_FULL);
+ # Will NOT match (there is no verson in the relation)
+ $uvrel->matches (qr/^pkg-\d \(.*\)$/, MATCH_PRED_FULL);
+
+=item MATCH_OR_CLAUSE_FULL
+
+Match REGEX against the full (normalized) OR clause. Each predicate
+will have both version and architecture constrains present. As an
+example:
+
+
+ my $vpred = Lintian::Relation->new ('pkg-0 (>= 1)');
+ my $orrel = Lintian::Relation->new ('somepkg | pkg-0 (>= 1)');
+ my $rorrel = Lintian::Relation->new ('pkg-0 (>= 1) | somepkg');
+
+ # Will match
+ $vrel->matches (qr/^pkg-\d(?: \([^\)]\))?$/, MATCH_OR_CLAUSE_FULL);
+ # These Will NOT match (does not match the "|" and the "somepkg" part)
+ $orrel->matches (qr/^pkg-\d(?: \([^\)]\))?$/, MATCH_OR_CLAUSE_FULL);
+ $rorrel->matches (qr/^pkg-\d(?: \([^\)]\))?$/, MATCH_OR_CLAUSE_FULL);
+
+=back
+
+=cut
+
+
+# The last argument is not part of the public API. It's a partial
+# relation that's not a blessed object and is used by matches()
+# internally so that it can recurse.
+
+sub matches {
+ my ($self, $regex, $rule, $partial) = @_;
+ my $relation = $partial // $self;
+ $rule //= MATCH_PRED_NAME;
+ if ($relation->[0] eq 'PRED') {
+ my $against = $relation->[1];
+ $against = $self->unparse ($relation) if $rule & MATCH_PRED_FULL;
+ return 1 if $against =~ m/$regex/;
+ return;
+ } elsif ($rule == MATCH_OR_CLAUSE_FULL and $relation->[0] eq 'OR') {
+ my $against = $self->unparse ($relation);
+ return 1 if $against =~ m/$regex/;
+ return;
+ } elsif ($relation->[0] eq 'AND' or $relation->[0] eq 'OR' or
+ $relation->[0] eq 'NOT') {
+ for my $rel (@$relation[1 .. $#$relation]) {
+ return 1 if $self->matches ($regex, $rule, $rel);
+ }
+ return;
+ }
+}
+
+=item empty ()
+
+Returns a truth value if this relation is empty (i.e. it contains no
+predicates).
+
+=cut
+
+sub empty {
+ my ($self) = @_;
+ return 1 if $self->[0] eq 'AND' and not $self->[1];
+}
+
=back
=head1 AUTHOR
--
Debian package checker
Reply to: