[SCM] Debian package checker branch, master, updated. 2.4.3-192-g4a69bbb
The following commit has been merged in the master branch:
commit 8094f9987bb50ef507ea9cd31bf1dcc615632393
Author: Raphael Geissert <atomo64@gmail.com>
Date: Thu Jan 27 13:28:28 2011 -0600
Fix lots of Perl::Critic-found issues
diff --git a/checks/binaries b/checks/binaries
index a99b0ee..f9b7b92 100644
--- a/checks/binaries
+++ b/checks/binaries
@@ -63,7 +63,7 @@ our %ARCH_REGEX = (
'sparc' => qr'ELF 32-bit MSB .* SPARC',
'sparc64' => qr'ELF 64-bit MSB .* SPARC');
-our %arch_64bit_equivs = (
+our %ARCH_64BIT_EQUIVS = (
'hppa' => 'hppa64',
'i386' => 'amd64',
'kfreebsd-i386' => 'kfreebsd-amd64',
@@ -110,7 +110,7 @@ our %EMBEDDED_LIBRARIES = (
'openjpeg' => qr'tcd_decode: incomplete bistream',
);
-our $multiarch;
+our $MULTIARCH;
sub run {
@@ -235,9 +235,9 @@ foreach my $file (@{$info->sorted_file_info}) {
# package may be a support package for cross-compiles.
if ($arch eq 'all') {
my ($arch_path) = ($file =~ m,^(?:usr/)?lib/([^/]+)/,);
- $multiarch = Lintian::Data->new('binaries/multiarch')
- unless defined($multiarch);
- unless ($arch_path and $multiarch->known($arch_path)) {
+ $MULTIARCH = Lintian::Data->new('binaries/multiarch')
+ unless defined($MULTIARCH);
+ unless ($arch_path and $MULTIARCH->known($arch_path)) {
tag 'arch-independent-package-contains-binary-or-object', $file;
}
}
@@ -259,15 +259,15 @@ foreach my $file (@{$info->sorted_file_info}) {
unless ($fileinfo =~ m/$ARCH_REGEX{$1}/);
} elsif ($arch eq 'amd64' and $fileinfo =~ m/$ARCH_REGEX{i386}/) {
# Ignore i386 binaries in amd64 packages for right now.
- } elsif (exists $arch_64bit_equivs{$arch}
- and $fileinfo =~ m/$ARCH_REGEX{$arch_64bit_equivs{$arch}}/
+ } elsif (exists $ARCH_64BIT_EQUIVS{$arch}
+ and $fileinfo =~ m/$ARCH_REGEX{$ARCH_64BIT_EQUIVS{$arch}}/
and $file =~ m,^lib/modules/,) {
# Allow amd64 kernel modules to be installed on i386.
} else {
- $multiarch = Lintian::Data->new('binaries/multiarch')
- unless defined($multiarch);
+ $MULTIARCH = Lintian::Data->new('binaries/multiarch')
+ unless defined($MULTIARCH);
tag 'binary-from-other-architecture', $file
- unless (grep { $file =~ m,/\Q$_\E/, } $multiarch->all);
+ unless (grep { $file =~ m,/\Q$_\E/, } $MULTIARCH->all);
}
}
diff --git a/checks/changelog-file b/checks/changelog-file
index e97aded..d55fb30 100644
--- a/checks/changelog-file
+++ b/checks/changelog-file
@@ -259,14 +259,14 @@ if ($line) {
tag 'debian-changelog-file-uses-obsolete-national-encoding', "at line $line"
}
-my $changes = $info->changelog;
-if (my @errors = $changes->get_parse_errors) {
+my $changelog = $info->changelog;
+if (my @errors = $changelog->get_parse_errors) {
foreach (@errors) {
tag 'syntax-error-in-debian-changelog', "line $_->[1]", "\"$_->[2]\"";
}
}
-my @entries = $changes->data;
+my @entries = $changelog->data;
if (@entries) {
my %versions;
for my $entry (@entries) {
@@ -339,21 +339,22 @@ if (@entries) {
#
# NMUs get a free pass because they need to work with the version number
# that was already there.
- my $version;
+ my $changelog_version;
if ($info->native) {
- $version = $entry->Version || '';
+ $changelog_version = $entry->Version || '';
} else {
if( $entry->Version ){
- ($version) = (split('-', $entry->Version))[-1];
+ ($changelog_version) = (split('-', $entry->Version))[-1];
}else{
- $version = '';
+ $changelog_version = '';
}
}
- unless (not $info->native and $version =~ /\./) {
- if ($info->native and $version =~ /testing|(?:un)?stable/i) {
+ unless (not $info->native and $changelog_version =~ /\./) {
+ if ($info->native and $changelog_version =~ /testing|(?:un)?stable/i) {
tag 'version-refers-to-distribution', $entry->Version;
- } elsif ($version =~ /woody|sarge|etch|lenny|squeeze/) {
- if ($entry->Distribution =~ /^(?:unstable|experimental)$/) {
+ } elsif ($changelog_version =~ /woody|sarge|etch|lenny|squeeze/) {
+ my %unreleased_dists = map { $_ => 1 } qw(unstable experimental);
+ if (exists ($unreleased_dists{$entry->Distribution})) {
tag 'version-refers-to-distribution', $entry->Version;
}
}
diff --git a/checks/changes-file b/checks/changes-file
index 9788d49..f51f13e 100644
--- a/checks/changes-file
+++ b/checks/changes-file
@@ -26,7 +26,7 @@ use Util;
use Lintian::Tags qw(tag);
use Lintian::Check qw(check_maintainer);
-my $check_checksums = $main::check_checksums;
+our $CHECK_CHECKSUMS = $main::check_checksums;
sub run {
@@ -88,6 +88,7 @@ if (defined $info->field('distribution')) {
} else {
my $urgency = lc $info->field('urgency');
$urgency =~ s/ .*//o;
+ my %urgencies = map { $_ => 1 } qw(low medium high critical emergency);
unless ($urgency =~ /^(?:low|medium|high|critical|emergency)$/io) {
tag 'bad-urgency-in-changes-file', $info->field('urgency');
}
@@ -132,7 +133,7 @@ if (defined $info->field('distribution')) {
}
# check checksums
- if ($check_checksums or $file =~ m/\.dsc$/o) {
+ if ($CHECK_CHECKSUMS or $file =~ m/\.dsc$/o) {
foreach my $alg (qw(md5 sha1 sha256)) {
next unless exists $file_info->{checksums}{$alg};
diff --git a/checks/common_data.pm b/checks/common_data.pm
index 7bd90a4..5096147 100644
--- a/checks/common_data.pm
+++ b/checks/common_data.pm
@@ -18,7 +18,7 @@ use vars qw
# simple defines for commonly needed data
-$known_shells_regex = qr'(?:(?:b|d)?a|t?c|(?:pd|m)?k|z)?sh';
+$known_shells_regex = qr'(?:[bd]?a|t?c|(?:pd|m)?k|z)?sh';
1;
diff --git a/checks/conffiles b/checks/conffiles
index a978d9e..b9385f6 100644
--- a/checks/conffiles
+++ b/checks/conffiles
@@ -20,6 +20,8 @@
package Lintian::conffiles;
use strict;
+use warnings;
+
use Util;
use Lintian::Tags qw(tag);
diff --git a/checks/copyright-file b/checks/copyright-file
index f02f714..300901b 100644
--- a/checks/copyright-file
+++ b/checks/copyright-file
@@ -209,19 +209,19 @@ if (m/(?:Free\s*Software\s*Foundation.*02139|02111-1307)/s) {
# Whether the package is covered by the GPL, used later for the libssl check.
my $gpl;
-if (length($_) > 12000
+if (length($_) > 12_000
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';
$gpl = 1;
}
-if (length($_) > 12000
+if (length($_) > 12_000
and m/\bGNU Free Documentation License\s*Version 1\.2/ and m/\b1\. APPLICABILITY AND DEFINITIONS/) {
tag 'copyright-file-contains-full-gfdl-license';
}
-if (length($_) > 10000
+if (length($_) > 10_000
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';
diff --git a/checks/cruft b/checks/cruft
index a74301d..5f8e2f5 100644
--- a/checks/cruft
+++ b/checks/cruft
@@ -84,7 +84,7 @@ my @file_checks =
# List of files to check for a LF-only end of line terminator, relative
# to the debian/ source directory
-our @EOL_terminators_files = qw(control changelog);
+our @EOL_TERMINATORS_FILES = qw(control changelog);
sub run {
@@ -111,7 +111,6 @@ if ($info->native) {
# Check if this is a documentation package that's not arch: all. This doesn't
# really belong here either.
-my $arch;
if (defined $info->field('architecture')) {
my $arch = $info->field('architecture');
if ($pkg =~ /-docs?$/ && $arch ne 'all') {
@@ -149,7 +148,7 @@ for my $file (keys(%$file_info)) {
}
}
-for my $file (@EOL_terminators_files) {
+for my $file (@EOL_TERMINATORS_FILES) {
$file = "debian/$file";
next unless defined $file_info->{$file};
@@ -356,7 +355,7 @@ sub find_cruft {
my ($version, $major, $minor, $debian) = ($1, $2, $3, $4);
if ($major < 5 or ($major == 5 and $minor < 2)) {
tag 'ancient-libtool', $name, $version;
- } elsif ($minor == 2 and (!$debian or $debian < 2)) {
+ } elsif ($minor == 2 and (!$debian || $debian < 2)) {
tag 'ancient-libtool', $name, $version;
} elsif ($minor < 24) {
# not entirely sure whether that would be good idea
diff --git a/checks/debconf b/checks/debconf
index 34cd87b..8c4b6a0 100644
--- a/checks/debconf
+++ b/checks/debconf
@@ -253,7 +253,7 @@ foreach my $template (@templates) {
}
if (not exists $template->{description}) {
- tag "no-template-description", "$template->{template}";
+ tag 'no-template-description', "$template->{template}";
} elsif ($template->{description}=~m/^\s*(.*?)\s*?\n\s*\1\s*$/) {
# Check for duplication. Should all this be folded into the
# description checks?
@@ -294,7 +294,6 @@ foreach my $template (@templates) {
my $ttype = $template->{type} || '';
unless ($short =~ /for internal use/i) {
my $isprompt = grep { $_ eq $ttype } qw(string password);
- 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};
diff --git a/checks/description b/checks/description
index 8e17890..8d84ef2 100644
--- a/checks/description
+++ b/checks/description
@@ -44,7 +44,7 @@ my $description;
# description?
my $full_description = $info->field('description');
unless (defined $full_description) {
- tag "package-has-no-description", "";
+ tag 'package-has-no-description', '';
return 0;
}
@@ -58,24 +58,24 @@ unless (defined $synopsis) {
$description = '' unless defined($description);
if ($synopsis =~ m/^\s*$/) {
- tag "description-synopsis-is-empty", "";
+ tag 'description-synopsis-is-empty', '';
} else {
if ($synopsis =~ m/^\Q$pkg\E\b/i) {
- tag "description-starts-with-package-name", "";
+ tag 'description-starts-with-package-name', '';
}
if ($synopsis =~ m/^(an?|the)\s/i) {
- tag "description-synopsis-starts-with-article", "";
+ tag 'description-synopsis-starts-with-article', '';
}
if ($synopsis =~ m/(?<!etc)\.\s*$/i) {
- tag "description-synopsis-might-not-be-phrased-properly", "";
+ tag 'description-synopsis-might-not-be-phrased-properly', '';
}
if ($synopsis =~ m/\t/) {
- tag "description-contains-tabs", "" unless $tabs++;
+ tag 'description-contains-tabs', '' unless $tabs++;
}
if ($synopsis =~ m/^missing\s*$/i) {
- tag "description-is-debmake-template", "" unless $template++;
+ tag 'description-is-debmake-template', '' unless $template++;
} elsif ($synopsis =~ m/<insert up to 60 chars description>/) {
- tag "description-is-dh_make-template", "" unless $template++;
+ tag "description-is-dh_make-template", '' unless $template++;
}
# We have to decode into UTF-8 to get the right length for the length
@@ -87,7 +87,6 @@ if ($synopsis =~ m/^\s*$/) {
}
my $flagged_homepage;
-my $is_dummy;
foreach (split /\n/, $description) {
next if m/^ \.\s*$/o;
@@ -95,12 +94,12 @@ foreach (split /\n/, $description) {
my $firstline = lc $_;
my $lsyn = lc $synopsis;
if ($firstline =~ /^\Q$lsyn\E$/) {
- tag "description-synopsis-is-duplicated", "";
+ tag 'description-synopsis-is-duplicated', '';
} else {
$firstline =~ s/[^a-zA-Z0-9]+//g;
$lsyn =~ s/[^a-zA-Z0-9]+//g;
if ($firstline eq $lsyn) {
- tag "description-synopsis-is-duplicated", "";
+ tag 'description-synopsis-is-duplicated', '';
}
}
}
@@ -108,24 +107,24 @@ foreach (split /\n/, $description) {
$lines++;
if (m/^ \.\s*\S/o) {
- tag "description-contains-invalid-control-statement", "";
+ tag 'description-contains-invalid-control-statement', '';
} elsif (m/^ [\-\*]/o) {
# Print it only the second time. Just one is not enough to be sure that
# it's a list, and after the second there's no need to repeat it.
- tag "possible-unindented-list-in-extended-description", "" if $unindented_list++ == 2;
+ tag 'possible-unindented-list-in-extended-description', '' if $unindented_list++ == 2;
}
if (m/\t/o) {
- tag "description-contains-tabs", "" unless $tabs++;
+ tag 'description-contains-tabs', '' unless $tabs++;
}
if (m,^\s*Homepage: <?https?://,i) {
- tag "description-contains-homepage";
+ tag 'description-contains-homepage';
$flagged_homepage = 1;
}
if (m,This description was automagically extracted from the module by dh-make-perl,i) {
- tag "description-contains-dh-make-perl-template";
+ tag 'description-contains-dh-make-perl-template';
}
# Check for duplicated words. We want to catch "this this." but not
@@ -135,12 +134,12 @@ foreach (split /\n/, $description) {
# We don't want to think ", ," or "a, a" is a duplicated word, so require
# that a word start and end with a word character.
my $stripped = $_;
- $stripped =~ s,(\"|\')(.*?)(\1),,g;
+ $stripped =~ s,[\"\'](.*?)(\1),,g;
while ($stripped =~
m%(?:\s|^)((\w(?:\S*\w)?)(\s+(\2))+)(?:[\).,?!:;\s]|\z)%i) {
my $words = $1;
$stripped =~ s/\Q$words//;
- tag "description-contains-duplicated-word", $words;
+ tag 'description-contains-duplicated-word', $words;
}
my $first_person = $_;
@@ -148,31 +147,31 @@ foreach (split /\n/, $description) {
m/(?:^|\s)(I|[Mm]y|[Oo]urs?|mine|myself|me|us|[Ww]e)(?:$|\s)/) {
my $word = $1;
$first_person =~ s/\Q$word//;
- tag "using-first-person-in-description", "line $lines: $word";
+ tag 'using-first-person-in-description', "line $lines: $word";
}
if ($lines == 1) {
# checks for the first line of the extended description:
if (m/^ \s/o) {
- tag "description-starts-with-leading-spaces", "";
+ tag 'description-starts-with-leading-spaces', '';
}
if (m/^\s*missing\s*$/oi) {
- tag "description-is-debmake-template", "" unless $template++;
+ tag 'description-is-debmake-template', '' unless $template++;
} elsif (m/<insert long description, indented with spaces>/) {
- tag "description-is-dh_make-template", "" unless $template++;
+ tag "description-is-dh_make-template", '' unless $template++;
}
}
if (length(decode('utf-8', $_)) > 80) {
- tag "extended-description-line-too-long", "";
+ tag 'extended-description-line-too-long', '';
}
}
if ($type ne 'udeb') {
if ($lines == 0) {
- tag "extended-description-is-empty";
+ tag 'extended-description-is-empty';
} elsif ($lines <= 2 and not $synopsis =~ /(dummy|transition)/i) {
- tag "extended-description-is-probably-too-short";
+ tag 'extended-description-is-probably-too-short';
}
}
diff --git a/checks/etcfiles b/checks/etcfiles
index 512ef7a..6339d51 100644
--- a/checks/etcfiles
+++ b/checks/etcfiles
@@ -20,6 +20,8 @@
package Lintian::etcfiles;
use strict;
+use warnings;
+
use Util;
use Lintian::Tags qw(tag);
@@ -31,7 +33,7 @@ my $info = shift;
my %conffiles;
-my $conffiles = "control/conffiles";
+my $conffiles = 'control/conffiles';
# load conffiles
if (open(IN, '<', $conffiles)) {
@@ -55,7 +57,7 @@ foreach my $file (@{$info->sorted_index}) {
and $file ne 'etc/init.d/skeleton'
and $file ne 'etc/init.d/rc'
and $file ne 'etc/init.d/rcS') {
- tag "file-in-etc-not-marked-as-conffile", $file;
+ tag 'file-in-etc-not-marked-as-conffile', $file;
}
}
diff --git a/checks/fields b/checks/fields
index fd121be..b94b6c1 100644
--- a/checks/fields
+++ b/checks/fields
@@ -56,10 +56,10 @@ our %ARCH_WILDCARDS = map {
$ARCH_WILDCARDS{'linux-any'} = 1;
$ARCH_WILDCARDS{any} = 1;
-our %known_archive_parts = map { $_ => 1 }
+our %KNOWN_ARCHIVE_PARTS = map { $_ => 1 }
('non-free', 'contrib');
-our %known_sections = map { $_ => 1 }
+our %KNOWN_SECTIONS = map { $_ => 1 }
('admin', 'comm', 'cli-mono', 'database', 'debug', 'devel', 'doc',
'editors', 'electronics', 'embedded', 'fonts', 'games', 'gnome', 'gnu-r',
'gnustep', 'graphics', 'hamradio', 'haskell', 'httpd', 'interpreters',
@@ -69,11 +69,11 @@ our %known_sections = map { $_ => 1 }
'utils', 'vcs', 'video', 'web', 'x11', 'xfce', 'zope'
);
-our %known_prios = map { $_ => 1 }
+our %KNOWN_PRIOS = map { $_ => 1 }
('required', 'important', 'standard', 'optional', 'extra');
# The Ubuntu original-maintainer field is handled separately.
-our %known_binary_fields = map { $_ => 1 }
+our %KNOWN_BINARY_FIELDS = map { $_ => 1 }
('package', 'version', 'architecture', 'depends', 'pre-depends',
'recommends', 'suggests', 'enhances', 'conflicts', 'provides',
'replaces', 'breaks', 'essential', 'maintainer', 'section', 'priority',
@@ -81,7 +81,7 @@ our %known_binary_fields = map { $_ => 1 }
'bugs', 'origin');
# The Ubuntu original-maintainer field is handled separately.
-our %known_udeb_fields = map { $_ => 1 }
+our %KNOWN_UDEB_FIELDS = map { $_ => 1 }
('package', 'version', 'architecture', 'subarchitecture', 'depends',
'recommends', 'enhances', 'provides', 'replaces', 'breaks', 'replaces',
'maintainer', 'section', 'priority', 'source', 'description',
@@ -425,12 +425,12 @@ if (not defined $info->field('section')) {
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';
} 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
@@ -456,7 +456,7 @@ if (not defined $info->field('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
@@ -962,10 +962,10 @@ for my $field (readdir FIELDS) {
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});
+ 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});
+ if ($type eq 'udeb' && ! $KNOWN_UDEB_FIELDS{$field} && ! $known_obsolete_fields{$field});
}
closedir(FIELDS);
diff --git a/checks/files b/checks/files
index a11b565..dd49c3f 100644
--- a/checks/files
+++ b/checks/files
@@ -255,10 +255,10 @@ foreach my $file (@{$info->sorted_index}) {
tag 'package-contains-ancient-file', "$file " . $index_info->{date};
}
- if (!($index_info->{uid} < 100 || $index_info->{uid} == 65534
- || ($index_info->{uid} >= 60000 && $index_info->{uid} < 65000))
- || !($index_info->{gid} < 100 || $index_info->{gid} == 65534
- || ($index_info->{gid} >= 60000 && $index_info->{gid} < 65000))) {
+ if (!($index_info->{uid} < 100 || $index_info->{uid} == 65_534
+ || ($index_info->{uid} >= 60000 && $index_info->{uid} < 65_000))
+ || !($index_info->{gid} < 100 || $index_info->{gid} == 65_534
+ || ($index_info->{gid} >= 60_000 && $index_info->{gid} < 65_000))) {
tag 'wrong-file-owner-uid-or-gid', $file, $index_info->{uid} . '/' . $index_info->{gid};
}
diff --git a/checks/huge-usr-share b/checks/huge-usr-share
index be67f20..0fa3d9e 100644
--- a/checks/huge-usr-share
+++ b/checks/huge-usr-share
@@ -20,6 +20,8 @@
package Lintian::huge_usr_share;
use strict;
+use warnings;
+
use Lintian::Tags qw(tag);
# Threshold in kB of /usr/share to trigger this warning. Consider that the
@@ -53,7 +55,7 @@ $size_usrshare = int ($size_usrshare / 1024);
if ($size_usrshare > $THRESHOLD_SIZE_SOFT) {
my $perc = int (100 * $size_usrshare / $size);
if ($size_usrshare > $THRESHOLD_SIZE_HARD || $perc > $THRESHOLD_PERC) {
- tag "arch-dep-package-has-big-usr-share", "${size_usrshare}kB $perc%";
+ tag 'arch-dep-package-has-big-usr-share', "${size_usrshare}kB $perc%";
}
}
diff --git a/checks/infofiles b/checks/infofiles
index 3691019..bf2ecb9 100644
--- a/checks/infofiles
+++ b/checks/infofiles
@@ -21,6 +21,7 @@
package Lintian::infofiles;
use strict;
+use warnings;
use lib "$ENV{'LINTIAN_ROOT'}/checks/";
use common_data;
@@ -36,7 +37,6 @@ my $pkg = shift;
my $type = shift;
my $info = shift;
-my %missing_section;
my $has_info_file;
# Read package contents...
@@ -61,13 +61,13 @@ foreach my $file (@{$info->sorted_index}) {
# accept those and ignore them. Just ignore .png files for now.
my @fname_pieces = split /\./, $fname;
my $ext = pop @fname_pieces;
- if ($ext eq "gz") { # ok!
+ if ($ext eq 'gz') { # ok!
if ($index_info->{type} =~ m,^[-h],o) { # compressed with maximum compression rate?
if ($file_info !~ m/gzip compressed data/o) {
- tag "info-document-not-compressed-with-gzip", $file;
+ tag 'info-document-not-compressed-with-gzip', $file;
} else {
if ($file_info !~ m/max compression/o) {
- tag "info-document-not-compressed-with-max-compression", $file;
+ tag 'info-document-not-compressed-with-max-compression', $file;
}
}
}
@@ -75,12 +75,12 @@ foreach my $file (@{$info->sorted_index}) {
next;
} else {
push (@fname_pieces, $ext);
- tag "info-document-not-compressed", $file;
+ tag 'info-document-not-compressed', $file;
}
my $infoext = pop @fname_pieces;
unless ($infoext && $infoext =~ /^info(-\d+)?$/) { # it's not foo.info
unless (!@fname_pieces) { # it's not foo{,-{1,2,3,...}}
- tag "info-document-has-wrong-extension", $file;
+ tag 'info-document-has-wrong-extension', $file;
}
}
diff --git a/checks/init.d b/checks/init.d
index 47082f6..5c714a7 100644
--- a/checks/init.d
+++ b/checks/init.d
@@ -86,11 +86,11 @@ if (open(IN, '<', $postinst)) {
my ($name,$opt) = ($1,$2);
next if $opt eq 'remove';
if ($initd_postinst{$name}++ == 1) {
- tag "duplicate-updaterc.d-calls-in-postinst", $name;
+ tag 'duplicate-updaterc.d-calls-in-postinst', $name;
next;
}
unless (m,>\s*/dev/null,o) {
- tag "output-of-updaterc.d-not-redirected-to-dev-null", "$name postinst";
+ tag 'output-of-updaterc.d-not-redirected-to-dev-null', "$name postinst";
}
}
}
@@ -104,7 +104,7 @@ if (open(IN, '<', $preinst)) {
next unless m/update-rc\.d\s+(?:$opts_r)*($name_r)\s+($action_r)/o;
my ($name,$opt) = ($1,$2);
next if $opt eq 'remove';
- tag "preinst-calls-updaterc.d", $name;
+ tag 'preinst-calls-updaterc.d', $name;
}
close(IN);
}
@@ -116,11 +116,11 @@ if (open(IN, '<', $postrm)) {
s/\#.*$//o;
next unless m/update-rc\.d\s+($opts_r)*($name_r)/o;
if ($initd_postrm{$2}++ == 1) {
- tag "duplicate-updaterc.d-calls-in-postrm", $2;
+ tag 'duplicate-updaterc.d-calls-in-postrm', $2;
next;
}
unless (m,>\s*/dev/null,o) {
- tag "output-of-updaterc.d-not-redirected-to-dev-null", "$2 postrm";
+ tag 'output-of-updaterc.d-not-redirected-to-dev-null', "$2 postrm";
}
}
close(IN);
@@ -132,7 +132,7 @@ if (open(IN, '<', $prerm)) {
next if /$exclude_r/o;
s/\#.*$//o;
next unless m/update-rc\.d\s+($opts_r)*($name_r)/o;
- tag "prerm-calls-updaterc.d", $2;
+ tag 'prerm-calls-updaterc.d', $2;
}
close(IN);
}
@@ -142,11 +142,11 @@ for (keys %initd_postinst) {
if ($initd_postrm{$_}) {
delete $initd_postrm{$_};
} else {
- tag "postrm-does-not-call-updaterc.d-for-init.d-script", "etc/init.d/$_";
+ tag 'postrm-does-not-call-updaterc.d-for-init.d-script', "etc/init.d/$_";
}
}
for (keys %initd_postrm) {
- tag "postrm-contains-additional-updaterc.d-calls", "etc/init.d/$_";
+ tag 'postrm-contains-additional-updaterc.d-calls', "etc/init.d/$_";
}
# load conffiles
@@ -157,7 +157,7 @@ if (open(IN, '<', $conffiles)) {
$conffiles{$_} = 1;
if (m,^/?etc/rc.\.d,o) {
- tag "file-in-etc-rc.d-marked-as-conffile", $_;
+ tag 'file-in-etc-rc.d-marked-as-conffile', $_;
}
}
close(IN);
@@ -170,7 +170,7 @@ for (keys %initd_postinst) {
# init.d scripts have to be marked as conffiles unless they're symlinks.
unless ($conffiles{"/etc/init.d/$_"} or $conffiles{"etc/init.d/$_"}
or -l $initd_file) {
- tag "init.d-script-not-marked-as-conffile", "etc/init.d/$_";
+ tag 'init.d-script-not-marked-as-conffile', "etc/init.d/$_";
}
# Check if file exists in package and check the script for other issues if
@@ -178,12 +178,12 @@ for (keys %initd_postinst) {
if (-f $initd_file) {
check_init($initd_file);
} elsif (not -l $initd_file) {
- tag "init.d-script-not-included-in-package", "etc/init.d/$_";
+ tag 'init.d-script-not-included-in-package', "etc/init.d/$_";
}
}
# files actually installed in /etc/init.d should match our list :-)
-opendir(INITD, "init.d") or fail("cannot read init.d directory: $!");
+opendir(INITD, 'init.d') or fail("cannot read init.d directory: $!");
for (readdir(INITD)) {
my $script = $_;
next if grep {$script eq $_} qw(. .. README skeleton rc rcS);
@@ -220,11 +220,11 @@ sub check_init {
my %needs_fs = ('remote' => 0, 'local' => 0);
while (defined(my $l = <IN>)) {
if ($. == 1 && $l =~ m,^\#!\s*(/usr/[^\s]+),) {
- tag "init.d-script-uses-usr-interpreter", "etc/init.d/$_ $1";
+ tag 'init.d-script-uses-usr-interpreter', "etc/init.d/$_ $1";
}
if ($l =~ m/^\#\#\# BEGIN INIT INFO/) {
if ($lsb{BEGIN}) {
- tag "init.d-script-has-duplicate-lsb-section", "etc/init.d/$_";
+ tag 'init.d-script-has-duplicate-lsb-section', "etc/init.d/$_";
next;
}
$lsb{BEGIN} = 1;
@@ -237,14 +237,14 @@ sub check_init {
$lsb{END} = 1;
last;
} elsif ($l !~ /^\#/) {
- tag "init.d-script-has-unterminated-lsb-section", "etc/init.d/$_:$.";
+ tag 'init.d-script-has-unterminated-lsb-section', "etc/init.d/$_:$.";
last;
} elsif ($l =~ /^\# ([a-zA-Z-]+):\s*(.*?)\s*$/) {
my $keyword = lc $1;
my $value = $2;
- tag "init.d-script-has-duplicate-lsb-keyword", "etc/init.d/$_:$. $keyword"
+ tag 'init.d-script-has-duplicate-lsb-keyword', "etc/init.d/$_:$. $keyword"
if (defined $lsb{$keyword});
- tag "init.d-script-has-unknown-lsb-keyword", "etc/init.d/$_:$. $keyword"
+ tag 'init.d-script-has-unknown-lsb-keyword', "etc/init.d/$_:$. $keyword"
unless (defined ($lsb_keywords{$keyword}) || $keyword =~ /^x-/);
$lsb{$keyword} = defined($value) ? $value : '';
$last = $keyword;
@@ -253,7 +253,7 @@ sub check_init {
$value =~ s/^\#\s*//;
$lsb{description} .= ' ' . $value;
} else {
- tag "init.d-script-has-bad-lsb-line", "etc/init.d/$_:$.";
+ tag 'init.d-script-has-bad-lsb-line', "etc/init.d/$_:$.";
}
}
}
@@ -263,7 +263,7 @@ sub check_init {
$in_file_test = 1 if ($l =~ m/\bif\s+.*?(?:test|\[)(?:\s+\!)?\s+-[efr]\s+/);
$in_file_test = 0 if ($l =~ m/\bfi\b/);
if (!$in_file_test && $l =~ m,^\s*\.\s+["'"]?(/etc/default/[\$\w/-]+),) {
- tag "init.d-script-sourcing-without-test", "etc/init.d/$_:$. $1";
+ tag 'init.d-script-sourcing-without-test', "etc/init.d/$_:$. $1";
}
# This should be more sophisticated: ignore heredocs, ignore quoted
@@ -279,14 +279,14 @@ sub check_init {
# Make sure all of the required keywords are present.
if (not $lsb{BEGIN}) {
- tag "init.d-script-missing-lsb-section", "etc/init.d/$_";
+ tag 'init.d-script-missing-lsb-section', "etc/init.d/$_";
} else {
for my $keyword (keys %lsb_keywords) {
if ($lsb_keywords{$keyword} && !defined $lsb{$keyword}) {
if ($keyword eq 'short-description') {
- tag "init.d-script-missing-lsb-short-description", "etc/init.d/$_";
+ tag 'init.d-script-missing-lsb-short-description', "etc/init.d/$_";
} else {
- tag "init.d-script-missing-lsb-keyword", "etc/init.d/$_ $keyword";
+ tag 'init.d-script-missing-lsb-keyword', "etc/init.d/$_ $keyword";
}
}
}
@@ -325,13 +325,13 @@ sub check_init {
if ($runlevel =~ /^[sS0-6]$/) {
$stop{$runlevel} = 1 unless $runlevel =~ /[sS2-5]/;
if ($start{$runlevel}) {
- tag "init.d-script-has-conflicting-start-stop", "etc/init.d/$_ $runlevel";
+ tag 'init.d-script-has-conflicting-start-stop', "etc/init.d/$_ $runlevel";
}
if ($runlevel =~ /[sS]/) {
- tag "init-d-script-stops-in-s-runlevel", "etc/init.d/$_";
+ tag 'init-d-script-stops-in-s-runlevel', "etc/init.d/$_";
}
} else {
- tag "init.d-script-has-bad-stop-runlevel", "etc/init.d/$_ $runlevel";
+ tag 'init.d-script-has-bad-stop-runlevel', "etc/init.d/$_ $runlevel";
}
}
@@ -410,7 +410,7 @@ sub check_init {
"etc/init.d/$_",
"$dependency -> $implied_dependencies{$dependency}";
} elsif ($keyword =~ m/^required-/ && $dependency =~ m/^\$/) {
- tag "init.d-script-depends-on-unknown-virtual-facility",
+ tag 'init.d-script-depends-on-unknown-virtual-facility',
"etc/init.d/$_", $dependency
unless ($VIRTUAL_FACILITIES->known($dependency));
}
@@ -420,7 +420,7 @@ sub check_init {
# all tags included in file?
for my $option qw(start stop restart force-reload) {
$tag{$option}
- or tag "init.d-script-does-not-implement-required-option", "etc/init.d/$_ $option";
+ or tag 'init.d-script-does-not-implement-required-option', "etc/init.d/$_ $option";
}
}
diff --git a/checks/manpages b/checks/manpages
index 45933db..1e24615 100644
--- a/checks/manpages
+++ b/checks/manpages
@@ -20,6 +20,8 @@
package Lintian::manpages;
use strict;
+use warnings;
+
use Util;
use Lintian::Check qw(check_spelling);
use Lintian::Tags qw(tag);
@@ -69,8 +71,8 @@ foreach my $file (@{$info->sorted_index}) {
next;
}
- if (($path =~ m,usr/(share|X11R6)/man/$,) and ($fname ne "")) {
- tag "manpage-in-wrong-directory", $file;
+ if (($path =~ m,usr/(share|X11R6)/man/$,) and ($fname ne '')) {
+ tag 'manpage-in-wrong-directory', $file;
next;
}
@@ -82,50 +84,50 @@ foreach my $file (@{$info->sorted_index}) {
my $t = $1;
if (not $t =~ m,^.*man(\d)/$,o) {
- tag "manpage-in-wrong-directory", $file;
+ tag 'manpage-in-wrong-directory', $file;
next;
}
my ($section,$name) = ($1,$fname);
- my $lang = "";
+ my $lang = '';
$lang = $1 if $t =~ m,^/([^/]+)/man\d/$,o;
# The country should not be part of the man page locale directory unless
# it's one of the known cases where the language is significantly
# different between countries.
- if ($lang =~ /_/ && $lang !~ /^(pt_BR|zh_[A-Z][A-Z])$/) {
- tag "manpage-locale-dir-country-specific", $file;
+ if ($lang =~ /_/ && $lang !~ /^(?:pt_BR|zh_[A-Z][A-Z])$/) {
+ tag 'manpage-locale-dir-country-specific', $file;
}
my @pieces = split(/\./, $name);
my $ext = pop @pieces;
if ($ext ne 'gz') {
push @pieces, $ext;
- tag "manpage-not-compressed", $file;
+ tag 'manpage-not-compressed', $file;
} elsif ($perm =~ m,^[-h],o) { # so it's .gz... files first; links later
if ($file_info !~ m/gzip compressed data/o) {
- tag "manpage-not-compressed-with-gzip", $file;
+ tag 'manpage-not-compressed-with-gzip', $file;
} elsif ($file_info !~ m/max compression/o) {
- tag "manpage-not-compressed-with-max-compression", $file;
+ tag 'manpage-not-compressed-with-max-compression', $file;
}
}
my $fn_section = pop @pieces;
my $section_num = $fn_section;
if (scalar @pieces && $section_num =~ s/^(\d).*$/$1/) {
- my $bin = join(".", @pieces);
+ my $bin = join('.', @pieces);
$manpage{$bin} = [] unless $manpage{$bin};
push @{$manpage{$bin}}, { file => $file, lang => $lang };
# number of directory and manpage extension equal?
if ($section_num != $section) {
- tag "manpage-in-wrong-directory", $file;
+ tag 'manpage-in-wrong-directory', $file;
}
} else {
- tag "manpage-has-wrong-extension", $file;
+ tag 'manpage-has-wrong-extension', $file;
}
# special check for manual pages for X11 games
if ($path =~ m,^usr/X11R6/man/man6/,o) {
- tag "x11-games-should-be-in-usr-games", $file;
+ tag 'x11-games-should-be-in-usr-games', $file;
}
# check symbolic links to other manual pages
@@ -144,9 +146,9 @@ foreach my $file (@{$info->sorted_index}) {
($link =~ m,^\.\./\.\./man/man[237]/undocumented\.[237]\.gz$,o) or
($link =~ m,^\.\./\.\./\.\./share/man/man[237]/undocumented\.[237]\.gz$,o) or
($link =~ m,^\.\./\.\./\.\./\.\./usr/share/man/man[237]/undocumented\.[237]\.gz$,o)) {
- tag "link-to-undocumented-manpage", $file;
+ tag 'link-to-undocumented-manpage', $file;
} else {
- tag "bad-link-to-undocumented-manpage", $file;
+ tag 'bad-link-to-undocumented-manpage', $file;
}
} else {
# undocumented link in /usr/X11R6/man -- possibilities:
@@ -154,9 +156,9 @@ foreach my $file (@{$info->sorted_index}) {
# ../../../../usr/share/man/man?/undocumented...
if (($link =~ m,^\.\./\.\./\.\./share/man/man[237]/undocumented\.[237]\.gz$,o) or
($link =~ m,^\.\./\.\./\.\./\.\./usr/share/man/man[237]/undocumented\.[237]\.gz$,o)) {
- tag "link-to-undocumented-manpage", $file;
+ tag 'link-to-undocumented-manpage', $file;
} else {
- tag "bad-link-to-undocumented-manpage", $file;
+ tag 'bad-link-to-undocumented-manpage', $file;
}
}
}
@@ -168,13 +170,13 @@ foreach my $file (@{$info->sorted_index}) {
close MANFILE;
# Is it a .so link?
if ($index_info->{size} < 256) {
- my ($i, $first) = (0, "");
+ my ($i, $first) = (0, '');
do {
- $first = $manfile[$i++] || "";
+ $first = $manfile[$i++] || '';
} while ($first =~ /^\.\\"/ && $manfile[$i]); #");
unless ($first) {
- tag "empty-manual-page", $file;
+ tag 'empty-manual-page', $file;
} elsif ($first =~ /^\.so\s+(.+)?$/) {
my $dest = $1;
if ($dest =~ m,^([^/]+)/(.+)$,) {
@@ -185,14 +187,14 @@ foreach my $file (@{$info->sorted_index}) {
if ($rest =~ m,^([^/]+)/(.+)$,) {
my ($lang, $rest) = ($1, $2);
if ($rest !~ m,^[^/]+\.\d(?:\S+)?(?:\.gz)?$,) {
- tag "bad-so-link-within-manual-page", $file;
+ tag 'bad-so-link-within-manual-page', $file;
}
} else {
- tag "bad-so-link-within-manual-page", $file;
+ tag 'bad-so-link-within-manual-page', $file;
}
}
} else {
- tag "bad-so-link-within-manual-page", $file;
+ tag 'bad-so-link-within-manual-page', $file;
}
next;
}
@@ -222,16 +224,16 @@ foreach my $file (@{$info->sorted_index}) {
my $desc = <LEXGROG>;
$desc =~ s/^[^:]+: \"(.*)\"$/$1/;
if ($desc =~ /(\S+)\s+-\s+manual page for \1/i) {
- tag "manpage-has-useless-whatis-entry", $file;
+ tag 'manpage-has-useless-whatis-entry', $file;
} elsif ($desc =~ /(\S+)\s+-\s+programs? to do something/i) {
tag "manpage-is-dh_make-template", $file;
}
1 while <LEXGROG>;
close LEXGROG;
- tag "manpage-has-bad-whatis-entry", $file if $? != 0;
+ tag 'manpage-has-bad-whatis-entry', $file if $? != 0;
}
- # If it's not a .so link, run it through "man" to check for errors.
+ # If it's not a .so link, run it through 'man' to check for errors.
# If it is in a directory with the standard man layout, cd to the
# parent directory before running man so that .so directives are
# processed properly. (Yes, there are man pages that include other
@@ -273,7 +275,7 @@ foreach my $file (@{$info->sorted_index}) {
next if /warning: (?:macro )?\`(Tr|IX)\' not defined/;
chomp;
s/^[^:]+://o;
- tag "manpage-has-errors-from-man", $file, $_;
+ tag 'manpage-has-errors-from-man', $file, $_;
last;
}
close(MANERRS);
@@ -289,7 +291,7 @@ foreach my $file (@{$info->sorted_index}) {
my ($th_command, $th_title, $th_section, $th_date ) =
Text::ParseWords::parse_line( '\s+', 0, $line);
if ($th_section && (lc($fn_section) ne lc($th_section))) {
- tag "manpage-section-mismatch", "$file:$lc $fn_section != $th_section";
+ tag 'manpage-section-mismatch', "$file:$lc $fn_section != $th_section";
}
}
# Catch hyphens used as minus signs by looking for ones at the
@@ -306,25 +308,25 @@ foreach my $file (@{$info->sorted_index}) {
)?
(--?\w+)/ox) {
$hc++;
- tag "hyphen-used-as-minus-sign", "$file:$lc"
+ tag 'hyphen-used-as-minus-sign', "$file:$lc"
if $hc <= 10 or $ENV{'LINTIAN_DEBUG'};
}
if (($line =~ m,(/usr/(dict|doc|etc|info|man|adm|preserve)/),o)
|| ($line =~ m,(/var/(adm|catman|named|nis|preserve)/),o)) {
# FSSTND dirs in man pages
# regexes taken from checks/files
- tag "FSSTND-dir-in-manual-page", "$file:$lc $1";
+ tag 'FSSTND-dir-in-manual-page', "$file:$lc $1";
}
if ($line eq '.SH "POD ERRORS"') {
- tag "manpage-has-errors-from-pod2man", "$file:$lc";
+ tag 'manpage-has-errors-from-pod2man', "$file:$lc";
}
# Check for spelling errors if the manpage is English
- check_spelling("spelling-error-in-manpage", $line, $file, { $pkg => 1 })
+ check_spelling('spelling-error-in-manpage', $line, $file, { $pkg => 1 })
if ($path =~ m,/man/man\d/,);
}
- tag "hyphen-used-as-minus-sign", $file, ($hc - 10),
+ tag 'hyphen-used-as-minus-sign', $file, ($hc - 10),
"more occurrences not shown"
- if ($hc > 10 and ! $ENV{'LINTIAN_DEBUG'});
+ if ($hc > 10 && ! $ENV{'LINTIAN_DEBUG'});
}
}
@@ -339,25 +341,25 @@ for my $f (sort keys %binary) {
if ($manp_info->{file} =~ m/X11R6/) {
# ok.
} else {
- tag "manpage-for-x11-binary-in-wrong-directory", "$binary{$f} $manp_info->{file}";
+ tag 'manpage-for-x11-binary-in-wrong-directory', "$binary{$f} $manp_info->{file}";
}
}
} else {
for my $manp_info (@{$manpage{$f}}) {
# no. manpage in X11?
if ($manp_info->{file} =~ m/X11R6/) {
- tag "manpage-for-non-x11-binary-in-wrong-directory", "$binary{$f} $manp_info->{file}";
+ tag 'manpage-for-non-x11-binary-in-wrong-directory', "$binary{$f} $manp_info->{file}";
} else {
# ok.
}
}
}
- if (not grep { $_->{lang} eq "" } @{$manpage{$f}}) {
- tag "binary-without-english-manpage", "$binary{$f}";
+ if (not grep { $_->{lang} eq '' } @{$manpage{$f}}) {
+ tag 'binary-without-english-manpage', "$binary{$f}";
}
} else {
- tag "binary-without-manpage", "$binary{$f}";
+ tag 'binary-without-manpage', "$binary{$f}";
}
}
diff --git a/checks/md5sums b/checks/md5sums
index e33477b..11df4ed 100644
--- a/checks/md5sums
+++ b/checks/md5sums
@@ -36,7 +36,7 @@ my %info_entry;
my %conffile;
# read in md5sums info file
-open(C, '<', "md5sums") or fail("cannot open md5sums info file: $!");
+open(C, '<', 'md5sums') or fail("cannot open md5sums info file: $!");
while (<C>) {
chop;
next if m/^\s*$/;
@@ -64,7 +64,7 @@ if (-f "control/conffiles") {
# Is there a md5sums control file?
unless (-f $control) {
# ignore if package contains no files
- return 0 if -z "md5sums";
+ return 0 if -z 'md5sums';
# check if package contains non-conffiles
# debhelper doesn't create entries in md5sums
@@ -78,7 +78,7 @@ unless (-f $control) {
}
}
- tag "no-md5sums-control-file", "" unless $only_conffiles;
+ tag 'no-md5sums-control-file', '' unless $only_conffiles;
return 0;
}
@@ -96,7 +96,7 @@ while (<C>) {
if (m{^([a-f0-9]+)\s*(?:\./)?(\S.*)$} && length($1) == 32) {
$control_entry{$2} = $1;
} else {
- tag "malformed-md5sums-control-file", "line $.";
+ tag 'malformed-md5sums-control-file', "line $.";
}
}
close(C);
@@ -104,15 +104,15 @@ close(C);
for my $file (keys %control_entry) {
if (not exists $info_entry{$file}) {
- tag "md5sums-lists-nonexisting-file", $file;
+ tag 'md5sums-lists-nonexisting-file', $file;
} elsif ($info_entry{$file} ne $control_entry{$file}) {
- tag "md5sum-mismatch", $file;
+ tag 'md5sum-mismatch', $file;
}
delete $info_entry{$file};
}
for my $file (keys %info_entry) {
- tag "file-missing-in-md5sums", $file
+ tag 'file-missing-in-md5sums', $file
unless ($conffile{$file} || $file =~ m%^var/lib/[ai]spell/.%);
}
diff --git a/checks/menu-format b/checks/menu-format
index b54c8c9..ece7f5b 100644
--- a/checks/menu-format
+++ b/checks/menu-format
@@ -406,7 +406,7 @@ foreach my $file (@{$info->sorted_index}) {
$file =~ m,^usr/share/applications/.*\.desktop$,) {
if ($operm & 0100 or $operm & 010 or $operm & 01) {
- tag "executable-desktop-file", sprintf("%s %04o",$file,$operm);
+ tag 'executable-desktop-file', sprintf("%s %04o",$file,$operm);
}
unless ($file =~ m,template,) {
push (@desktop_files, $file);
@@ -427,9 +427,9 @@ foreach my $menufile (@menufiles) {
my $fullname = "usr/share/menu/$basename";
$fullname = "usr/lib/menu/$basename" if $menufile =~ m,^menu/lib/,o;
- next if $basename eq "README"; # README is a special case
+ next if $basename eq 'README'; # README is a special case
- my $menufile_line ="";
+ my $menufile_line ='';
open (IN, '<', $menufile) or
fail("cannot open menu file $menufile for reading.");
# line below is commented out in favour of the while loop
@@ -445,7 +445,7 @@ foreach my $menufile (@menufiles) {
# Check first line of file to see if it matches the old menu file format.
if ($menufile_line =~ m/^(?!\?package\(.*\)).* .* .* .* "?.*"? .*$/o) {
- tag "old-format-menu-file", $fullname;
+ tag 'old-format-menu-file', $fullname;
close IN;
next;
} elsif ($menufile_line =~ m/^!C\s*menu-2/o) {
@@ -455,7 +455,7 @@ foreach my $menufile (@menufiles) {
}
# Parse entire file as a new format menu file.
- my $line="";
+ my $line='';
my $lc=0;
do {
$lc++;
@@ -469,7 +469,7 @@ foreach my $menufile (@menufiles) {
# This is caught by VerifyLine().
if (! ($menufile_line =~ m/\\\s*?$/)) {
VerifyLine($pkg, $info, $type, $menufile, $fullname, $line, $lc);
- $line="";
+ $line='';
}
} while ($menufile_line = <IN>);
VerifyLine($pkg, $info, $type, $menufile, $fullname, $line, $lc);
@@ -497,25 +497,25 @@ sub VerifyLine {
# This is in here to fix a common mistake: whitespace after a '\'
# character.
if ($line =~ s/\\\s+\n/ /mgo) {
- tag "whitespace-after-continuation-character", "$fullname:$linecount";
+ tag 'whitespace-after-continuation-character', "$fullname:$linecount";
}
# Ignore lines that are all whitespace or empty.
- return if $line =~ m/^\s+$/o or ! $line;
+ return if $line =~ m/^\s*$/o;
# Ignore lines that are comments.
return if $line =~ m/^\s*\#/o;
# Start by testing the package check.
if (not $line =~ m/^\?package\((.*?)\):/o) {
- tag "bad-test-in-menu-item", "$fullname:$linecount";
+ tag 'bad-test-in-menu-item', "$fullname:$linecount";
return;
}
my $pkg_test = $1;
my %tested_packages = map { $_ => 1 } split( /\s*,\s*/, $pkg_test);
my $tested_packages = scalar keys %tested_packages;
unless (exists $tested_packages{$pkg}) {
- tag "pkg-not-in-package-test", "$pkg_test $fullname";
+ tag 'pkg-not-in-package-test', "$pkg_test $fullname";
}
$line =~ s/^\?package\(.*?\)://;
@@ -555,14 +555,14 @@ sub VerifyLine {
my $value = $2;
if (exists $vals{$tag}) {
- tag "duplicated-tag-in-menu-item", "$fullname $1:$linecount";
+ tag 'duplicated-tag-in-menu-item', "$fullname $1:$linecount";
}
# If the value was quoted, remove those quotes.
if ($value =~ m/^\"(.*)\"$/) {
$value = $1;
} else {
- tag "unquoted-string-in-menu-item", "$fullname $1:$linecount";
+ tag 'unquoted-string-in-menu-item', "$fullname $1:$linecount";
}
# If the value has escaped characters, remove the
@@ -584,7 +584,7 @@ sub VerifyLine {
# If that loop didn't match up to end of line, we have a
# problem..
if (pos($line) < length($line)) {
- tag "unparsable-menu-item", "$fullname:$linecount";
+ tag 'unparsable-menu-item', "$fullname:$linecount";
# Give up now, before things just blow up in our face.
return;
}
@@ -594,7 +594,7 @@ sub VerifyLine {
# Test for important tags.
foreach my $tag (@req_tags) {
unless ( exists($vals{$tag}) && defined($vals{$tag}) ) {
- tag "menu-item-missing-required-tag", "$tag $fullname:$linecount";
+ tag 'menu-item-missing-required-tag', "$tag $fullname:$linecount";
# Just give up right away, if such an essential tag is missing,
# chance is high the rest doesn't make sense either. And now all
# following checks can assume those tags to be there
@@ -605,7 +605,7 @@ sub VerifyLine {
# Make sure all tags are known.
foreach my $tag (keys %vals) {
if (! $known_tags_hash{$tag}) {
- tag "menu-item-contains-unknown-tag", "$tag $fullname:$linecount";
+ tag 'menu-item-contains-unknown-tag', "$tag $fullname:$linecount";
}
}
@@ -617,7 +617,7 @@ sub VerifyLine {
# Be sure the command is provided by the package.
my ($okay, $command) = VerifyCmd ($fullname, $linecount, $vals{'command'},
$pkg, $info);
- tag "menu-command-not-in-package", "$fullname:$linecount $command"
+ tag 'menu-command-not-in-package', "$fullname:$linecount $command"
unless ($okay
or not $command
or ($tested_packages >= 2)
@@ -638,35 +638,35 @@ sub VerifyLine {
if ($section =~ m:^(WindowManagers/Modules|FVWM Modules|Window Maker):) {
# WM/Modules: needs must not be the regular ones nor wm
- if ($needs_tag_vals_hash{$needs} or $needs eq "wm") {
- tag "non-wm-module-in-wm-modules-menu-section", "$needs $fullname:$linecount";
+ if ($needs_tag_vals_hash{$needs} or $needs eq 'wm') {
+ tag 'non-wm-module-in-wm-modules-menu-section', "$needs $fullname:$linecount";
}
} elsif ($section =~ m:^Window ?Managers:) {
# Other WM sections: needs must be wm
if ($needs ne 'wm') {
- tag "non-wm-in-windowmanager-menu-section", "$needs $fullname:$linecount";
+ tag 'non-wm-in-windowmanager-menu-section', "$needs $fullname:$linecount";
}
} else {
# Any other section: just only the general ones
- if ($needs eq "dwww") {
- tag "menu-item-needs-dwww", "$fullname:$linecount";
+ if ($needs eq 'dwww') {
+ tag 'menu-item-needs-dwww', "$fullname:$linecount";
} elsif (not $needs_tag_vals_hash{$needs}) {
- tag "menu-item-needs-tag-has-unknown-value", "$needs $fullname:$linecount";
+ tag 'menu-item-needs-tag-has-unknown-value', "$needs $fullname:$linecount";
}
}
# Check the section tag
# Check for historical changes in the section tree.
if ($section =~ m:^Apps/Games:) {
- tag "menu-item-uses-apps-games-section", "$fullname:$linecount";
+ tag 'menu-item-uses-apps-games-section', "$fullname:$linecount";
$section =~ s:^Apps/::;
}
if ($section =~ m:^Apps/:) {
- tag "menu-item-uses-apps-section", "$fullname:$linecount";
+ tag 'menu-item-uses-apps-section', "$fullname:$linecount";
$section =~ s:^Apps/:Applications/:;
}
if ($section =~ m:^WindowManagers:) {
- tag "menu-item-uses-windowmanagers-section", "$fullname:$linecount";
+ tag 'menu-item-uses-windowmanagers-section', "$fullname:$linecount";
$section =~ s:^WindowManagers:Window Managers:;
}
@@ -674,11 +674,11 @@ sub VerifyLine {
my ($rootsection) = $section =~ m:([^/]*):;
if (not $root_sections_hash{$rootsection}) {
if (not $rootsection =~ m/$pkg/i) {
- tag "menu-item-creates-new-root-section", "$rootsection $fullname:$linecount";
+ tag 'menu-item-creates-new-root-section', "$rootsection $fullname:$linecount";
}
} else {
if (not $sections_hash{$section}) {
- tag "menu-item-creates-new-section", "$vals{section} $fullname:$linecount";
+ tag 'menu-item-creates-new-section', "$vals{section} $fullname:$linecount";
}
}
}
@@ -689,12 +689,12 @@ sub VerifyIcon {
local *IN;
if ($icon eq 'none') {
- tag "menu-item-uses-icon-none", "$fullname:$linecount";
+ tag 'menu-item-uses-icon-none', "$fullname:$linecount";
return;
}
if (not ($icon =~ m/\.xpm$/i)) {
- tag "menu-icon-not-in-xpm-format", $icon;
+ tag 'menu-icon-not-in-xpm-format', $icon;
return;
}
@@ -705,7 +705,7 @@ sub VerifyIcon {
}
if (! open (IN, '<', $iconfile)) {
- tag "menu-icon-missing", $icon;
+ tag 'menu-icon-missing', $icon;
return;
}
@@ -723,7 +723,7 @@ sub VerifyIcon {
my $cpp = $4 + 0;
if ($width > $size || $height > $size) {
- tag "menu-icon-too-big", "$icon: ${width}x${height} > ${size}x${size}";
+ tag 'menu-icon-too-big', "$icon: ${width}x${height} > ${size}x${size}";
}
close IN or die;
@@ -731,7 +731,7 @@ sub VerifyIcon {
parse_error:
close IN or die;
- tag "menu-icon-cannot-be-parsed", "$icon: looking for $parse";
+ tag 'menu-icon-cannot-be-parsed', "$icon: looking for $parse";
return;
}
@@ -774,17 +774,17 @@ sub VerifyDesktopFile {
my $basetag = $tag;
my ($encoding) = ($basetag =~ s/\[([^\]]+)\]$//);
if (exists $vals{$tag}) {
- tag "duplicated-key-in-desktop-entry", "$file:$. $tag";
+ tag 'duplicated-key-in-desktop-entry', "$file:$. $tag";
} elsif ($deprecated_desktop_keys{$basetag}) {
if ($basetag eq 'Encoding') {
- push (@pending, [ "desktop-entry-contains-encoding-key", "$file:$. $tag" ]);
+ push (@pending, [ 'desktop-entry-contains-encoding-key', "$file:$. $tag" ]);
} else {
- push (@pending, [ "desktop-entry-contains-deprecated-key", "$file:$. $tag" ]);
+ push (@pending, [ 'desktop-entry-contains-deprecated-key', "$file:$. $tag" ]);
}
} elsif ( not $known_desktop_keys{$basetag}
and not $kde_desktop_keys{$basetag}
and not $basetag =~ /^X-/) {
- push (@pending, [ "desktop-entry-contains-unknown-key", "$file:$. $tag" ]);
+ push (@pending, [ 'desktop-entry-contains-unknown-key', "$file:$. $tag" ]);
}
$vals{$tag} = $value;
}
@@ -802,7 +802,7 @@ sub VerifyDesktopFile {
# Test for important keys.
for my $tag (@req_desktop_keys) {
unless (defined $vals{$tag}) {
- tag "desktop-entry-missing-required-key", "$file $tag";
+ tag 'desktop-entry-missing-required-key', "$file $tag";
}
}
@@ -815,7 +815,7 @@ sub VerifyDesktopFile {
if ($file =~ m,^usr/share/applications/, and $vals{'Exec'} and $vals{'Exec'} =~ /\S/) {
my ($okay, $command) = VerifyCmd ($file, undef, $vals{'Exec'}, $pkg,
$info);
- tag "desktop-command-not-in-package", "$file $command"
+ tag 'desktop-command-not-in-package', "$file $command"
unless $okay or $command eq 'kcmshell';
}
@@ -827,18 +827,18 @@ sub VerifyDesktopFile {
for my $cat (@cats) {
next if $cat =~ /^X-/;
if ($reserved_categories{$cat}) {
- tag "desktop-entry-uses-reserved-category", "$cat $file"
+ tag 'desktop-entry-uses-reserved-category', "$cat $file"
unless $vals{'OnlyShowIn'};
$saw_main = 1;
$in_reserved = 1;
} elsif (not $categories{$cat} and not $main_categories{$cat}) {
- tag "desktop-entry-invalid-category", "$cat $file";
+ tag 'desktop-entry-invalid-category', "$cat $file";
} elsif ($main_categories{$cat}) {
$saw_main = 1;
}
}
unless ($saw_main) {
- tag "desktop-entry-lacks-main-category", $file;
+ tag 'desktop-entry-lacks-main-category', $file;
}
}
diff --git a/checks/menus b/checks/menus
index 5887399..205ccae 100644
--- a/checks/menus
+++ b/checks/menus
@@ -90,7 +90,7 @@ if (-f 'control/postrm') {
# read package contents
for my $file (@{$info->sorted_index}) {
- next if $file eq "";
+ next if $file eq '';
add_file_link_info ($info, $file, \%all_files, \%all_links);
my $index_info = $info->index->{$file};
@@ -100,25 +100,25 @@ for my $file (@{$info->sorted_index}) {
# menu file?
if ($file =~ m,^usr/(lib|share)/menu/\S,o) { # correct permissions?
if ($operm & 01 or $operm & 010 or $operm & 0100) {
- tag "executable-menu-file", sprintf("%s %04o",$file,$operm);
+ tag 'executable-menu-file', sprintf("%s %04o",$file,$operm);
}
next if $file =~ m,^usr/(lib|share)/menu/README$,;
if ($file =~ m,^usr/lib/,o) {
- tag "menu-file-in-usr-lib", $file;
+ tag 'menu-file-in-usr-lib', $file;
}
$menu_file = $file;
if ($file =~ m,usr/(lib|share)/menu/menu$,o and $pkg ne 'menu') {
- tag "bad-menu-file-name", $file;
+ tag 'bad-menu-file-name', $file;
}
}
# doc-base file?
elsif ($file =~ m,^usr/share/doc-base/\S,o) { # correct permissions?
if ($operm & 01 or $operm & 010 or $operm & 0100) {
- tag "executable-in-usr-share-docbase", $file, sprintf("%04o",$operm);
+ tag 'executable-in-usr-share-docbase', $file, sprintf("%04o",$operm);
}
$docbase_file = $file;
}
@@ -142,7 +142,7 @@ for my $file (@{$info->sorted_index}) {
}
}
close MM;
- tag "menu-method-should-include-menu-h", $file
+ tag 'menu-method-should-include-menu-h', $file
unless $menumethod_includes_menu_h or $pkg eq 'menu';
}
# package doc dir?
@@ -159,42 +159,42 @@ close IN;
# prerm scripts should not call update-menus
if ($prerm{'calls-updatemenus'}) {
- tag "prerm-calls-updatemenus";
+ tag 'prerm-calls-updatemenus';
}
# postrm scripts should not call install-docs
if ($postrm{'calls-installdocs'} or $postrm{'calls-installdocs-r'}) {
- tag "postrm-calls-installdocs";
+ tag 'postrm-calls-installdocs';
}
# preinst scripts should not call either update-menus nor installdocs
if ($preinst{'calls-updatemenus'}) {
- tag "preinst-calls-updatemenus";
+ tag 'preinst-calls-updatemenus';
}
if ($preinst{'calls-installdocs'}) {
- tag "preinst-calls-installdocs";
+ tag 'preinst-calls-installdocs';
}
# don't set the /usr/doc link, the FHS transition is over (2002-10-08)
if (defined $postinst{'sets-link'} && $postinst{'sets-link'} == 1) {
- tag "postinst-should-not-set-usr-doc-link";
+ tag 'postinst-should-not-set-usr-doc-link';
}
$anymenu_file = $menu_file || $menumethod_file;
# No one needs to call install-docs any more; triggers now handles that.
if ($postinst{'calls-installdocs'} or $postinst{'calls-installdocs-r'}) {
- tag "postinst-has-useless-call-to-install-docs";
+ tag 'postinst-has-useless-call-to-install-docs';
}
if ($prerm{'calls-installdocs'} or $prerm{'calls-installdocs-r'}) {
- tag "prerm-has-useless-call-to-install-docs";
+ tag 'prerm-has-useless-call-to-install-docs';
}
# check consistency
# docbase file?
if ($docbase_file) {
- opendir DOCBASEDIR, "doc-base" or fail("cannot read doc-base directory.");
+ opendir DOCBASEDIR, 'doc-base' or fail("cannot read doc-base directory.");
my $dbfile;
while (defined ($dbfile = readdir DOCBASEDIR)) {
# don't try to parse executables, plus we already warned about it
@@ -208,7 +208,7 @@ if ($docbase_file) {
# libraries register their documentation via the ghc compiler's
# documetation registration mechanism. See bug #586877.
} else {
- tag "possible-documentation-but-no-doc-base-registration";
+ tag 'possible-documentation-but-no-doc-base-registration';
}
}
@@ -223,18 +223,18 @@ if ($anymenu_file) {
# debhelper apparently currently still adds that to the maintainer script,
# so don't warn if it's done.
if (not $postinst{'calls-updatemenus'}) {
- tag "postinst-does-not-call-updatemenus", $anymenu_file;
+ tag 'postinst-does-not-call-updatemenus', $anymenu_file;
}
if ($menumethod_file and not $postrm{'calls-updatemenus'}) {
- tag "postrm-does-not-call-updatemenus", $menumethod_file
+ tag 'postrm-does-not-call-updatemenus', $menumethod_file
unless $pkg eq 'menu';
}
} else {
if ($postinst{'calls-updatemenus'}) {
- tag "postinst-has-useless-call-to-update-menus";
+ tag 'postinst-has-useless-call-to-update-menus';
}
if ($postrm{'calls-updatemenus'}) {
- tag "postrm-has-useless-call-to-update-menus";
+ tag 'postrm-has-useless-call-to-update-menus';
}
}
@@ -284,7 +284,7 @@ sub check_doc_base_file {
# Sections' separator.
} elsif (/^(\s*)$/) {
- tag "doc-base-file-separator-extra-whitespaces", "$dbfile:$."
+ tag 'doc-base-file-separator-extra-whitespaces', "$dbfile:$."
if $1;
next unless $field; # skip successive empty lines
@@ -306,7 +306,7 @@ sub check_doc_base_file {
# Everything else is a syntax error.
} else {
- tag "doc-base-file-syntax-error", "$dbfile:$.";
+ tag 'doc-base-file-syntax-error', "$dbfile:$.";
}
}
@@ -320,7 +320,7 @@ sub check_doc_base_file {
}
# Make sure we saw at least one format.
- tag "doc-base-file-no-format-section", "$dbfile:$." unless %sawformats;
+ tag 'doc-base-file-no-format-section', "$dbfile:$." unless %sawformats;
close IN;
}
@@ -331,9 +331,9 @@ sub check_doc_base_field {
my ($pkg, $dbfile, $line, $field, $vals, $sawfields, $sawformats,
$knownfields, $all_files, $all_links) = @_;
- tag "doc-base-file-unknown-field", "$dbfile:$line", $field
+ tag 'doc-base-file-unknown-field', "$dbfile:$line", $field
unless defined $knownfields->{$field};
- tag "doc-base-file-duplicated-field", "$dbfile:$line", $field
+ tag 'doc-base-file-duplicated-field', "$dbfile:$line", $field
if $sawfields->{$field};
$sawfields->{$field} = 1;
@@ -349,12 +349,12 @@ sub check_doc_base_field {
my @files = map { split ('\s+', $_) } @$vals;
if ($field eq 'index' && @files > 1) {
- tag "doc-base-index-references-multiple-files", "$dbfile:$line";
+ tag 'doc-base-index-references-multiple-files', "$dbfile:$line";
}
for my $file (@files) {
next if $file eq '';
if ($file =~ m%^/usr/doc%) {
- tag "doc-base-file-references-usr-doc", "$dbfile:$line";
+ tag 'doc-base-file-references-usr-doc', "$dbfile:$line";
}
my $realfile = delink ($file, $all_links);
# openoffice.org-dev-doc has thousands of files listed so try to
@@ -373,7 +373,7 @@ sub check_doc_base_field {
$found = $all_files->{$realfile} || $all_files->{"$realfile/"};
}
unless ($found) {
- tag "doc-base-file-references-missing-file", "$dbfile:$line",
+ tag 'doc-base-file-references-missing-file', "$dbfile:$line",
$file;
}
}
@@ -385,9 +385,9 @@ sub check_doc_base_field {
$format =~ s/^\s+//o;
$format =~ s/\s+$//o;
$format = lc $format;
- tag "doc-base-file-unknown-format", "$dbfile:$line", $format
+ tag 'doc-base-file-unknown-format', "$dbfile:$line", $format
unless $known_doc_base_formats{$format};
- tag "doc-base-file-duplicated-format", "$dbfile:$line", $format
+ tag 'doc-base-file-duplicated-format', "$dbfile:$line", $format
if $sawformats->{$format};
$sawformats->{$format} = 1;
@@ -400,17 +400,17 @@ sub check_doc_base_field {
tag 'doc-base-invalid-document-field', "$dbfile:$line", $_
unless /^[a-z0-9+.-]+$/;
- tag "doc-base-document-field-ends-in-whitespace", "$dbfile:$line"
+ tag 'doc-base-document-field-ends-in-whitespace', "$dbfile:$line"
if /[ \t]$/;
- tag "doc-base-document-field-not-in-first-line", "$dbfile:$line"
+ tag 'doc-base-document-field-not-in-first-line', "$dbfile:$line"
unless $line == 1;
# Title field.
} elsif ($field eq 'title') {
if (@$vals) {
- check_spelling("spelling-error-in-doc-base-title-field",
+ check_spelling('spelling-error-in-doc-base-title-field',
join (' ', @$vals), "$dbfile:$line", { $pkg => 1});
- check_spelling_picky("spelling-error-in-doc-base-title-field",
+ check_spelling_picky('spelling-error-in-doc-base-title-field',
join (' ', @$vals), "$dbfile:$line");
}
@@ -420,11 +420,11 @@ sub check_doc_base_field {
$_ = join (' ', @$vals);
unless ($SECTIONS->known($_)) {
if (m,^App(?:lication)?s/(.+)$, and $SECTIONS->known($1)) {
- tag "doc-base-uses-applications-section", "$dbfile:$line", $_;
- } elsif (m,^(.+)/([^/]+)$, and $SECTIONS->known($1)) {
+ tag 'doc-base-uses-applications-section', "$dbfile:$line", $_;
+ } elsif (m,^(.+)/(?:[^/]+)$, and $SECTIONS->known($1)) {
# allows creating a new subsection to a known section
} else {
- tag "doc-base-unknown-section", "$dbfile:$line", $_;
+ tag 'doc-base-unknown-section', "$dbfile:$line", $_;
}
}
@@ -453,10 +453,10 @@ sub check_doc_base_field {
for my $idx (1 .. $#{$vals}) {
$_ = $vals->[$idx];
if (/manage\s+online\s+manuals\s.*Debian/o) {
- tag "doc-base-abstract-field-is-template", "$dbfile:$line"
- unless $pkg eq "doc-base";
+ tag 'doc-base-abstract-field-is-template', "$dbfile:$line"
+ unless $pkg eq 'doc-base';
} elsif (/^(\s+)\.(\s*)$/o and ($1 ne " " or $2)) {
- tag "doc-base-abstract-field-separator-extra-whitespaces",
+ tag 'doc-base-abstract-field-separator-extra-whitespaces',
"$dbfile:" . ($line - $#{$vals} + $idx);
} elsif (!$leadsp && /^(\s+)(\S)/o) {
# The regexp should always match.
@@ -470,15 +470,15 @@ sub check_doc_base_field {
}
}
unless ($leadsp_ok) {
- tag "doc-base-abstract-might-contain-extra-leading-whitespaces",
+ tag 'doc-base-abstract-might-contain-extra-leading-whitespaces',
"$dbfile:$line";
}
# Check spelling.
if (@$vals) {
- check_spelling("spelling-error-in-doc-base-abstract-field",
+ check_spelling('spelling-error-in-doc-base-abstract-field',
join (' ', @$vals), "$dbfile:$line", { $pkg => 1 });
- check_spelling_picky("spelling-error-in-doc-base-abstract-field",
+ check_spelling_picky('spelling-error-in-doc-base-abstract-field',
join (' ', @$vals), "$dbfile:$line");
}
}
@@ -489,14 +489,14 @@ sub check_doc_base_field {
sub check_doc_base_file_section {
my ($dbfile, $line, $sawfields, $sawformats, $knownfields) = @_;
- tag "doc-base-file-no-format", "$dbfile:$line"
+ tag 'doc-base-file-no-format', "$dbfile:$line"
if ((defined $sawfields->{'files'} || defined $sawfields->{'index'})
&& !(defined $sawfields->{'format'}));
# The current format is set by check_doc_base_field.
if ($sawfields->{'format'}) {
my $format = $sawformats->{' *current* '};
- tag "doc-base-file-no-index", "$dbfile:$line"
+ tag 'doc-base-file-no-index', "$dbfile:$line"
if ($format && ($format eq 'html' || $format eq 'info')
&& !$sawfields->{'index'});
}
@@ -546,7 +546,7 @@ sub delink {
$file =~ s%/+%/%g; # remove duplicated '/'
return $file unless %$all_links; # package doesn't symlinks
- my $p1 = "";
+ my $p1 = '';
my $p2 = $file;
my %used_links = ();
@@ -573,7 +573,7 @@ sub delink {
if (defined $all_links->{$p1}) {
return '!!! SYMLINK LOOP !!!' if defined $used_links{$p1};
$p2 = $all_links->{$p1} . $p2;
- $p1 = "";
+ $p1 = '';
$used_links{$p1} = 1;
}
}
@@ -581,7 +581,7 @@ sub delink {
# After the loop $p2 should be empty and $p1 should contain the target
# file. In some rare cases when $file contains no slashes, $p1 will be
# empty and $p2 will contain the result (which will be equal to $file).
- return $p1 ne "" ? $p1 : $p2;
+ return $p1 ne '' ? $p1 : $p2;
}
sub check_script {
@@ -620,7 +620,7 @@ sub check_script {
##
# does the script check whether update-menus exists?
- if (/-x\s+\S*update-menus/o or /(which|type)\s+update-menus/o
+ if (/-x\s+\S*update-menus/o or /(?:which|type)\s+update-menus/o
or /command\s+.*?update-menus/o) {
# yes, it does.
$pres->{'checks-for-updatemenus'} = 1;
@@ -635,12 +635,12 @@ sub check_script {
# checked first?
if (not $pres->{'checks-for-updatemenus'} and $pkg ne 'menu') {
- tag "maintainer-script-does-not-check-for-existence-of-updatemenus", "$script:$." unless $no_check_menu++;
+ tag 'maintainer-script-does-not-check-for-existence-of-updatemenus', "$script:$." unless $no_check_menu++;
}
}
# does the script check whether wm-menu-config exists?
- if (s/-x\s+\S*wm-menu-config//o or /(which|type)\s+wm-menu-config/o
+ if (s/-x\s+\S*wm-menu-config//o or /(?:which|type)\s+wm-menu-config/o
or s/command\s+.*?wm-menu-config//o) {
# yes, it does.
$pres->{'checks-for-wmmenuconfig'} = 1;
@@ -650,27 +650,27 @@ sub check_script {
if (m/(?:^\s*|[;&|]\s*|(?:then|do)\s+)(?:\/usr\/sbin\/)?wm-menu-config(?:\s|[;&|<>]|$)/) {
# yes, it does.
$pres->{'calls-wmmenuconfig'} = 1;
- tag "maintainer-script-calls-deprecated-wm-menu-config", "$script:$." unless $calls_wmmenu++;
+ tag 'maintainer-script-calls-deprecated-wm-menu-config', "$script:$." unless $calls_wmmenu++;
# checked first?
if (not $pres->{'checks-for-wmmenuconfig'} and $pkg ne 'menu') {
- tag "maintainer-script-does-not-check-for-existence-of-wm-menu-config", "$script:$." unless $no_check_wmmenu++;
+ tag 'maintainer-script-does-not-check-for-existence-of-wm-menu-config', "$script:$." unless $no_check_wmmenu++;
}
}
# does the script set a link in /usr/doc?
# does the script remove a link in /usr/doc?
if ($interp eq 'sh') {
- if (m,ln\s+(-\w+)?\s+\"?\.\./share/doc/\S+, ) {
+ if (m,ln\s+(?:-\w+)?\s+\"?\.\./share/doc/\S+, ) {
$pres->{'sets-link'} = 1;
}
- if (m,rm\s+(-\w+\s+)?\"?/usr/doc/\S+, ) {
+ if (m,rm\s+(?:-\w+\s+)?\"?/usr/doc/\S+, ) {
$pres->{'removes-link'} = 1;
}
} elsif ($interp eq 'perl') {
if (m|symlink\s*\(?\s*[\"\']\.\./share/doc/\.+?[\"\']\s*,|) {
$pres->{'sets-link'} = 1;
- } elsif (m,ln\s+(-\w+)?\s+\"?\.\./share/doc/\S+, ) {
+ } elsif (m,ln\s+(?:-\w+)?\s+\"?\.\./share/doc/\S+, ) {
$pres->{'sets-link'} = 1;
}
} else {
@@ -678,7 +678,7 @@ sub check_script {
}
# does the script check whether install-docs exists?
- if (s/-x\s+\S*install-docs//o or /(which|type)\s+install-docs/o
+ if (s/-x\s+\S*install-docs//o or /(?:which|type)\s+install-docs/o
or s/command\s+.*?install-docs//o) {
# yes, it does.
$pres->{'checks-for-installdocs'} = 1;
@@ -687,14 +687,14 @@ sub check_script {
# does the script call install-docs?
if (m/(?:^\s*|[;&|]\s*|(?:then|do)\s+)(?:\/usr\/sbin\/)?install-docs(?:\s|[;&|<>]|$)/) {
# yes, it does. Does it remove or add a doc?
- if (m/install-docs\s+(-r|--remove)\s/) {
+ if (m/install-docs\s+(?:-r|--remove)\s/) {
$pres->{'calls-installdocs-r'} = 1;
} else {
$pres->{'calls-installdocs'} = 1;
}
# checked first?
if (not $pres->{'checks-for-installdocs'}) {
- tag "maintainer-script-does-not-check-for-existence-of-installdocs", $script unless $no_check_installdocs++;
+ tag 'maintainer-script-does-not-check-for-existence-of-installdocs', $script unless $no_check_installdocs++;
}
}
}
diff --git a/checks/nmu b/checks/nmu
index 1d4dc5c..a7b333a 100644
--- a/checks/nmu
+++ b/checks/nmu
@@ -20,6 +20,7 @@
package Lintian::nmu;
use strict;
+use warnings;
use Lintian::Data;
use Lintian::Tags qw(tag);
@@ -48,7 +49,7 @@ my $changelog_mentions_team_upload = 0;
# debian/changelog in source packages. Catch a debian/changelog file that's a
# symlink.
if (-l "debfiles/changelog") {
- tag "changelog-is-symlink", "";
+ tag 'changelog-is-symlink', '';
return 0;
}
@@ -64,7 +65,7 @@ my $firstline = (grep /^\s*\*/, split('\n', $changes))[0];
if ($firstline) {
local $_ = $firstline;
if (/\bnmu\b/i or /non-maintainer upload/i) {
- unless (/(ackno|\back\b|confir|incorporat).*(\bnmu\b|non-maintainer)/i) {
+ unless (/(?:ackno|\back\b|confir|incorporat).*(?:\bnmu\b|non-maintainer)/i) {
$changelog_mentions_nmu = 1;
}
}
@@ -73,9 +74,9 @@ if ($firstline) {
$changelog_mentions_team_upload = 1 if /team upload/i;
}
-my $version = $info->field("version");
-my $maintainer = canonicalize($info->field("maintainer"));
-my $uploaders = $info->field("uploaders");
+my $version = $info->field('version');
+my $maintainer = canonicalize($info->field('maintainer'));
+my $uploaders = $info->field('uploaders');
my $version_nmuness = 0;
my $version_local = 0;
@@ -106,26 +107,26 @@ if ($version =~ /$UBUNTU_REGEX/ or $distribution =~ /$UBUNTU_REGEX/) {
}
if ($maintainer =~ /packages\@qa.debian.org/) {
- tag "orphaned-package-should-not-have-uploaders", ""
+ tag 'orphaned-package-should-not-have-uploaders', ''
if defined $uploaders;
- tag "qa-upload-has-incorrect-version-number", $version
+ tag 'qa-upload-has-incorrect-version-number', $version
if $version_nmuness == 1;
- tag "changelog-should-mention-qa", ""
+ tag 'changelog-should-mention-qa', ''
if !$changelog_mentions_qa;
} elsif ($changelog_mentions_team_upload) {
- tag "team-upload-has-incorrect-version-number", $version
+ tag 'team-upload-has-incorrect-version-number', $version
if $version_nmuness == 1;
} else {
# Local packages may be either NMUs or not.
unless ($changelog_mentions_local || $version_local) {
- tag "changelog-should-mention-nmu", ""
+ tag 'changelog-should-mention-nmu', ''
if !$changelog_mentions_nmu && $upload_is_nmu;
- tag "source-nmu-has-incorrect-version-number", $version
+ tag 'source-nmu-has-incorrect-version-number', $version
if $upload_is_nmu && $version_nmuness != 1;
}
- tag "changelog-should-not-mention-nmu", ""
+ tag 'changelog-should-not-mention-nmu', ''
if $changelog_mentions_nmu && !$upload_is_nmu;
- tag "maintainer-upload-has-incorrect-version-number", $version
+ tag 'maintainer-upload-has-incorrect-version-number', $version
if !$upload_is_nmu && $version_nmuness;
}
diff --git a/checks/ocaml b/checks/ocaml
index f4d7927..408e16f 100644
--- a/checks/ocaml
+++ b/checks/ocaml
@@ -21,6 +21,7 @@
package Lintian::ocaml;
use strict;
+use warnings;
use File::Basename;
use Lintian::Collect::Binary ();
@@ -38,7 +39,7 @@ my $info = shift;
# Collect information about .a files from ar-info dump
my %provided_o;
-open ARINFO, "ar-info";
+open ARINFO, '<', 'ar-info';
while (<ARINFO>) {
chomp;
if (/^\.\/([^:]+): (.*)$/) {
@@ -84,7 +85,7 @@ foreach my $file (@{$info->sorted_file_info}) {
# For each .cmxa file, there must be a matching .a file (#528367)
$_ = $file;
if (s/\.cmxa$/.a/ && !(exists $info->file_info->{$_})) {
- tag "ocaml-dangling-cmxa", $file;
+ tag 'ocaml-dangling-cmxa', $file;
}
# For each .cmxs file, there must be a matching .cma or .cmo file
@@ -94,7 +95,7 @@ foreach my $file (@{$info->sorted_file_info}) {
if (s/\.cmxs$/.cm/
&& !(exists $info->file_info->{"${_}a"})
&& !(exists $info->file_info->{"${_}o"})) {
- tag "ocaml-dangling-cmxs", $file;
+ tag 'ocaml-dangling-cmxs', $file;
}
}
@@ -105,7 +106,7 @@ foreach my $file (@{$info->sorted_file_info}) {
if (s/\.cmx$/.o/
&& !(exists $info->file_info->{$_})
&& !(exists $provided_o{$_})) {
- tag "ocaml-dangling-cmx", $file;
+ tag 'ocaml-dangling-cmx', $file;
}
# $somename.cmi should be shipped with $somename.mli or $somename.ml
@@ -115,7 +116,7 @@ foreach my $file (@{$info->sorted_file_info}) {
&& !(exists $info->file_info->{$_})) {
$cmi_number++;
if ($cmi_number <= $MAX_CMI) {
- tag "ocaml-dangling-cmi", $file;
+ tag 'ocaml-dangling-cmi', $file;
}
}
@@ -132,7 +133,7 @@ foreach my $file (@{$info->sorted_file_info}) {
# $somename.cmo should usually not be shipped with $somename.cma
$_ = $file;
if (s/\.cma$/.cmo/ && exists $info->file_info->{$_}) {
- tag "ocaml-stray-cmo", $file;
+ tag 'ocaml-stray-cmo', $file;
}
# development files outside /usr/lib/ocaml (.cmi, .cmx, .cmxa)
@@ -154,14 +155,14 @@ if ($is_dev_package) {
# summary about .cmi files
if ($cmi_number > $MAX_CMI) {
my $plural = ($cmi_number - $MAX_CMI == 1) ? '' : 's';
- tag "ocaml-dangling-cmi", ($cmi_number - $MAX_CMI),
+ tag 'ocaml-dangling-cmi', ($cmi_number - $MAX_CMI),
"more file$plural not shown";
}
# summary about /usr/lib/ocaml
if ($outside_number) {
$outside_prefix = dirname($outside_prefix);
my $plural = ($outside_number == 1) ? '' : 's';
- tag "ocaml-dev-file-not-in-usr-lib-ocaml",
+ tag 'ocaml-dev-file-not-in-usr-lib-ocaml',
"$outside_number file$plural in $outside_prefix";
}
if ($has_meta) {
@@ -174,7 +175,7 @@ if ($is_dev_package) {
if ($dev_number > 0) {
$dev_prefix = dirname($dev_prefix);
my $plural = ($dev_number == 1) ? '' : 's';
- tag "ocaml-dev-file-in-nondev-package",
+ tag 'ocaml-dev-file-in-nondev-package',
"$dev_number file$plural in $dev_prefix";
}
}
--
Debian package checker
Reply to: