[SCM] Debian package checker branch, master, updated. 2.4.3-182-gc374038
The following commit has been merged in the master branch:
commit 778fe3a3572fd98f309f5b5d9f9dfa4e8134301e
Author: Niels Thykier <niels@thykier.net>
Date: Wed Jan 26 15:22:06 2011 +0100
Fixed more PerlCritic warnings in some checks
diff --git a/checks/changelog-file b/checks/changelog-file
index 2c7ad24..80444a1 100644
--- a/checks/changelog-file
+++ b/checks/changelog-file
@@ -20,6 +20,7 @@
package Lintian::changelog_file;
use strict;
+use warnings;
use Lintian::Relation::Version qw(versions_gt);
use Lintian::Tags qw(tag);
@@ -87,8 +88,8 @@ foreach (@{$info->sorted_index}) {
}
# we are only interested in files or symlinks in /usr/(share/)?doc/$pkg
- if (m,usr/(share/)?doc/$ppkg/([^/\s]+), ) {
- my $file = $2;
+ if (m,usr/(?:share/)?doc/$ppkg/([^/\s]+), ) {
+ my $file = $1;
my $file1 = "usr/share/doc/$pkg/$file";
push(@doc_files, $file);
@@ -96,9 +97,9 @@ foreach (@{$info->sorted_index}) {
# Check a few things about the NEWS.Debian file.
if ($file =~ /^NEWS.Debian(?:\.gz)?$/i) {
if (not $file =~ /\.gz$/) {
- tag "debian-news-file-not-compressed", "$file1";
+ tag 'debian-news-file-not-compressed', "$file1";
} elsif ($file ne 'NEWS.Debian.gz') {
- tag "wrong-name-for-debian-news-file", "$file1";
+ tag 'wrong-name-for-debian-news-file', "$file1";
}
}
@@ -109,7 +110,7 @@ foreach (@{$info->sorted_index}) {
next unless $file =~ m/^changelog(?:\.html)?(?:\.gz)?$|changelog.Debian(?:\.gz)?$/;
if (not $file =~ m/\.gz$/) {
- tag "changelog-file-not-compressed", "$file";
+ tag 'changelog-file-not-compressed', "$file";
} else {
my $max_compressed = 0;
if (exists $file_info{$file1} && defined $file_info{$file1}) {
@@ -119,7 +120,7 @@ foreach (@{$info->sorted_index}) {
}
if (not $max_compressed and $file_info{$file1} =~ m/gzip compressed/) {
unless ($is_a_symlink{$file1}) {
- tag "changelog-not-compressed-with-max-compression", "$file";
+ tag 'changelog-not-compressed-with-max-compression', "$file";
}
}
}
@@ -145,12 +146,12 @@ my $news;
if (-f 'NEWS.Debian') {
my $line = file_is_encoded_in_non_utf8('NEWS.Debian', $type, $pkg);
if ($line) {
- tag "debian-news-file-uses-obsolete-national-encoding", "at line $line"
+ tag 'debian-news-file-uses-obsolete-national-encoding', "at line $line"
}
my $changes = Parse::DebianChangelog->init( { infile => 'NEWS.Debian', quiet => 1 } );
if (my @errors = $changes->get_parse_errors) {
for (@errors) {
- tag "syntax-error-in-debian-news-file", "line $_->[1]", "\"$_->[2]\"";
+ tag 'syntax-error-in-debian-news-file', "line $_->[1]", "\"$_->[2]\"";
}
}
@@ -158,7 +159,7 @@ if (-f 'NEWS.Debian') {
if ($changes->data and defined (($changes->data)[0])) {
($news) = $changes->data;
if ($news->Distribution && $news->Distribution =~ /unreleased/i) {
- tag "debian-news-entry-has-strange-distribution", $news->Distribution;
+ tag 'debian-news-entry-has-strange-distribution', $news->Distribution;
}
check_spelling('spelling-error-in-news-debian', $news->Changes,
undef, { $pkg => 1});
@@ -169,7 +170,7 @@ if (-f 'NEWS.Debian') {
}
if ( $found_html && !$found_text ) {
- tag "html-changelog-without-text-version", "";
+ tag 'html-changelog-without-text-version';
}
# is this a native Debian package?
@@ -177,11 +178,11 @@ my $version;
if (defined $info->field('version')) {
$version = $info->field('version');
} else {
- fail "Unable to determine version!";
+ fail 'Unable to determine version!';
}
$native_pkg = $info->native;
-$foreign_pkg = (!$native_pkg and $version !~ m/-0\./);
+$foreign_pkg = (!$native_pkg && $version !~ m/-0\./);
# A version of 1.2.3-0.1 could be either, so in that
# case, both vars are false
@@ -191,9 +192,9 @@ if ($native_pkg) {
if (grep m/^changelog(?:\.gz)?$/,@doc_files) {
# everything is fine
} elsif (@foo = grep m/^changelog\.debian(?:\.gz)$/i,@doc_files) {
- tag "wrong-name-for-changelog-of-native-package", "usr/share/doc/$pkg/$foo[0]";
+ tag 'wrong-name-for-changelog-of-native-package', "usr/share/doc/$pkg/$foo[0]";
} else {
- tag "changelog-file-missing-in-native-package", "";
+ tag 'changelog-file-missing-in-native-package';
}
} else {
# non-native (foreign :) Debian package
@@ -208,26 +209,26 @@ if ($native_pkg) {
my $found = 0;
for (@doc_files) {
if (m/^change/i and not m/debian/i) {
- tag "wrong-name-for-upstream-changelog", "usr/share/doc/$pkg/$_";
+ tag 'wrong-name-for-upstream-changelog', "usr/share/doc/$pkg/$_";
$found = 1;
last;
}
}
if (not $found) {
- tag "no-upstream-changelog";
+ tag 'no-upstream-changelog';
}
}
# 2. check for Debian changelog
if (grep m/^changelog\.Debian(?:\.gz)?$/,@doc_files) {
# everything is fine
- } elsif (my @foo = grep m/^changelog\.debian(\.gz)?$/i,@doc_files) {
- tag "wrong-name-for-debian-changelog-file", "usr/share/doc/$pkg/$foo[0]";
+ } elsif (my @foo = grep m/^changelog\.debian(?:\.gz)?$/i,@doc_files) {
+ tag 'wrong-name-for-debian-changelog-file', "usr/share/doc/$pkg/$foo[0]";
} else {
if ($foreign_pkg && $found_upstream_text_changelog) {
- tag "debian-changelog-file-missing-or-wrong-name", "";
+ tag 'debian-changelog-file-missing-or-wrong-name';
} elsif ($foreign_pkg) {
- tag "debian-changelog-file-missing", "";
+ tag 'debian-changelog-file-missing';
}
# TODO: if uncertain whether foreign or native, either changelog.gz or
# changelog.debian.gz should exists though... but no tests catches
@@ -253,15 +254,15 @@ unless (-f 'changelog') {
}
# check that changelog is UTF-8 encoded
-my $line = file_is_encoded_in_non_utf8("changelog", $type, $pkg);
+my $line = file_is_encoded_in_non_utf8('changelog', $type, $pkg);
if ($line) {
- tag "debian-changelog-file-uses-obsolete-national-encoding", "at line $line"
+ tag 'debian-changelog-file-uses-obsolete-national-encoding', "at line $line"
}
my $changes = $info->changelog;
if (my @errors = $changes->get_parse_errors) {
foreach (@errors) {
- tag "syntax-error-in-debian-changelog", "line $_->[1]", "\"$_->[2]\"";
+ tag 'syntax-error-in-debian-changelog', "line $_->[1]", "\"$_->[2]\"";
}
}
@@ -271,9 +272,9 @@ if (@entries) {
for my $entry (@entries) {
if ($entry->Maintainer) {
if ($entry->Maintainer =~ /<([^>\@]+\@unknown)>/) {
- tag "debian-changelog-file-contains-debmake-default-email-address", $1;
+ tag 'debian-changelog-file-contains-debmake-default-email-address', $1;
} elsif ($entry->Maintainer =~ /<([^>\@]+\@[^>.]*)>/) {
- tag "debian-changelog-file-contains-invalid-email-address", $1;
+ tag 'debian-changelog-file-contains-invalid-email-address', $1;
}
}
$versions{$entry->Version} = 1;
@@ -284,7 +285,7 @@ if (@entries) {
my $second_timestamp = $entries[1]->Timestamp;
if ($first_timestamp && $second_timestamp) {
- tag "latest-debian-changelog-entry-without-new-date"
+ tag 'latest-debian-changelog-entry-without-new-date'
unless (($first_timestamp - $second_timestamp) > 0
or lc($entries[0]->Distribution) eq 'unreleased');
}
@@ -292,10 +293,10 @@ if (@entries) {
my $first_version = $entries[0]->Version;
my $second_version = $entries[1]->Version;
if ($first_version and $second_version) {
- tag "latest-debian-changelog-entry-without-new-version"
+ tag 'latest-debian-changelog-entry-without-new-version'
unless versions_gt($first_version, $second_version)
or $entries[0]->Changes =~ /backport/i;
- tag "latest-debian-changelog-entry-changed-to-native"
+ tag 'latest-debian-changelog-entry-changed-to-native'
if $native_pkg and $second_version =~ m/-/;
}
@@ -304,7 +305,7 @@ if (@entries) {
my $second_upstream = $second_version;
$second_upstream =~ s/-[^-]+$//;
if ($first_upstream eq $second_upstream
- and $entries[0]->Changes =~ /^\s*\*\s+new\s+upstream\s+(\S+\s+)?release\b/im) {
+ and $entries[0]->Changes =~ /^\s*\*\s+new\s+upstream\s+(?:\S+\s+)?release\b/im) {
tag 'possible-new-upstream-release-without-new-version';
}
@@ -312,7 +313,7 @@ if (@entries) {
my $second_dist = lc $entries[1]->Distribution;
if ($first_dist eq 'unstable' and $second_dist eq 'experimental') {
unless ($entries[0]->Changes =~ /\bto\s+unstable\b/) {
- tag "experimental-to-unstable-without-comment";
+ tag 'experimental-to-unstable-without-comment';
}
}
}
@@ -325,11 +326,11 @@ if (@entries) {
}
my $changes = $entry->Changes || '';
while ($changes =~ /(closes\s*(?:bug)?\#?\s?\d{6,})[^\w]/ig) {
- tag "possible-missing-colon-in-closes", "$1" if $1;
+ tag 'possible-missing-colon-in-closes', "$1" if $1;
}
my $closes = $entry->Closes;
for my $bug (@$closes) {
- tag "improbable-bug-number-in-closes", $bug if ($bug < 100);
+ tag 'improbable-bug-number-in-closes', $bug if ($bug < 100);
}
# unstable, testing, and stable shouldn't be used in Debian version
@@ -383,8 +384,8 @@ if (@entries) {
my @lines = split ("\n", decode ('utf-8', $changes));
for my $i (0 .. $#lines) {
if (length($lines[$i]) > 81
- and $lines[$i] !~ /^[\s.o*+-]*([Ss]ee:?\s+)?\S+$/) {
- tag 'debian-changelog-line-too-long', "line " . ($i + 1);
+ and $lines[$i] !~ /^[\s.o*+-]*(?:[Ss]ee:?\s+)?\S+$/) {
+ tag 'debian-changelog-line-too-long', 'line ' . ($i + 1);
}
}
@@ -400,7 +401,7 @@ if (@entries) {
# one within 3000 chars of EOF and on the last page (^L), but that's a bit
# pesky to replicate. Demanding a match of $prefix and $suffix ought to
# be enough to avoid false positives.
-open (IN, '<', "changelog")
+open (IN, '<', 'changelog')
or fail("cannot find changelog for $type package $pkg");
my ($prefix, $suffix);
while (<IN>) {
@@ -409,7 +410,7 @@ while (<IN>) {
|| /closes:\s*(?:bug)?\#?\s?\d+
(?:,\s*(?:bug)?\#?\s?\d+)*
(?:,\s*(((?:bug)?\#?\s?\d*)[[:alpha:]]\w*))/iox) {
- tag "wrong-bug-number-in-closes", "l$.:$1" if $2;
+ tag 'wrong-bug-number-in-closes', "l$.:$1" if $2;
}
if (/^(.*)Local\ variables:(.*)$/i) {
@@ -419,7 +420,7 @@ while (<IN>) {
# emacs allows whitespace between prefix and variable, hence \s*
if (defined $prefix && defined $suffix
&& /^\Q$prefix\E\s*add-log-mailing-address:.*\Q$suffix\E$/) {
- tag "debian-changelog-file-contains-obsolete-user-emacs-settings";
+ tag 'debian-changelog-file-contains-obsolete-user-emacs-settings';
}
}
close IN;
diff --git a/checks/conffiles b/checks/conffiles
index d0e47a4..a978d9e 100644
--- a/checks/conffiles
+++ b/checks/conffiles
@@ -28,7 +28,7 @@ sub run {
my $pkg = shift;
my $type = shift;
-my $cf = "control/conffiles";
+my $cf = 'control/conffiles';
# conffiles?
unless (-f $cf) {
@@ -43,7 +43,7 @@ while (<IN>) {
next if m/^\s*$/;
unless (m,^/,) {
- tag "relative-conffile", $_;
+ tag 'relative-conffile', $_;
$_ = '/' . $_;
}
my $file = $_;
@@ -51,14 +51,14 @@ while (<IN>) {
$conffiles{$file}++;
if ($conffiles{$file} > 1) {
- tag "duplicate-conffile", $file;
+ tag 'duplicate-conffile', $file;
}
if (m,^/usr/,) {
- tag "file-in-usr-marked-as-conffile", $file;
+ tag 'file-in-usr-marked-as-conffile', $file;
} else {
unless (m,^/etc/,) {
- tag "non-etc-file-marked-as-conffile", $file;
+ tag 'non-etc-file-marked-as-conffile', $file;
}
}
diff --git a/checks/control-file b/checks/control-file
index 8c419bc..2ceec48 100644
--- a/checks/control-file
+++ b/checks/control-file
@@ -20,6 +20,7 @@
package Lintian::control_file;
use strict;
+use warnings;
use lib "$ENV{'LINTIAN_ROOT'}/checks/";
@@ -38,38 +39,38 @@ sub run {
my $pkg = shift;
my $type = shift;
-if (-l "debfiles/control") {
- tag "debian-control-file-is-a-symlink", "";
+if (-l 'debfiles/control') {
+ tag 'debian-control-file-is-a-symlink';
}
# check that control is UTF-8 encoded
-my $line = file_is_encoded_in_non_utf8("debfiles/control", $type, $pkg);
+my $line = file_is_encoded_in_non_utf8('debfiles/control', $type, $pkg);
if ($line) {
- tag "debian-control-file-uses-obsolete-national-encoding", "at line $line"
+ tag 'debian-control-file-uses-obsolete-national-encoding', "at line $line"
}
# Check that each field is only used once:
my $seen_fields = {};
-open (CONTROL, '<', "debfiles/control")
+open (CONTROL, '<', 'debfiles/control')
or fail "Couldn't read debfiles/control: $!";
while (<CONTROL>) {
s/\s*\n$//;
next if /^\#/;
#Reset seen_fields if we enter a new section:
- $seen_fields = {} if /^$/;
+ $seen_fields = {} if $_ eq '';
#line with field:
if (/^(\S+):/) {
my $field = lc ($1);
if ($seen_fields->{$field}) {
- tag "debian-control-with-duplicate-fields", "$field: $$seen_fields{$field}, $.";
+ tag 'debian-control-with-duplicate-fields', "$field: $$seen_fields{$field}, $.";
}
$seen_fields->{$field} = $.;
if ($field =~ /^xs-vcs-/) {
my $base = $field;
$base =~ s/^xs-//;
- tag "xs-vcs-header-in-debian-control", "$field"
+ tag 'xs-vcs-header-in-debian-control', "$field"
if $src_fields->known($base);
}
if ($field eq 'xc-package-type') {
@@ -82,12 +83,12 @@ while (<CONTROL>) {
}
close CONTROL;
-my ($header, @binary_controls) = read_dpkg_control("debfiles/control");
+my ($header, @binary_controls) = read_dpkg_control('debfiles/control');
for my $binary_control (@binary_controls) {
- tag "build-info-in-binary-control-file-section", "Package ".$binary_control->{"package"}
- if ($binary_control->{"build-depends"} || $binary_control->{"build-depends-indep"} ||
- $binary_control->{"build-conflicts"} || $binary_control->{"build-conflicts-indep"});
+ tag 'build-info-in-binary-control-file-section', 'Package '.$binary_control->{'package'}
+ if ($binary_control->{'build-depends'} || $binary_control->{'build-depends-indep'} ||
+ $binary_control->{'build-conflicts'} || $binary_control->{'build-conflicts-indep'});
for my $field (keys %$binary_control) {
tag 'binary-control-field-duplicates-source', "field \"$field\" in package ".$binary_control->{'package'},
if ($header->{$field} && $binary_control->{$field} eq $header->{$field});
@@ -176,7 +177,7 @@ for my $control (@binary_controls) {
for my $strong (0 .. $#dep_fields) {
next unless $control->{$dep_fields[$strong]};
my $relation = Lintian::Relation->new($control->{$dep_fields[$strong]});
- tag "package-depends-on-itself", $control->{package}, $dep_fields[$strong]
+ tag 'package-depends-on-itself', $control->{package}, $dep_fields[$strong]
if $relation->implies($control->{package});
tag 'package-depends-on-hardcoded-libc', $control->{package}, $dep_fields[$strong]
if ($relation->implies($libcs) and $pkg !~ /^e?glibc$/);
@@ -184,7 +185,7 @@ for my $control (@binary_controls) {
next unless $control->{$dep_fields[$weak]};
for my $dependency (split /\s*,\s*/, $control->{$dep_fields[$weak]}) {
next unless $dependency;
- tag "stronger-dependency-implies-weaker", $control->{package}, "$dep_fields[$strong] -> $dep_fields[$weak]", $dependency
+ tag 'stronger-dependency-implies-weaker', $control->{package}, "$dep_fields[$strong] -> $dep_fields[$weak]", $dependency
if $relation->implies($dependency);
}
}
@@ -216,7 +217,7 @@ if ($header->{'section'}) {
$area = '';
}
} else {
- tag "no-section-field-for-source", "";
+ tag 'no-section-field-for-source';
}
my @descriptions;
for my $binary_control (@binary_controls) {
@@ -245,9 +246,9 @@ for my $binary_control (@binary_controls) {
}
next;
}
- tag "section-area-mismatch", "Package " . $package
+ tag 'section-area-mismatch', 'Package ' . $package
if ($area && $binary_control->{'section'} !~ m%^$area/%);
- tag "section-area-mismatch", "Package " . $package
+ tag 'section-area-mismatch', 'Package ' . $package
if (!$area && $binary_control->{'section'} =~ m%^([^/]+)/% && $1 ne 'contrib');
}
diff --git a/checks/control-files b/checks/control-files
index 5a42c77..1ab86c6 100644
--- a/checks/control-files
+++ b/checks/control-files
@@ -20,6 +20,8 @@
package Lintian::control_files;
use strict;
+use warnings;
+
use Util;
use Lintian::Tags qw(tag);
@@ -57,7 +59,7 @@ my %ctrl = $type eq 'udeb' ? %ctrl_udeb : %ctrl_deb;
my %ctrl_alt = $type eq 'udeb' ? %ctrl_deb : %ctrl_udeb;
# process control-index file
-open(IN, '<', "control-index") or fail("cannot open control-index file: $!");
+open(IN, '<', 'control-index') or fail("cannot open control-index file: $!");
while (<IN>) {
chop;
@@ -75,17 +77,17 @@ while (<IN>) {
# valid control file?
unless ( exists $ctrl{$file} ) {
if ( exists $ctrl_alt{$file} ) {
- tag "not-allowed-control-file", "$file";
+ tag 'not-allowed-control-file', "$file";
next;
} else {
- tag "unknown-control-file", "$file";
+ tag 'unknown-control-file', "$file";
next;
}
}
# I'm not sure about the udeb case
if ($type ne 'udeb' and $size == 0) {
- tag "control-file-is-empty", "$file";
+ tag 'control-file-is-empty', "$file";
}
@@ -97,13 +99,13 @@ while (<IN>) {
# correct permissions?
unless ($operm == $ctrl{$file}) {
- tag "control-file-has-bad-permissions",
- sprintf("%s %04o != %04o",$file,$operm,$ctrl{$file});
+ tag 'control-file-has-bad-permissions',
+ sprintf('%s %04o != %04o',$file,$operm,$ctrl{$file});
}
# correct owner?
unless ($owner eq 'root/root') {
- tag "control-file-has-bad-owner", "$file $owner != root/root";
+ tag 'control-file-has-bad-owner', "$file $owner != root/root";
}
# for other maintainer scripts checks, see the scripts check
diff --git a/checks/copyright-file b/checks/copyright-file
index de6ffe0..8e878cd 100644
--- a/checks/copyright-file
+++ b/checks/copyright-file
@@ -20,6 +20,7 @@
package Lintian::copyright_file;
use strict;
+use warnings;
use lib "$ENV{'LINTIAN_ROOT'}/checks/";
use common_data;
@@ -47,8 +48,8 @@ my $linked = 0;
# Read package contents...
foreach (@{$info->sorted_index}) {
my $index_info = $info->index->{$_};
- if (m,usr/(share/)?doc/$ppkg/copyright(\.\S+)?$,) {
- my $ext = $2;
+ if (m,usr/(?:share/)?doc/$ppkg/copyright(\.\S+)?$,) {
+ my $ext = $1;
$ext = '' if (! defined $ext);
#an extension other than .gz doesn't count as copyright file
@@ -57,13 +58,13 @@ foreach (@{$info->sorted_index}) {
#search for an extension
if ($ext eq '.gz') {
- tag "copyright-file-compressed", "";
+ tag 'copyright-file-compressed';
last;
}
#make sure copyright is not a symlink
if ($index_info->{link}) {
- tag "copyright-file-is-symlink", "";
+ tag 'copyright-file-is-symlink';
last;
}
@@ -82,7 +83,7 @@ foreach (@{$info->sorted_index}) {
# check if this symlink references a directory elsewhere
if ($link =~ m,^(?:\.\.)?/,) {
- tag "usr-share-doc-symlink-points-outside-of-usr-share-doc", "$link";
+ tag 'usr-share-doc-symlink-points-outside-of-usr-share-doc', "$link";
last;
}
@@ -107,23 +108,23 @@ foreach (@{$info->sorted_index}) {
# We can only check if both packages come from the same source
# if our source package is currently unpacked in the lab, too!
- if (-d "source") { # yes, it's unpacked
+ if (-d 'source') { # yes, it's unpacked
# $link from the same source pkg?
if (-l "source/binary/$link") {
# yes, everything is ok.
} else {
# no, it is not.
- tag "usr-share-doc-symlink-to-foreign-package", "$link";
+ tag 'usr-share-doc-symlink-to-foreign-package', "$link";
}
} else { # no, source is not available
- tag "cannot-check-whether-usr-share-doc-symlink-points-to-foreign-package", "";
+ tag 'cannot-check-whether-usr-share-doc-symlink-points-to-foreign-package';
}
# everything is ok.
last;
} elsif (m,usr/doc/copyright/$ppkg$,) {
- tag "old-style-copyright-file", "";
+ tag 'old-style-copyright-file';
$found = 1;
last;
}
@@ -131,14 +132,14 @@ foreach (@{$info->sorted_index}) {
if (not $found) {
# #522827: special exception for perl for now
- tag "no-copyright-file", ""
+ tag 'no-copyright-file'
unless $pkg eq 'perl';
}
# check that copyright is UTF-8 encoded
-my $line = file_is_encoded_in_non_utf8("copyright", $type, $pkg);
+my $line = file_is_encoded_in_non_utf8('copyright', $type, $pkg);
if ($line) {
- tag "debian-copyright-file-uses-obsolete-national-encoding", "at line $line"
+ tag 'debian-copyright-file-uses-obsolete-national-encoding', "at line $line"
}
# check contents of copyright file
@@ -148,14 +149,14 @@ study $_;
my $wrong_directory_detected = 0;
if (m,\<fill in (?:http/)?ftp site\>, or m/\<Must follow here\>/) {
- tag "helper-templates-in-copyright", "";
+ tag 'helper-templates-in-copyright';
}
if (m,\<Put the license of the package here,) {
tag 'helper-templates-in-copyright';
}
if (m,(usr/share/common-licenses/(?:GPL|LGPL|BSD|Artistic)\.gz),) {
- tag "copyright-refers-to-compressed-license", $1;
+ tag 'copyright-refers-to-compressed-license', $1;
}
# Avoid complaining about referring to a versionless license file if the word
@@ -171,9 +172,9 @@ if (m,(usr/share/common-licenses/(L?GPL|GFDL))([^-]),i) {
|| m,as Perl itself,i
|| m,License-Alias:\s+Perl,
|| m,License:\s+Perl,) {
- tag "copyright-refers-to-symlink-license", $ref;
+ tag 'copyright-refers-to-symlink-license', $ref;
} else {
- tag "copyright-refers-to-versionless-license-file", $ref
+ tag 'copyright-refers-to-versionless-license-file', $ref
if /\bversion\b/;
}
}
@@ -185,24 +186,24 @@ if (m,/usr/share/common-licenses/BSD,) {
}
if (m,(usr/share/common-licences),) {
- tag "copyright-refers-to-incorrect-directory", $1;
+ tag 'copyright-refers-to-incorrect-directory', $1;
$wrong_directory_detected = 1;
}
if (m,usr/share/doc/copyright,) {
- tag "copyright-refers-to-old-directory", "";
+ tag 'copyright-refers-to-old-directory';
$wrong_directory_detected = 1;
}
if (m,usr/doc/copyright,) {
- tag "copyright-refers-to-old-directory", "";
+ tag 'copyright-refers-to-old-directory';
$wrong_directory_detected = 1;
}
# Lame check for old FSF zip code. Try to avoid false positives from other
# Cambridge, MA addresses.
if (m/(?:Free\s*Software\s*Foundation.*02139|02111-1307)/s) {
- tag "old-fsf-address-in-copyright-file", "";
+ tag 'old-fsf-address-in-copyright-file';
}
# Whether the package is covered by the GPL, used later for the libssl check.
@@ -211,24 +212,24 @@ my $gpl;
if (length($_) > 12000
and (m/\bGNU GENERAL PUBLIC LICENSE\s*TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION\b/m
or (m/\bGNU GENERAL PUBLIC LICENSE\s*Version 3/ and m/\bTERMS AND CONDITIONS\s/))) {
- tag "copyright-file-contains-full-gpl-license";
+ tag 'copyright-file-contains-full-gpl-license';
$gpl = 1;
}
if (length($_) > 12000
and m/\bGNU Free Documentation License\s*Version 1\.2/ and m/\b1\. APPLICABILITY AND DEFINITIONS/) {
- tag "copyright-file-contains-full-gfdl-license";
+ tag 'copyright-file-contains-full-gfdl-license';
}
if (length($_) > 10000
and m/\bApache License\s+Version 2\.0,/
and m/TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION/) {
- tag "copyright-file-contains-full-apache-2-license";
+ tag 'copyright-file-contains-full-apache-2-license';
}
# wtf?
if ((m,common-licenses(/\S+),) && (! m,/usr/share/common-licenses/,)) {
- tag "copyright-does-not-refer-to-common-license-file", "$1";
+ tag 'copyright-does-not-refer-to-common-license-file', "$1";
}
# This check is a bit prone to false positives, since some other licenses
@@ -252,16 +253,16 @@ if (m,/usr/share/common-licenses,
|| $wrong_directory_detected) {
# False positive or correct reference. Ignore.
} elsif (m/GNU Free Documentation License/i or m/\bGFDL\b/) {
- tag "copyright-should-refer-to-common-license-file-for-gfdl";
+ tag 'copyright-should-refer-to-common-license-file-for-gfdl';
} elsif (m/GNU (?:Lesser|Library) General Public License/i or m/\bLGPL\b/) {
- tag "copyright-should-refer-to-common-license-file-for-lgpl";
+ tag 'copyright-should-refer-to-common-license-file-for-lgpl';
} elsif (m/GNU General Public License/i or m/\bGPL\b/) {
- tag "copyright-should-refer-to-common-license-file-for-gpl";
+ tag 'copyright-should-refer-to-common-license-file-for-gpl';
$gpl = 1;
}
if (m,(?:under )?(?:the )?(?:same )?(?:terms )?as Perl itself,i &&
!m,usr/share/common-licenses/,) {
- tag "copyright-file-lacks-pointer-to-perl-license";
+ tag 'copyright-file-lacks-pointer-to-perl-license';
}
# Checks for various packaging helper boilerplate.
@@ -278,11 +279,11 @@ if (m/This copyright info was automatically extracted/) {
}
if (m,url://example\.com,) {
- tag "copyright-has-url-from-dh_make-boilerplate";
+ tag 'copyright-has-url-from-dh_make-boilerplate';
}
if (m{\# Please also look if there are files or directories which have a\n\# different copyright/license attached and list them here\.}) {
- tag "copyright-contains-dh_make-todo-boilerplate", "";
+ tag 'copyright-contains-dh_make-todo-boilerplate';
}
if (m,The\s+Debian\s+packaging\s+is\s+\(C\)\s+\d+,i) {
@@ -290,10 +291,10 @@ if (m,The\s+Debian\s+packaging\s+is\s+\(C\)\s+\d+,i) {
}
# Bad licenses.
-if (m/(The\s+PHP\s+Licen[cs]e,?\s+version\s+2)/si) {
+if (m/The\s+PHP\s+Licen[cs]e,?\s+version\s+2/si) {
tag 'copyright-refers-to-bad-php-license';
}
-if (m/(The\s+PHP\s+Licen[cs]e,?\s+version\s+3\.0[^\d])/si) {
+if (m/The\s+PHP\s+Licen[cs]e,?\s+version\s+3\.0[^\d]/si) {
tag 'copyright-refers-to-problematic-php-license';
}
diff --git a/checks/cruft b/checks/cruft
index 0bef1d1..a74301d 100644
--- a/checks/cruft
+++ b/checks/cruft
@@ -24,6 +24,7 @@
package Lintian::cruft;
use strict;
+use warnings;
use Lintian::Data;
use Lintian::Relation ();
@@ -91,7 +92,7 @@ my $pkg = shift;
my $type = shift;
my $info = shift;
-if (-e "debfiles/files" and not -z "debfiles/files") {
+if (-e 'debfiles/files' and not -z 'debfiles/files') {
tag 'debian-files-list-in-source';
}
@@ -131,7 +132,7 @@ if ($format =~ /^\s*2\.0\s*\z/ or $format =~ /^\s*3\.0\s*\(quilt\)/) {
my $wanted = sub { check_debfiles($pkg, $info, \%warned) };
find($wanted, 'debfiles');
} elsif (not $info->native) {
- check_diffstat("diffstat", \%warned);
+ check_diffstat('diffstat', \%warned);
}
my $wanted = sub { find_cruft($pkg, $info, \%warned, $atdinbd, $ltinbd) };
find($wanted, 'unpacked');
@@ -142,9 +143,9 @@ my $file_info = $info->file_info;
for my $file (keys(%$file_info)) {
next if ($file =~ m,(?:^|/)t(?:est(?:s(?:et)?)?)?/,);
if ($file_info->{$file} =~ m/\bELF\b/) {
- tag "source-contains-prebuilt-binary", $file;
+ tag 'source-contains-prebuilt-binary', $file;
} elsif ($file_info->{$file} =~ m/\bPE(32|64)\b/) {
- tag "source-contains-prebuilt-windows-binary", $file;
+ tag 'source-contains-prebuilt-windows-binary', $file;
}
}
@@ -154,7 +155,7 @@ for my $file (@EOL_terminators_files) {
next unless defined $file_info->{$file};
- tag "control-file-with-CRLF-EOLs", $file
+ tag 'control-file-with-CRLF-EOLs', $file
if ($file_info->{$file} =~ m/\bCRLF\b/);
}
@@ -205,7 +206,7 @@ sub check_diffstat {
# Check for CMake cache files. These embed the source path and hence
# will cause FTBFS on buildds, so they should never be touched in the
# diff.
- if ($file =~ m,(^|/)CMakeCache.txt\z, and $file !~ m,(^|/)debian/,) {
+ if ($file =~ m,(?:^|/)CMakeCache.txt\z, and $file !~ m,(?:^|/)debian/,) {
tag 'diff-contains-cmake-cache-file', $file;
}
@@ -304,7 +305,7 @@ sub find_cruft {
return;
}
- my $prefix = ($info->native ? "diff-contains" : "source-contains");
+ my $prefix = ($info->native ? 'diff-contains' : 'source-contains');
if (-d and not $warned->{$name}) {
for my $rule (@directory_checks) {
if ($name =~ /$rule->[0]/) {
@@ -328,7 +329,7 @@ sub find_cruft {
# as part of the build.
if ($name =~ m,^(.+/)?config.(?:cache|log|status)$,) {
if ($name !~ m,^debian/config\.cache$,) {
- tag "configure-generated-file-in-source", $name;
+ tag 'configure-generated-file-in-source', $name;
}
} elsif ($name =~ m,^(.+/)?config.(?:guess|sub)$, and not $atdinbd) {
my $b = basename $name;
@@ -346,7 +347,7 @@ sub find_cruft {
}
close F;
} elsif ($name =~ m,^(.+/)?ltconfig$, and not $ltinbd) {
- tag "ancient-libtool", $name;
+ tag 'ancient-libtool', $name;
} elsif ($name =~ m,^(.+/)?ltmain\.sh$, and not $ltinbd) {
my $b = basename $name;
open (F, '<', $b) or die "can't open $name: $!";
@@ -354,9 +355,9 @@ sub find_cruft {
if (/^VERSION=[\"\']?(1\.(\d)\.(\d+)(?:-(\d))?)/) {
my ($version, $major, $minor, $debian) = ($1, $2, $3, $4);
if ($major < 5 or ($major == 5 and $minor < 2)) {
- tag "ancient-libtool", $name, $version;
+ tag 'ancient-libtool', $name, $version;
} elsif ($minor == 2 and (!$debian or $debian < 2)) {
- tag "ancient-libtool", $name, $version;
+ tag 'ancient-libtool', $name, $version;
} elsif ($minor < 24) {
# not entirely sure whether that would be good idea
# tag "outdated-libtool", $name, $version;
diff --git a/checks/deb-format b/checks/deb-format
index 526e2f6..62edb8b 100644
--- a/checks/deb-format
+++ b/checks/deb-format
@@ -17,6 +17,7 @@
package Lintian::deb_format;
use strict;
+use warnings;
use Lintian::Command qw(spawn);
use Lintian::Tags qw(tag);
@@ -67,7 +68,7 @@ if ($success) {
} else {
tag 'lzma-deb-archive';
}
- } elsif ($members[2] !~ /^data\.tar\.(gz|bz2)\z/) {
+ } elsif ($members[2] !~ /^data\.tar\.(?:gz|bz2)\z/) {
tag 'malformed-deb-archive',
"third member $members[2] not data.tar.(gz|bz2)";
} else {
@@ -88,8 +89,8 @@ if ($success) {
# may eventually have a case where dpkg supports a newer format but it's not
# permitted in the archive yet.
if ($okay) {
- my $opts = {};
- my $success = spawn($opts, ['ar', 'p', 'deb', 'debian-binary']);
+ $opts = {};
+ $success = spawn($opts, ['ar', 'p', 'deb', 'debian-binary']);
if (not $success) {
tag 'malformed-deb-archive', "can't read debian-binary member";
} elsif (${ $opts->{out} } !~ /^2\.\d+\n/) {
diff --git a/checks/debconf b/checks/debconf
index ea1c9a7..94a4e64 100644
--- a/checks/debconf
+++ b/checks/debconf
@@ -20,6 +20,7 @@
package Lintian::debconf;
use strict;
+use warnings;
use Lintian::Relation;
use Lintian::Tags qw(tag);
@@ -71,7 +72,7 @@ if ($type eq 'source') {
my $binaries = $info->field('binary');
chomp $binaries;
my @files = map { "$_.templates" } split /,\s+/, $binaries;
- push @files, "templates";
+ push @files, 'templates';
foreach my $file (@files) {
my $templates_file = "debfiles/$file";
@@ -79,16 +80,16 @@ if ($type eq 'source') {
$binary =~ s/\.?templates$//;
# Single binary package (so @files contains "templates" and
# "binary.templates")?
- if (!$binary and $#files == 1) {
+ if (!$binary && $#files == 1) {
$binary = $binaries;
}
if (-f $templates_file) {
- my @templates = read_dpkg_control($templates_file, "templates file");
+ my @templates = read_dpkg_control($templates_file, 'templates file');
foreach my $template (@templates) {
if (exists $template->{template} and exists $template->{_choices}) {
- tag "template-uses-unsplit-choices",
+ tag 'template-uses-unsplit-choices',
"$binary - $template->{template}";
}
}
@@ -99,7 +100,7 @@ if ($type eq 'source') {
return 0;
}
-if (open(PREINST, '<', "control/preinst")) {
+if (open(PREINST, '<', 'control/preinst')) {
while (<PREINST>) {
s/\#.*//; # Not perfect for Perl, but should be OK
if (m,/usr/share/debconf/confmodule, or
@@ -111,10 +112,10 @@ if (open(PREINST, '<', "control/preinst")) {
close PREINST;
}
-if (-f "control/config") {
+if (-f 'control/config') {
$seenconfig=1;
}
-if (-f "control/templates") {
+if (-f 'control/templates') {
$seentemplates=1;
}
@@ -155,18 +156,18 @@ my $usesdbconfig = $alldependencies->implies('dbconfig-common');
# Check that both debconf control area files are present.
if ($seenconfig and not $seentemplates and not $usesdbconfig) {
- tag "no-debconf-templates", "";
+ tag 'no-debconf-templates';
} elsif ($seentemplates and not $seenconfig and not $usespreinst and $type ne 'udeb') {
- tag "no-debconf-config", "";
+ tag 'no-debconf-config';
}
-if ($seenconfig and not -x "control/config") {
- tag "debconf-config-not-executable", "";
+if ($seenconfig and not -x 'control/config') {
+ tag 'debconf-config-not-executable';
}
# First check that templates look valid
if ($seentemplates) {
- open(TMPL, '<', "control/templates")
+ open(TMPL, '<', 'control/templates')
or fail("Can't open control/templates: $!");
local $/ = "\n\n";
while (<TMPL>) {
@@ -184,7 +185,7 @@ if ($seentemplates) {
foreach (keys %fields) {
if ($fields{$_} > 1) {
local $/ = "\n";
- tag "duplicate-fields-in-templates", "$name $_";
+ tag 'duplicate-fields-in-templates', "$name $_";
# Templates file is corrupted, no need to report
# further errors
$seentemplates = '';
@@ -196,7 +197,7 @@ if ($seentemplates) {
# Lots of template checks.
-my @templates = $seentemplates ? read_dpkg_control("control/templates", "templates file") : ();
+my @templates = $seentemplates ? read_dpkg_control('control/templates', 'templates file') : ();
my %potential_db_abuse;
my @templates_seen;
@@ -204,26 +205,26 @@ foreach my $template (@templates) {
my $isselect='';
if (not exists $template->{template}) {
- tag "no-template-name", "";
+ tag 'no-template-name';
$template->{template} = 'no-template-name';
} else {
push @templates_seen, $template->{template};
if ($template->{template}!~m|[A-Za-z0-9.+-](?:/[A-Za-z0-9.+-])|) {
- tag "malformed-template-name", "$template->{template}";
+ tag 'malformed-template-name', "$template->{template}";
}
}
if (not exists $template->{type}) {
- tag "no-template-type", "$template->{template}";
+ tag 'no-template-type', "$template->{template}";
} elsif (not $valid_types{$template->{type}}) {
- tag "unknown-template-type", "$template->{type}";
+ tag 'unknown-template-type', "$template->{type}";
} elsif ($template->{type} eq 'select') {
$isselect=1;
} elsif ($template->{type} eq 'multiselect') {
$isselect=1;
$usesmultiselect=1;
} elsif ($template->{type} eq 'boolean') {
- tag "boolean-template-has-bogus-default",
+ tag 'boolean-template-has-bogus-default',
"$template->{template} $template->{default}"
if defined $template->{default}
and $template->{default} ne 'true'
@@ -234,21 +235,21 @@ foreach my $template (@templates) {
my $nrchoices = count_choices ($template->{choices});
for my $key (keys %$template) {
if ($key =~ /^choices-/) {
- if (! $template->{$key} || ($template->{$key} =~ /^\s*$/)) {
- tag "empty-translated-choices", "$template->{template} $key";
+ if (! $template->{$key} || ($template->{$key} =~ /^\s*$/o)) {
+ tag 'empty-translated-choices', "$template->{template} $key";
}
if (count_choices ($template->{$key}) != $nrchoices) {
- tag "mismatch-translated-choices", "$template->{template} $key";
+ tag 'mismatch-translated-choices', "$template->{template} $key";
}
}
}
if ($template->{choices} =~ /^\s*(yes\s*,\s*no|no\s*,\s*yes)\s*$/i) {
- tag "select-with-boolean-choices", "$template->{template}";
+ tag 'select-with-boolean-choices', "$template->{template}";
}
}
if ($isselect and not exists $template->{choices}) {
- tag "select-without-choices", "$template->{template}";
+ tag 'select-without-choices', "$template->{template}";
}
if (not exists $template->{description}) {
@@ -256,7 +257,7 @@ foreach my $template (@templates) {
} elsif ($template->{description}=~m/^\s*(.*?)\s*?\n\s*\1\s*$/) {
# Check for duplication. Should all this be folded into the
# description checks?
- tag "duplicate-long-description-in-template",
+ tag 'duplicate-long-description-in-template',
"$template->{template}";
}
@@ -268,13 +269,13 @@ foreach my $template (@templates) {
$languages{$lang}{$mainfield}=1;
}
unless ($template_fields{$mainfield}) { # Ignore language codes here
- tag "unknown-field-in-templates", "$template->{template} $field";
+ tag 'unknown-field-in-templates', "$template->{template} $field";
}
}
if ($template->{template} && $template->{type}) {
$potential_db_abuse{$template->{template}} = 1
- if (($template->{type} eq "note") or ($template->{type} eq "text"));
+ if (($template->{type} eq 'note') or ($template->{type} eq 'text'));
}
# Check the description against the best practices in the Developer's
@@ -296,37 +297,37 @@ foreach my $template (@templates) {
my $isselect = grep { $_ eq $ttype } qw(select multiselect);
if ($isprompt) {
if ($short && ($short !~ m/:$/ || $short =~ m/^(what|who|when|where|which|how)/i)) {
- tag "malformed-prompt-in-templates", $template->{template};
+ tag 'malformed-prompt-in-templates', $template->{template};
}
}
if ($isselect) {
if ($short =~ /^(Please|Cho+se|Enter|Select|Specify|Give)/) {
- tag "using-imperative-form-in-templates", $template->{template};
+ tag 'using-imperative-form-in-templates', $template->{template};
}
}
if ($ttype eq 'boolean') {
if ($short !~ /\?/) {
- tag "malformed-question-in-templates", $template->{template};
+ tag 'malformed-question-in-templates', $template->{template};
}
}
if (defined ($extended) && $extended =~ /[^\?]\?(\s+|$)/) {
- tag "using-question-in-extended-description-in-templates", $template->{template};
+ tag 'using-question-in-extended-description-in-templates', $template->{template};
}
if ($ttype eq 'note') {
if ($short =~ /[.?;:]$/) {
- tag "malformed-title-in-templates", $template->{template};
+ tag 'malformed-title-in-templates', $template->{template};
}
}
if (length ($short) > 75) {
- tag "too-long-short-description-in-templates", $template->{template}
+ tag 'too-long-short-description-in-templates', $template->{template}
unless $type eq 'udeb' && $ttype eq 'text';
}
if (defined $template->{description}) {
if ($template->{description} =~ /(\A|\s)(I|[Mm]y|[Ww]e|[Oo]ur|[Oo]urs|mine|myself|ourself|me|us)(\Z|\s)/) {
- tag "using-first-person-in-templates", $template->{template};
+ tag 'using-first-person-in-templates', $template->{template};
}
if ($template->{description} =~ /[ \'\"]yes[ \'\",;.]/i and $ttype eq 'boolean') {
- tag "making-assumptions-about-interfaces-in-templates", $template->{template};
+ tag 'making-assumptions-about-interfaces-in-templates', $template->{template};
}
}
@@ -349,7 +350,7 @@ foreach my $template (@templates) {
$lines++;
}
if ($lines > 20) {
- tag "too-long-extended-description-in-templates", $template->{template};
+ tag 'too-long-extended-description-in-templates', $template->{template};
}
}
}
@@ -386,13 +387,14 @@ for my $file (qw(config prerm postrm preinst postinst)) {
$_ .= $next;
}
if (m,(?:\.|source)\s+/usr/share/debconf/confmodule, ||
- m/(use|require)\s+Debconf::Client::ConfModule/) {
+ m/(?:use|require)\s+Debconf::Client::ConfModule/) {
$usesconfmodule=1;
}
if (not $obsoleteconfmodule and
m,(/usr/share/debconf/confmodule\.sh|
Debian::DebConf::Client::ConfModule),x) {
- tag "loads-obsolete-confmodule", "$file:$. $1";
+ my $cmod = $1;
+ tag 'loads-obsolete-confmodule', "$file:$. $cmod";
$usesconfmodule=1;
$obsoleteconfmodule=1;
}
@@ -402,7 +404,7 @@ for my $file (qw(config prerm postrm preinst postinst)) {
if ($file eq 'postinst' and not $db_input and m/db_input/
and not $config_calls_db_input) {
# TODO: Perl?
- tag "postinst-uses-db-input", ""
+ tag 'postinst-uses-db-input'
unless $type eq 'udeb';
$db_input=1;
}
@@ -413,15 +415,15 @@ for my $file (qw(config prerm postrm preinst postinst)) {
my ($priority, $template) = ($1, $2);
$templates_used{$template} = 1;
if ($priority !~ /^\$\S+$/) {
- tag "unknown-debconf-priority", "$file:$. $1"
+ tag 'unknown-debconf-priority', "$file:$. $1"
unless ($valid_priorities{$priority});
- tag "possible-debconf-note-abuse", "$file:$. $template"
+ tag 'possible-debconf-note-abuse', "$file:$. $template"
if ($potential_db_abuse{$template}
- and (not ($potential_makedev->{($. - 1)} and ($priority eq "low")))
+ and (not ($potential_makedev->{($. - 1)} and ($priority eq 'low')))
and ($priority =~ /^(low|medium)$/));
}
}
- if (m/^\s*(?:db_get|db_set(?:title)?)\s+[\"\']?(\S+?)[\"\']?(\s|\Z)/) {
+ if (m/^\s*(?:db_get|db_set(?:title)?)\s+[\"\']?(\S+?)[\"\']?(?:\s|\Z)/) {
$templates_used{$1} = 1;
}
# Try to handle Perl somewhat.
@@ -434,7 +436,7 @@ for my $file (qw(config prerm postrm preinst postinst)) {
}
if (not $isdefault and m/db_fset.*isdefault/) {
# TODO: Perl?
- tag "isdefault-flag-is-deprecated", "$file";
+ tag 'isdefault-flag-is-deprecated', "$file";
$isdefault=1;
}
if (not $db_purge and m/db_purge/) { # TODO: Perl?
@@ -444,23 +446,23 @@ for my $file (qw(config prerm postrm preinst postinst)) {
if ($file eq 'postinst' or $file eq 'config') {
unless ($usesconfmodule) {
- tag "$file-does-not-load-confmodule", ""
+ tag "$file-does-not-load-confmodule"
unless ($type eq 'udeb' || ($file eq 'postinst' && !$seenconfig));
}
}
if ($file eq 'postrm') {
unless ($db_purge) {
- tag "postrm-does-not-purge-debconf", "";
+ tag 'postrm-does-not-purge-debconf';
}
}
close IN;
} elsif ($file eq 'postinst') {
- tag "$file-does-not-load-confmodule", ""
+ tag 'postinst-does-not-load-confmodule'
unless ($type eq 'udeb' || !$seenconfig);
} elsif ($file eq 'postrm') {
- tag "postrm-does-not-purge-debconf", ""
+ tag 'postrm-does-not-purge-debconf'
unless ($type eq 'udeb');
}
}
@@ -481,8 +483,8 @@ foreach my $template (@templates_seen) {
}
}
- unless ($used or $pkg eq "debconf" or $type eq 'udeb') {
- tag "unused-debconf-template", $template
+ unless ($used or $pkg eq 'debconf' or $type eq 'udeb') {
+ tag 'unused-debconf-template', $template
unless $template =~ m,^shared/packages-(wordlist|ispell)$,
or $template =~ m,/languages$,;
}
@@ -494,12 +496,12 @@ foreach my $template (@templates_seen) {
my $anydebconf = join (' | ', @debconfs);
if ($usespreinst) {
unless ($dependencies{'pre-depends'}->implies($anydebconf)) {
- tag "missing-debconf-dependency-for-preinst", ""
+ tag 'missing-debconf-dependency-for-preinst'
unless $type eq 'udeb';
}
} else {
unless ($alldependencies->implies($anydebconf) or $usesdbconfig) {
- tag "missing-debconf-dependency", "";
+ tag 'missing-debconf-dependency';
}
}
@@ -509,7 +511,7 @@ if ($usespreinst) {
# the following checks is ignored if the package being checked is debconf
# itself.
-return 0 if ($pkg eq "debconf") || ($type eq 'udeb');
+return 0 if ($pkg eq 'debconf') || ($type eq 'udeb');
foreach my $filename (sort keys %{$info->scripts}) {
open(IN, '<', "unpacked/$filename") or fail("cannot open $filename: $!");
@@ -517,7 +519,7 @@ foreach my $filename (sort keys %{$info->scripts}) {
s/#.*//; # Not perfect for Perl, but should be OK
if (m,/usr/share/debconf/confmodule, or
m/(?:Debconf|Debian::DebConf)::Client::ConfModule/) {
- tag "debconf-is-not-a-registry", "$filename";
+ tag 'debconf-is-not-a-registry', "$filename";
last;
}
}
diff --git a/checks/debhelper b/checks/debhelper
index 8701cca..cc772bc 100644
--- a/checks/debhelper
+++ b/checks/debhelper
@@ -20,6 +20,7 @@
package Lintian::debhelper;
use strict;
+use warnings;
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Util;
@@ -70,13 +71,13 @@ my $seendhcleank = '';
my $overridetargets = 0;
my %missingbdeps;
-open(RULES, '<', "debfiles/rules") or fail("cannot read debian/rules: $!");
+open(RULES, '<', 'debfiles/rules') or fail("cannot read debian/rules: $!");
my $maybe_skipping;
my $dhcompatvalue;
my @versioncheck;
my $inclcdbs = 0;
while (<RULES>) {
- if (/^ifn?(eq|def)\s/) {
+ if (/^ifn?(?:eq|def)\s/) {
$maybe_skipping++;
} elsif (/^endif\s/) {
$maybe_skipping--;
@@ -86,13 +87,13 @@ while (<RULES>) {
my $dhcommand = $1;
if ($dhcommand eq 'dh_dhelp') {
- tag "dh_dhelp-is-deprecated", "line $.";
+ tag 'dh_dhelp-is-deprecated', "line $.";
}
if ($dhcommand eq 'dh_suidregister') {
- tag "dh_suidregister-is-obsolete", "line $.";
+ tag 'dh_suidregister-is-obsolete', "line $.";
}
if ($dhcommand eq 'dh_undocumented') {
- tag "dh_undocumented-is-obsolete", "line $.";
+ tag 'dh_undocumented-is-obsolete', "line $.";
}
# Don't warn about recently deprecated commands in code that may be
@@ -104,7 +105,7 @@ while (<RULES>) {
if ($dhcommand eq 'dh_scrollkeeper') {
tag 'dh_scrollkeeper-is-deprecated', "line $.";
}
- if ($dhcommand eq 'dh_clean' and m/\s+\-k(\s+.*)?$/) {
+ if ($dhcommand eq 'dh_clean' and m/\s+\-k(?:\s+.*)?$/) {
$seendhcleank = 1;
}
}
@@ -176,7 +177,7 @@ close RULES;
unless ($inclcdbs){
my $bdepends = $info->relation('build-depends-all');
# Okay - d/rules does not include any file in /usr/share/cdbs/
- tag "unused-build-dependency-on-cdbs" if ($bdepends->implies("cdbs"));
+ tag 'unused-build-dependency-on-cdbs' if ($bdepends->implies('cdbs'));
}
return unless $seencommand;
@@ -241,11 +242,11 @@ if ($usescdbs and not defined($level)) {
}
$level ||= 1;
if ($level < 5) {
- tag "package-uses-deprecated-debhelper-compat-version", $level;
+ tag 'package-uses-deprecated-debhelper-compat-version', $level;
}
if ($seendhcleank and $level >= 7) {
- tag "dh-clean-k-is-deprecated";
+ tag 'dh-clean-k-is-deprecated';
}
@@ -275,23 +276,22 @@ while (defined(my $file=readdir(DEBIAN))) {
unless (($binpkg && exists($pkgs->{$binpkg})
&& ($pkgs->{$binpkg} eq 'udeb'))
or (!$binpkg && ($single_pkg eq 'udeb'))) {
- tag "maintainer-script-lacks-debhelper-token", "debian/$file";
+ tag 'maintainer-script-lacks-debhelper-token', "debian/$file";
}
}
} elsif ($file eq 'control') {
my $bdepends_noarch = $info->relation_noarch('build-depends-all');
my $bdepends = $info->relation('build-depends-all');
if ($needbuilddepends && ! $bdepends->implies('debhelper')) {
- tag "package-uses-debhelper-but-lacks-build-depends", "";
+ tag 'package-uses-debhelper-but-lacks-build-depends';
}
while (my ($dep, $command) = each %missingbdeps) {
next if $dep eq 'debhelper'; #handled above
tag 'missing-build-dependency-for-dh_-command', "$command=$dep"
unless ($bdepends_noarch->implies($dep));
}
- my $needed = "debhelper (>= $level~)";
- if (not $bdepends->implies($needed)) {
- tag "package-lacks-versioned-build-depends-on-debhelper", $level;
+ if (not $bdepends->implies("debhelper (>= $level~)")) {
+ tag 'package-lacks-versioned-build-depends-on-debhelper', $level;
} elsif (@versioncheck or $overridetargets) {
my %seen;
@versioncheck = grep { !$seen{$_}++ } @versioncheck;
@@ -313,7 +313,7 @@ while (defined(my $file=readdir(DEBIAN))) {
}
}
} elsif ($file =~ m/^ex\.|\.ex$/i) {
- tag "dh-make-template-in-source", "debian/$file";
+ tag 'dh-make-template-in-source', "debian/$file";
} elsif ($file =~ m/^(?:.+\.)?debhelper(?:\.log)?$/){
push(@indebfiles, $file);
} else {
@@ -345,13 +345,13 @@ closedir(DEBIAN);
if(scalar(@indebfiles)){
my $f = pop(@indebfiles);
my $others = scalar(@indebfiles);
- my $otext = "";
+ my $otext = '';
if($others > 1){
$otext = " and $others others";
} elsif($others == 1){
- $otext = " and 1 other";
+ $otext = ' and 1 other';
}
- tag "temporary-debhelper-file", "$f$otext";
+ tag 'temporary-debhelper-file', "$f$otext";
}
# Check for Python policy usage and the required debhelper dependency for
@@ -359,12 +359,12 @@ if(scalar(@indebfiles)){
# something earlier than 2 know what they're doing. Skip CDBS packages since
# CDBS creates pycompat internally at build time.
if ($seendhpython && !$usescdbspython) {
- if (open(PYCOMPAT, '<', "debfiles/pycompat")) {
+ if (open(PYCOMPAT, '<', 'debfiles/pycompat')) {
local $/;
my $pycompat = <PYCOMPAT>;
close PYCOMPAT;
} else {
- tag "uses-dh-python-with-no-pycompat", "";
+ tag 'uses-dh-python-with-no-pycompat';
}
}
diff --git a/checks/debian-readme b/checks/debian-readme
index 6f882f4..cb07887 100644
--- a/checks/debian-readme
+++ b/checks/debian-readme
@@ -20,6 +20,8 @@
package Lintian::debian_readme;
use strict;
+use warnings;
+
use Lintian::Check qw(check_spelling);
use Lintian::Tags qw(tag);
@@ -27,10 +29,9 @@ sub run {
my $pkg = shift;
my $type = shift;
-my $readme = "";
-my $template;
+my $readme = '';
-if (open(IN, '<', "README.Debian")) {
+if (open(IN, '<', 'README.Debian')) {
local $_;
while (<IN>) {
if (m,/usr/doc\b,) {
@@ -47,9 +48,9 @@ my @template =
'<possible notes regarding this package - if none, delete this file>');
my $regex = join ('|', @template);
if ($readme =~ m/$regex/io) {
- tag("readme-debian-contains-debmake-template");
+ tag 'readme-debian-contains-debmake-template';
} elsif ($readme =~ m/^\s*-- [^<]*<[^> ]+.\@unknown>/m) {
- tag("readme-debian-contains-debmake-default-email-address");
+ tag 'readme-debian-contains-debmake-default-email-address';
}
check_spelling('spelling-error-in-readme-debian', $readme, undef, { $pkg => 1 });
diff --git a/checks/debian-source-dir b/checks/debian-source-dir
index 75d87e5..85fea44 100644
--- a/checks/debian-source-dir
+++ b/checks/debian-source-dir
@@ -20,6 +20,7 @@
package Lintian::debian_source_dir;
use strict;
+use warnings;
use Lintian::Data;
use Lintian::Tags qw(tag);
@@ -51,7 +52,7 @@ if (-d 'debfiles/source') {
my $file;
while ($file = readdir(DEBSRC)) {
next if $file eq '.' or $file eq '..';
- tag "unknown-file-in-debian-source", $file
+ tag 'unknown-file-in-debian-source', $file
unless $KNOWN_FILES->known($file);
}
closedir(DEBSRC);
diff --git a/checks/fields b/checks/fields
index cd365c5..ac88727 100644
--- a/checks/fields
+++ b/checks/fields
@@ -24,6 +24,7 @@
package Lintian::fields;
use strict;
+use warnings;
use lib "$ENV{'LINTIAN_ROOT'}/checks/";
@@ -187,7 +188,7 @@ my $info = shift;
my $version;
my $arch_indep;
-unless (-d "fields") {
+unless (-d 'fields') {
fail("directory in lintian laboratory for $type package $pkg missing: fields");
}
@@ -209,58 +210,58 @@ if ($type eq 'source') {
#---- Package
-if ($type eq "binary"){
+if ($type eq 'binary'){
if (not defined $info->field('package')) {
- tag "no-package-name", "";
+ tag 'no-package-name';
} else {
my $name = $info->field('package');
- unfold("package", \$name);
- tag "bad-package-name", "" unless $name =~ /^[A-Z0-9][-+\.A-Z0-9]+$/i;
- tag "package-not-lowercase", "" if ($name =~ /[A-Z]/)
+ unfold('package', \$name);
+ tag 'bad-package-name' unless $name =~ /^[A-Z0-9][-+\.A-Z0-9]+$/i;
+ tag 'package-not-lowercase' if ($name =~ /[A-Z]/)
}
}
#---- Version
if (not defined $info->field('version')) {
- tag "no-version-field", "";
+ tag 'no-version-field';
} else {
$version = $info->field('version');
- unfold("version", \$version);
+ unfold('version', \$version);
if (@_ = _valid_version($version)) {
my ($epoch, $upstream, $debian) = @_;
if ($upstream !~ /^\d/i) {
- tag "upstream-version-not-numeric", "$version";
+ tag 'upstream-version-not-numeric', "$version";
}
if (defined $debian) {
- tag "debian-revision-should-not-be-zero", "$version"
+ tag 'debian-revision-should-not-be-zero', "$version"
if $debian eq '-0';
my $ubuntu;
- if($debian =~ /^-([^.]+)(?:\.[^.]+)?(?:\.[^.]+)?(\..*)?$/){
- my $extra = $2;
+ if($debian =~ /^-(?:[^.]+)(?:\.[^.]+)?(?:\.[^.]+)?(\..*)?$/){
+ my $extra = $1;
if (defined $extra) {
- $debian =~ /^-([^.]+ubuntu[^.]+)(?:\.\d+){1,3}(\..*)?$/;
+ $debian =~ /^-(?:[^.]+ubuntu[^.]+)(?:\.\d+){1,3}(\..*)?$/;
$ubuntu = 1;
- $extra = $2;
+ $extra = $1;
}
- if (not defined $1 or defined $extra) {
- tag "debian-revision-not-well-formed", "$version";
+ if (defined $extra) {
+ tag 'debian-revision-not-well-formed', "$version";
}
} else {
- tag "debian-revision-not-well-formed", "$version";
+ tag 'debian-revision-not-well-formed', "$version";
}
if ($debian =~ /^-[^.-]+\.[^.-]+\./ and not $ubuntu) {
- tag "binary-nmu-uses-old-version-style", "$version"
+ tag 'binary-nmu-uses-old-version-style', "$version"
if $type eq 'binary';
- tag "binary-nmu-debian-revision-in-source", "$version"
+ tag 'binary-nmu-debian-revision-in-source', "$version"
if $type eq 'source';
}
}
- if ($version =~ /\+b\d+$/ && $type eq "source") {
- tag "binary-nmu-debian-revision-in-source", "$version";
+ if ($version =~ /\+b\d+$/ && $type eq 'source') {
+ tag 'binary-nmu-debian-revision-in-source', "$version";
}
# Checks for the dfsg convention for repackaged upstream
@@ -280,39 +281,39 @@ if (not defined $info->field('version')) {
if ($name && $PERL_CORE_PROVIDES->known($name) &&
perl_core_has_version($name, '>=', $upstream)) {
my $core_version = $PERL_CORE_PROVIDES->value($name);
- tag "package-superseded-by-perl", "with $core_version"
+ tag 'package-superseded-by-perl', "with $core_version"
}
} else {
- tag "bad-version-number", "$version";
+ tag 'bad-version-number', "$version";
}
}
#---- Architecture
if (not defined $info->field('architecture')) {
- tag "no-architecture-field", "";
+ tag 'no-architecture-field';
} else {
my $archs = $info->field('architecture');
- unfold("architecture", \$archs);
+ unfold('architecture', \$archs);
my @archs = split / /, $archs;
- if (@archs > 1 && grep { $_ eq "any" || ($type ne "source" && $_ eq "all") } @archs) {
- tag "magic-arch-in-arch-list", "";
+ if (@archs > 1 && grep { $_ eq 'any' || ($type ne 'source' && $_ eq 'all') } @archs) {
+ tag 'magic-arch-in-arch-list';
}
for my $arch (@archs) {
- tag "unknown-architecture", "$arch"
+ tag 'unknown-architecture', "$arch"
unless $KNOWN_ARCHS->known($arch) || $ARCH_WILDCARDS{$arch};
- tag "arch-wildcard-in-binary-package", "$arch"
+ tag 'arch-wildcard-in-binary-package', "$arch"
if ($type eq 'binary' && $ARCH_WILDCARDS{$arch});
}
- if ($type eq "binary") {
- tag "too-many-architectures", "" if (@archs > 1);
- tag "aspell-package-not-arch-all", ""
- if ($pkg =~ /^aspell-[a-z]{2}(-.*)?$/ && (@archs > 1 || $archs[0] ne 'all'));
+ if ($type eq 'binary') {
+ tag 'too-many-architectures' if (@archs > 1);
+ tag 'aspell-package-not-arch-all'
+ if ($pkg =~ /^aspell-[a-z]{2}(?:-.*)?$/ && (@archs > 1 || $archs[0] ne 'all'));
}
# Used for later tests.
@@ -324,7 +325,7 @@ if (not defined $info->field('architecture')) {
if (defined $info->field('subarchitecture')) {
my $subarch = $info->field('subarchitecture');
- unfold("subarchitecture", \$subarch);
+ unfold('subarchitecture', \$subarch);
}
#---- Maintainer
@@ -332,7 +333,7 @@ if (defined $info->field('subarchitecture')) {
for my $f (qw(maintainer uploaders)) {
if (not defined $info->field($f)) {
- tag "no-maintainer-field", "" if $f eq "maintainer";
+ tag 'no-maintainer-field' if $f eq 'maintainer';
} else {
my $maintainer = $info->field($f);
@@ -340,11 +341,11 @@ for my $f (qw(maintainer uploaders)) {
# newlines for the .dsc, and the newlines don't hurt in debian/control
unfold($f, \$maintainer);
- if ($f eq "uploaders") {
+ if ($f eq 'uploaders') {
my @uploaders = split /\s*,\s*/, $maintainer;
my %duplicate_uploaders;
for my $uploader (@uploaders) {
- check_maintainer($uploader, "uploader");
+ check_maintainer($uploader, 'uploader');
if ( ((grep { $_ eq $uploader } @uploaders) > 1) and
($duplicate_uploaders{$uploader}++ == 0)) {
tag 'duplicate-uploader', $uploader;
@@ -353,7 +354,7 @@ for my $f (qw(maintainer uploaders)) {
} else {
check_maintainer($maintainer, $f);
if ($type eq 'source'
- && $maintainer =~ /\@lists(\.alioth)?\.debian\.org\b/
+ && $maintainer =~ /\@lists(?:\.alioth)?\.debian\.org\b/
&& ! defined $info->field('uploaders')) {
tag 'no-human-maintainers';
}
@@ -370,15 +371,15 @@ if (defined $info->field('uploaders') && defined $info->field('maintainer')) {
#---- Source
if (not defined $info->field('source')) {
- tag "no-source-field" if $type eq "source";
+ tag 'no-source-field' if $type eq 'source';
} else {
my $source = $info->field('source');
- unfold("source", \$source);
+ unfold('source', \$source);
if ($type eq 'source') {
if ($source ne $pkg) {
- tag "source-field-does-not-match-pkg-name", "$source != $pkg";
+ tag 'source-field-does-not-match-pkg-name', "$source != $pkg";
}
if ($source !~ /^[a-z0-9][-+\.a-z0-9]+\z/) {
tag 'source-field-malformed', $source;
@@ -387,7 +388,7 @@ if (not defined $info->field('source')) {
if ($source !~ /^[a-z0-9][-+\.a-z0-9]+ # Package name
\s*
(?:\((?:\d+:)?(?:[-\.+:a-zA-Z0-9~]+?)(?:-[\.+a-zA-Z0-9~]+)?\))?\s*$/x) { #Version
- tag "source-field-malformed", "$source";
+ tag 'source-field-malformed', "$source";
}
}
}
@@ -397,12 +398,12 @@ if (not defined $info->field('source')) {
if (defined $info->field('essential')) {
my $essential = $info->field('essential');
- unfold("essential", \$essential);
+ unfold('essential', \$essential);
- tag "essential-in-source-package", "" if ($type eq "source");
- tag "essential-no-not-needed", "" if ($essential eq "no");
- tag "unknown-essential-value", "" if ($essential ne "no" and $essential ne "yes");
- if ($essential eq "yes" and not $KNOWN_ESSENTIAL->known($pkg)) {
+ tag 'essential-in-source-package' if ($type eq 'source');
+ tag 'essential-no-not-needed' if ($essential eq 'no');
+ tag 'unknown-essential-value' if ($essential ne 'no' and $essential ne 'yes');
+ if ($essential eq 'yes' and not $KNOWN_ESSENTIAL->known($pkg)) {
tag 'new-essential-package';
}
}
@@ -414,22 +415,22 @@ if (not defined $info->field('section')) {
} else {
my $section = $info->field('section');
- unfold("section", \$section);
+ unfold('section', \$section);
if ($type eq 'udeb') {
unless ($section eq 'debian-installer') {
- tag "wrong-section-for-udeb", "$section";
+ tag 'wrong-section-for-udeb', "$section";
}
} else {
my @parts = split /\//, $section, 2;
if (scalar @parts > 1) {
- tag "unknown-section", "$section" unless $known_archive_parts{$parts[0]};
- tag "unknown-section", "$section" unless $known_sections{$parts[1]};
+ tag 'unknown-section', "$section" unless $known_archive_parts{$parts[0]};
+ tag 'unknown-section', "$section" unless $known_sections{$parts[1]};
} elsif ($parts[0] eq 'unknown') {
- tag "section-is-dh_make-template";
+ tag 'section-is-dh_make-template';
} else {
- tag "unknown-section", "$section" unless $known_sections{$parts[0]};
+ tag 'unknown-section', "$section" unless $known_sections{$parts[0]};
}
# Check package name <-> section. oldlibs is a special case; let
@@ -437,7 +438,7 @@ if (not defined $info->field('section')) {
if ($parts[-1] ne 'oldlibs') {
foreach my $map (@NAME_SECTION_MAPPINGS) {
if ($pkg =~ $map->[0]) {
- tag "wrong-section-according-to-package-name", "$pkg => $map->[1]"
+ tag 'wrong-section-according-to-package-name', "$pkg => $map->[1]"
unless $parts[-1] eq $map->[1];
last;
}
@@ -449,16 +450,16 @@ if (not defined $info->field('section')) {
#---- Priority
if (not defined $info->field('priority')) {
- tag "no-priority-field", "" if $type eq "binary";
+ tag 'no-priority-field' if $type eq 'binary';
} else {
my $priority = $info->field('priority');
- unfold("priority", \$priority);
+ unfold('priority', \$priority);
- tag "unknown-priority", "$priority" if (! $known_prios{$priority});
+ tag 'unknown-priority', "$priority" if (! $known_prios{$priority});
if ($pkg =~ /-dbg$/) {
- tag "debug-package-should-be-priority-extra", $pkg
+ tag 'debug-package-should-be-priority-extra', $pkg
unless $priority eq 'extra';
}
}
@@ -474,24 +475,24 @@ if (not defined $info->field('priority')) {
if (defined $info->field('homepage')) {
my $homepage = $info->field('homepage');
- unfold("homepage", \$homepage);
+ unfold('homepage', \$homepage);
if ($homepage =~ /^<(?:UR[LI]:)?.*>$/i) {
- tag "superfluous-clutter-in-homepage", $homepage;
+ tag 'superfluous-clutter-in-homepage', $homepage;
}
require URI;
my $uri = URI->new($homepage);
unless ($uri->scheme) { # not an absolute URI
- tag "bad-homepage", $homepage;
+ tag 'bad-homepage', $homepage;
}
if ($homepage =~ m,/search\.cpan\.org/.*-[0-9._]+/*$,) {
tag 'homepage-for-cpan-package-contains-version', $homepage;
}
-} elsif ($type eq "binary" and not $info->native) {
- tag "no-homepage-field";
+} elsif ($type eq 'binary' and not $info->native) {
+ tag 'no-homepage-field';
}
#---- Installer-Menu-Item (udeb)
@@ -501,7 +502,7 @@ if (defined $info->field('installer-menu-item')) {
unfold('installer-menu-item', \$menu_item);
- $menu_item =~ /^\d+$/ or tag "bad-menu-item", "$menu_item";
+ $menu_item =~ /^\d+$/ or tag 'bad-menu-item', "$menu_item";
}
@@ -528,8 +529,8 @@ if ($type eq 'binary') {
# they don't look like it.
$metapackage = 1 if $KNOWN_METAPACKAGES->known($pkg);
}
-if (($type eq "binary") || ($type eq 'udeb')) {
- my (%deps, %fields, %parsed);
+if (($type eq 'binary') || ($type eq 'udeb')) {
+ my (%fields, %parsed);
my $javalib = 0;
my $replaces = Lintian::Relation->new($info->field('replaces')//'');
$javalib = 1 if($pkg =~ m/^lib.*-(?:java|gcj)$/o);
@@ -545,7 +546,7 @@ if (($type eq "binary") || ($type eq 'udeb')) {
my $is_dep_field = sub { grep { $_ eq $_[0] } qw(depends pre-depends recommends suggests) };
- tag "alternates-not-allowed", "$field"
+ tag 'alternates-not-allowed', "$field"
if ($data =~ /\|/ && ! &$is_dep_field($field));
for my $dep (split /\s*,\s*/, $data) {
@@ -568,99 +569,99 @@ if (($type eq "binary") || ($type eq 'udeb')) {
}
# Only for (Pre-)?Depends.
- tag "virtual-package-depends-without-real-package-depends", "$field: $alternatives[0]->[0]"
+ tag 'virtual-package-depends-without-real-package-depends', "$field: $alternatives[0]->[0]"
if ($VIRTUAL_PACKAGES->known($alternatives[0]->[0])
- && ($field eq "depends" || $field eq "pre-depends")
+ && ($field eq 'depends' || $field eq 'pre-depends')
&& ($pkg ne 'base-files' || $alternatives[0]->[0] ne 'awk')
# ignore phpapi- dependencies as adding an
# alternative, real, package breaks its pourpose
&& $alternatives[0]->[0] !~ m/^phpapi-/);
# Check defaults for transitions. Here, we only care that the first alternative is current.
- tag "depends-on-old-emacs", "$field: $alternatives[0]->[0]"
+ tag 'depends-on-old-emacs', "$field: $alternatives[0]->[0]"
if (&$is_dep_field($field) && $known_obsolete_emacs{$alternatives[0]->[0]});
for my $part_d (@alternatives) {
my ($d_pkg, $d_version, $d_arch, $rest, $part_d_orig) = @$part_d;
- tag "versioned-provides", "$part_d_orig"
- if ($field eq "provides" && $d_version->[0]);
+ tag 'versioned-provides', "$part_d_orig"
+ if ($field eq 'provides' && $d_version->[0]);
- tag "bad-provided-package-name", $d_pkg
+ tag 'bad-provided-package-name', $d_pkg
if $d_pkg !~ /^[a-z0-9][-+\.a-z0-9]+$/;
- tag "breaks-without-version", "$part_d_orig"
- if ($field eq "breaks" && !$d_version->[0] && !$VIRTUAL_PACKAGES->known($d_pkg)
+ tag 'breaks-without-version', "$part_d_orig"
+ if ($field eq 'breaks' && !$d_version->[0] && !$VIRTUAL_PACKAGES->known($d_pkg)
&& !$replaces->implies("$part_d_orig")
);
- tag "conflicts-with-version", "$part_d_orig"
+ tag 'conflicts-with-version', "$part_d_orig"
if ($field eq 'conflicts' && $d_version->[0]);
- tag "obsolete-relation-form", "$field: $part_d_orig"
- if ($d_version && grep { $d_version->[0] eq $_ } ("<", ">"));
+ tag 'obsolete-relation-form', "$field: $part_d_orig"
+ if ($d_version && grep { $d_version->[0] eq $_ } ('<', '>'));
- tag "bad-version-in-relation", "$field: $part_d_orig"
+ tag 'bad-version-in-relation', "$field: $part_d_orig"
if ($d_version->[0] && ! defined((_valid_version($d_version->[1]))[1]));
- tag "package-relation-with-self", "$field: $part_d_orig"
+ tag 'package-relation-with-self', "$field: $part_d_orig"
if ($pkg eq $d_pkg) && ($field ne 'conflicts');
- tag "bad-relation", "$field: $part_d_orig"
+ tag 'bad-relation', "$field: $part_d_orig"
if $rest;
push @seen_obsolete_packages, $part_d_orig
if ($OBSOLETE_PACKAGES->known($d_pkg) && &$is_dep_field($field));
- tag "depends-on-metapackage", "$field: $part_d_orig"
+ tag 'depends-on-metapackage', "$field: $part_d_orig"
if ($KNOWN_METAPACKAGES->known($d_pkg) and not $metapackage and &$is_dep_field($field));
# diffutils is a special case since diff was
# renamed to diffutils, so a dependency on
# diffutils effectively is a versioned one.
- tag "depends-on-essential-package-without-using-version", "$field: $part_d_orig"
+ tag 'depends-on-essential-package-without-using-version', "$field: $part_d_orig"
if ($KNOWN_ESSENTIAL->known($d_pkg) && ! $d_version->[0]
&& &$is_dep_field($field) && $d_pkg ne 'diffutils' && $d_pkg ne 'dash');
- tag "package-depends-on-an-x-font-package", "$field: $part_d_orig"
+ tag 'package-depends-on-an-x-font-package', "$field: $part_d_orig"
if ($field =~ /^(pre-)?depends$/ && $d_pkg =~ /^xfont.*/ && $d_pkg ne 'xfonts-utils' && $d_pkg ne 'xfonts-encodings');
- tag "needlessly-depends-on-awk", "$field"
- if ($d_pkg eq "awk" && ! $d_version->[0] && &$is_dep_field($field) && $pkg ne 'base-files');
+ tag 'needlessly-depends-on-awk', "$field"
+ if ($d_pkg eq 'awk' && ! $d_version->[0] && &$is_dep_field($field) && $pkg ne 'base-files');
- tag "depends-on-libdb1-compat", "$field"
- if ($d_pkg eq "libdb1-compat" && $pkg !~ /^libc(6|6.1|0.3)/ && $field =~ /^(pre-)depends$/);
+ tag 'depends-on-libdb1-compat', "$field"
+ if ($d_pkg eq 'libdb1-compat' && $pkg !~ /^libc(?:6|6.1|0.3)/ && $field =~ /^(pre-)depends$/);
- tag "depends-on-python-minimal", "$field",
+ tag 'depends-on-python-minimal', "$field",
if ($d_pkg =~ /^python[\d.]*-minimal$/ && &$is_dep_field($field)
&& $pkg !~ /^python[\d.]*-minimal$/);
- tag "doc-package-depends-on-main-package", "$field"
+ tag 'doc-package-depends-on-main-package', "$field"
if ("$d_pkg-doc" eq $pkg && $field =~ /^(pre-)depends$/);
- tag "old-versioned-python-dependency", "$field: $part_d_orig"
+ tag 'old-versioned-python-dependency', "$field: $part_d_orig"
if ($d_pkg eq 'python' && $d_version->[0] eq '<<' && &$is_dep_field($field)
&& $arch_indep && $pkg =~ /^python-/ && ! defined $info->field('python-version')
&& ! $info->relation('depends')->implies('python-support'));
# only trigger this for the the preferred alternative
- tag "versioned-dependency-satisfied-by-perl", "$field: $part_d_orig"
+ tag 'versioned-dependency-satisfied-by-perl', "$field: $part_d_orig"
if $alternatives[0][-1] eq $part_d_orig
&& &$is_dep_field($field)
&& perl_core_has_version($d_pkg, $d_version->[0], $d_version->[1]);
- tag "depends-exclusively-on-makedev", "$field",
+ tag 'depends-exclusively-on-makedev', "$field",
if ($field eq 'depends' && $d_pkg eq 'makedev' && @alternatives == 1);
- tag "lib-recommends-documentation", "$field: $part_d_orig"
+ tag 'lib-recommends-documentation', "$field: $part_d_orig"
if ($field eq 'recommends'
- && $pkg =~ m/^lib/ && $pkg !~ m/-(dev|docs?|tools|bin)$/
+ && $pkg =~ m/^lib/ && $pkg !~ m/-(?:dev|docs?|tools|bin)$/
&& $part_d_orig =~ m/-docs?$/);
# default-jdk-doc must depend on openjdk-X-doc (or classpath-doc) to be
# useful; other packages should depend on default-jdk-doc if they
# want the Java Core API.
- tag "depends-on-specific-java-doc-package", "$field"
+ tag 'depends-on-specific-java-doc-package', "$field"
if(&$is_dep_field($field) && $pkg ne 'default-jdk-doc'
&& ($d_pkg eq 'classpath-doc' || $d_pkg =~ m/openjdk-\d+-doc/o));
@@ -679,28 +680,28 @@ if (($type eq "binary") || ($type eq 'udeb')) {
for my $pkg (@seen_obsolete_packages) {
if ($pkg eq $alternatives[0]->[0] or
scalar @seen_obsolete_packages == scalar @alternatives) {
- tag "depends-on-obsolete-package", "$field: $pkg";
+ tag 'depends-on-obsolete-package', "$field: $pkg";
} else {
- tag "ored-depends-on-obsolete-package", "$field: $pkg";
+ tag 'ored-depends-on-obsolete-package', "$field: $pkg";
}
}
# Only emit the tag if all the alternatives are JVM/JRE/JDKs
# - assume that <some-lib> | openjdk-6-jre-headless makes sense for now.
- tag "needless-dependency-on-jre"
+ tag 'needless-dependency-on-jre'
if (scalar(@alternatives) == $javadep);
}
- tag "package-depends-on-multiple-libstdc-versions", @seen_libstdcs
+ tag 'package-depends-on-multiple-libstdc-versions', @seen_libstdcs
if (scalar @seen_libstdcs > 1);
- tag "package-depends-on-multiple-tcl-versions", @seen_tcls
+ tag 'package-depends-on-multiple-tcl-versions', @seen_tcls
if (scalar @seen_tcls > 1);
- tag "package-depends-on-multiple-tclx-versions", @seen_tclxs
+ tag 'package-depends-on-multiple-tclx-versions', @seen_tclxs
if (scalar @seen_tclxs > 1);
- tag "package-depends-on-multiple-tk-versions", @seen_tks
+ tag 'package-depends-on-multiple-tk-versions', @seen_tks
if (scalar @seen_tks > 1);
- tag "package-depends-on-multiple-tkx-versions", @seen_tkxs
+ tag 'package-depends-on-multiple-tkx-versions', @seen_tkxs
if (scalar @seen_tkxs > 1);
- tag "package-depends-on-multiple-libpng-versions", @seen_libpngs
+ tag 'package-depends-on-multiple-libpng-versions', @seen_libpngs
if (scalar @seen_libpngs > 1);
}
@@ -712,7 +713,7 @@ if (($type eq "binary") || ($type eq 'udeb')) {
next unless $info->field($field);
my $relation = $info->relation($field);
for my $package (split /\s*,\s*/, $fields{$conflict}) {
- tag "conflicts-with-dependency", $field, $package
+ tag 'conflicts-with-dependency', $field, $package
if $relation->implies($package);
}
}
@@ -721,7 +722,7 @@ if (($type eq "binary") || ($type eq 'udeb')) {
#---- Package relations (source package)
-if ($type eq "source") {
+if ($type eq 'source') {
my $binpkgs = $info->binaries;
@@ -737,7 +738,7 @@ if ($type eq "source") {
}
}
- tag "build-depends-indep-without-arch-indep", ""
+ tag 'build-depends-indep-without-arch-indep'
if (defined $info->field('build-depends-indep') && $arch_indep_packages == 0);
my $is_dep_field = sub { grep { $_ eq $_[0] } qw(build-depends build-depends-indep) };
@@ -754,7 +755,7 @@ if ($type eq "source") {
my (@alternatives, @seen_obsolete_packages);
push @alternatives, [_split_dep($_), $_] for (split /\s*\|\s*/, $dep);
- tag "virtual-package-depends-without-real-package-depends", "$field: $alternatives[0]->[0]"
+ tag 'virtual-package-depends-without-real-package-depends', "$field: $alternatives[0]->[0]"
if ($VIRTUAL_PACKAGES->known($alternatives[0]->[0]) && &$is_dep_field($field));
for my $part_d (@alternatives) {
@@ -762,8 +763,8 @@ if ($type eq "source") {
my $negated = 0;
for my $arch (@{$d_arch->[0]}) {
- if ($arch eq 'all' or (!$KNOWN_ARCHS->known($arch) and !$ARCH_WILDCARDS{$arch})) {
- tag "invalid-arch-string-in-source-relation", "$arch [$field: $part_d_orig]"
+ if ($arch eq 'all' || (!$KNOWN_ARCHS->known($arch) && !$ARCH_WILDCARDS{$arch})) {
+ tag 'invalid-arch-string-in-source-relation', "$arch [$field: $part_d_orig]"
}
}
@@ -774,31 +775,31 @@ if ($type eq "source") {
tag 'conflicting-negation-in-source-relation', "$field: $part_d_orig"
unless (not $d_arch or $d_arch->[1] == 0 or $d_arch->[1] eq @{ $d_arch->[0] });
- tag "build-depends-on-build-essential", $field
- if ($d_pkg eq "build-essential");
+ tag 'build-depends-on-build-essential', $field
+ if ($d_pkg eq 'build-essential');
- tag "depends-on-build-essential-package-without-using-version", "$d_pkg [$field: $part_d_orig]"
+ tag 'depends-on-build-essential-package-without-using-version', "$d_pkg [$field: $part_d_orig]"
if ($known_build_essential{$d_pkg} && ! $d_version->[1]);
- tag "build-depends-on-essential-package-without-using-version", "$field: $part_d_orig"
+ tag 'build-depends-on-essential-package-without-using-version', "$field: $part_d_orig"
if ($KNOWN_ESSENTIAL->known($d_pkg) && ! $d_version->[0] && $d_pkg ne 'dash');
push @seen_obsolete_packages, $part_d_orig
if ($OBSOLETE_PACKAGES->known($d_pkg) && &$is_dep_field($field));
- tag "build-depends-on-metapackage", "$field: $part_d_orig"
+ tag 'build-depends-on-metapackage', "$field: $part_d_orig"
if ($KNOWN_METAPACKAGES->known($d_pkg) and &$is_dep_field($field));
tag 'build-depends-on-non-build-package', "$field: $part_d_orig"
if ($NO_BUILD_DEPENDS->known($d_pkg) and &$is_dep_field($field));
- tag "build-depends-on-1-revision", "$field: $part_d_orig"
+ tag 'build-depends-on-1-revision', "$field: $part_d_orig"
if ($d_version->[0] eq '>=' && $d_version->[1] =~ /-1$/ && &$is_dep_field($field));
- tag "bad-relation", "$field: $part_d_orig"
+ 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"
+ tag 'versioned-dependency-satisfied-by-perl', "$field: $part_d_orig"
if $alternatives[0][-1] eq $part_d_orig
&& &$is_dep_field($field)
&& perl_core_has_version($d_pkg, $d_version->[0], $d_version->[1]);
@@ -807,9 +808,9 @@ if ($type eq "source") {
for my $pkg (@seen_obsolete_packages) {
if ($pkg eq $alternatives[0]->[0] or
scalar @seen_obsolete_packages == scalar @alternatives) {
- tag "build-depends-on-obsolete-package", "$field: $pkg";
+ tag 'build-depends-on-obsolete-package', "$field: $pkg";
} else {
- tag "ored-build-depends-on-obsolete-package", "$field: $pkg";
+ tag 'ored-build-depends-on-obsolete-package', "$field: $pkg";
}
}
}
@@ -820,7 +821,7 @@ if ($type eq "source") {
my $build_all = $info->relation('build-depends-all');
my @dups = $build_all->duplicates;
for my $dup (@dups) {
- tag "package-has-a-duplicate-build-relation", join (', ', @$dup);
+ tag 'package-has-a-duplicate-build-relation', join (', ', @$dup);
}
# Make sure build dependencies and conflicts are consistent.
@@ -829,7 +830,7 @@ if ($type eq "source") {
next unless $_;
for my $conflict (split /\s*,\s*/, $_) {
if ($build_all->implies($conflict)) {
- tag "build-conflicts-with-build-dependency", $conflict;
+ tag 'build-conflicts-with-build-dependency', $conflict;
}
}
}
@@ -847,7 +848,7 @@ if ($type eq "source") {
$deps = $info->binary_field($_, 'pre-depends') . ', ';
$deps .= $info->binary_field($_, 'depends');
tag 'dbg-package-missing-depends', $_
- unless (grep {my $quoted_name = qr<\Q$_>; $deps =~ m/(\s|,|^)$quoted_name(\s|,|\z)/} @arch_dep_pkgs);
+ unless (grep {my $quoted_name = qr<\Q$_>; $deps =~ m/(?:\s|,|^)$quoted_name(?:\s|,|\z)/} @arch_dep_pkgs);
}
# Check for a python*-dev build dependency in source packages that
@@ -864,7 +865,7 @@ if (defined $info->field('origin')) {
unfold('origin', \$origin);
- tag "redundant-origin-field", "" if lc($origin) eq 'debian';
+ tag 'redundant-origin-field' if lc($origin) eq 'debian';
}
#----- Bugs
@@ -874,7 +875,7 @@ if (defined $info->field('bugs')) {
unfold('bugs', \$bugs);
- tag "redundant-bugs-field"
+ tag 'redundant-bugs-field'
if $bugs =~ m,^debbugs://bugs.debian.org/?$,i;
}
@@ -896,7 +897,7 @@ if (defined $info->field('python-version')) {
my @pyversion = split(/\s*,\s*/, $pyversion);
if (@pyversion > 2) {
if (grep { !/^\d+\.\d+$/ } @pyversion) {
- tag "malformed-python-version", "$pyversion";
+ tag 'malformed-python-version', "$pyversion";
}
} else {
my $okay = 0;
@@ -908,7 +909,7 @@ if (defined $info->field('python-version')) {
last;
}
}
- tag "malformed-python-version", "$pyversion" unless $okay;
+ tag 'malformed-python-version', "$pyversion" unless $okay;
}
}
@@ -920,7 +921,7 @@ if (defined $info->field('dm-upload-allowed')) {
unfold('dm-upload-allowed', \$dmupload);
unless ($dmupload eq 'yes') {
- tag "malformed-dm-upload-allowed", "$dmupload";
+ tag 'malformed-dm-upload-allowed', "$dmupload";
}
}
@@ -931,9 +932,9 @@ while (my ($vcs, $regex) = each %VCS_RECOMMENDED_URIS) {
my $uri = $info->field("vcs-$vcs");
if ($uri !~ $regex) {
if ($VCS_VALID_URIS{$vcs} and $uri =~ $VCS_VALID_URIS{$vcs}) {
- tag "vcs-field-uses-not-recommended-uri-format", "vcs-$vcs", $uri;
+ tag 'vcs-field-uses-not-recommended-uri-format', "vcs-$vcs", $uri;
} else {
- tag "vcs-field-uses-unknown-uri-format", "vcs-$vcs", $uri;
+ tag 'vcs-field-uses-unknown-uri-format', "vcs-$vcs", $uri;
}
}
}
@@ -954,17 +955,17 @@ for my $field (readdir FIELDS) {
next if ($field eq 'original-maintainer') and $version =~ /ubuntu/;
- tag "obsolete-field", "$field"
+ tag 'obsolete-field', "$field"
if $known_obsolete_fields{$field};
- tag "unknown-field-in-dsc", "$field"
- if ($type eq "source" && ! $SOURCE_FIELDS->known($field) && ! $known_obsolete_fields{$field});
+ tag 'unknown-field-in-dsc', "$field"
+ if ($type eq 'source' && ! $SOURCE_FIELDS->known($field) && ! $known_obsolete_fields{$field});
- tag "unknown-field-in-control", "$field"
- if ($type eq "binary" && ! $known_binary_fields{$field} && ! $known_obsolete_fields{$field});
+ tag 'unknown-field-in-control', "$field"
+ if ($type eq 'binary' && ! $known_binary_fields{$field} && ! $known_obsolete_fields{$field});
- tag "unknown-field-in-control", "$field"
- if ($type eq "udeb" && ! $known_udeb_fields{$field} && ! $known_obsolete_fields{$field});
+ tag 'unknown-field-in-control', "$field"
+ if ($type eq 'udeb' && ! $known_udeb_fields{$field} && ! $known_obsolete_fields{$field});
}
closedir(FIELDS);
@@ -977,7 +978,7 @@ closedir(FIELDS);
# rest (should always be "" for valid dependencies)
sub _split_dep {
my $dep = shift;
- my ($pkg, $version, $darch) = ("", ["",""], [[], 0]);
+ my ($pkg, $version, $darch) = ('', ['',''], [[], 0]);
$pkg = $1 if $dep =~ s/^\s*([^\s\[\(]+)\s*//;
@@ -1027,7 +1028,7 @@ sub unfold {
$$line =~ s/\n$//;
if ($$line =~ s/\n//g) {
- tag "multiline-field", "$field";
+ tag 'multiline-field', "$field";
}
}
--
Debian package checker
Reply to: