[SCM] Debian package checker branch, master, updated. 2.5.12-58-g53d6323
The following commit has been merged in the master branch:
commit 53d6323f00f69958bebd22b447a9abc10930b3f4
Author: Niels Thykier <niels@thykier.net>
Date: Tue Apr 30 17:35:33 2013 +0200
checks/*: Replace all remaining bareword file handles
On top of that, enable the perlcritic policy
InputOutput::ProhibitBarewordFileHandles.
Signed-off-by: Niels Thykier <niels@thykier.net>
diff --git a/.perlcriticrc b/.perlcriticrc
index 96f207b..a60b766 100644
--- a/.perlcriticrc
+++ b/.perlcriticrc
@@ -8,7 +8,7 @@ severity = 1
# Work based on a whitelist
only = 1
# Our whitelist (ignores severity):
-include = ExplicitReturnUndef GlobFunction NegativeIndices PrivateVars UselessInitialization MatchVars NumberSeparators NullStatements LongChainsOfMethodCalls UseStrict UseWarnings EndWithOne ConditionalUseStatements PackageMatchesPodName JoinedReadline UnreachableCode TrailingWhitespace InterpolationOfLiterals ImplicitNewlines CommaSeparatedStatements UseStrict UseWarnings UnusedVariables UnusedCapture TwoArgOpen ProhibitHardTabs MismatchedOperators IndirectSyntax Modules:: BuiltinFunctions:: ClassHierarchies:: CommaSeparatedStatements QuotesAsQuotelikeOperatorDelimiters MixedBooleanOperators
+include = ExplicitReturnUndef GlobFunction NegativeIndices PrivateVars UselessInitialization MatchVars NumberSeparators NullStatements LongChainsOfMethodCalls UseStrict UseWarnings EndWithOne ConditionalUseStatements PackageMatchesPodName JoinedReadline UnreachableCode TrailingWhitespace InterpolationOfLiterals ImplicitNewlines CommaSeparatedStatements UseStrict UseWarnings UnusedVariables UnusedCapture TwoArgOpen ProhibitHardTabs MismatchedOperators IndirectSyntax Modules:: BuiltinFunctions:: ClassHierarchies:: CommaSeparatedStatements QuotesAsQuotelikeOperatorDelimiters MixedBooleanOperators ProhibitBarewordFileHandles
#include = MixedBooleanOperators InteractiveTest UpperCaseHeredoc ReusedNames PackageVars ConditionalDeclarations SingleCharAlternation FixedStringMatches ConditionalUseStatements QuotedWordLists
exclude = RequireFilenameMatchesPackage RequireVersionVar ProhibitExcessMainComplexity ProhibitStringySplit ComplexMappings StringyEval
diff --git a/checks/cruft b/checks/cruft
index fef5c10..7dd0ad0 100644
--- a/checks/cruft
+++ b/checks/cruft
@@ -203,9 +203,9 @@ for my $file (keys %ERRORS) {
my $tag = $ERRORS{$file};
my $path = $info->lab_data_path ($file);
if (-s $path) {
- open ERRORS, '<', $path or fail "cannot open $file: $!";
+ open(my $fd, '<', $path) or fail "cannot open $file: $!";
local $_;
- while (<ERRORS>) {
+ while (<$fd>) {
chomp;
s,^(?:[/\w]+/)?tar: ,,;
@@ -221,7 +221,7 @@ for my $file (keys %ERRORS) {
next if /^Exiting with failure status due to previous errors/;
tag $tag, $_;
}
- close ERRORS;
+ close($fd);
}
}
@@ -235,9 +235,9 @@ for my $file (keys %ERRORS) {
sub check_diffstat {
my ($diffstat, $warned) = @_;
my $saw_file;
- open(STAT, '<', $diffstat) or fail("cannot open $diffstat: $!");
+ open(my $fd, '<', $diffstat) or fail("cannot open $diffstat: $!");
local $_;
- while (<STAT>) {
+ while (<$fd>) {
my ($file) = (m,^\s+(.*?)\s+\|,)
or fail("syntax error in diffstat file: $_");
$saw_file = 1;
@@ -281,7 +281,7 @@ sub check_diffstat {
tag 'diff-contains-substvars', $file;
}
}
- close(STAT) or fail("error reading diffstat file: $!");
+ close($fd) or fail("error reading diffstat file: $!");
# If there was nothing in the diffstat output, there was nothing in the
# diff, which is probably a mistake.
@@ -405,8 +405,8 @@ sub find_cruft {
tag 'configure-generated-file-in-source', $name;
}
} elsif ($name =~ m,^(.+/)?config.(?:guess|sub)$, and not $atdinbd) {
- open F, '<', $basename or fail "can't open $name: $!";
- while (<F>) {
+ open(my $fd, '<', $basename) or fail "can't open $name: $!";
+ while (<$fd>) {
last if $. > 10; # it's on the 6th line, but be a bit more lenient
if (/^(?:timestamp|version)='((\d+)-(\d+).*)'$/) {
my ($date, $year, $month) = ($1, $2, $3);
@@ -421,12 +421,12 @@ sub find_cruft {
}
}
}
- close F;
+ close($fd);
} elsif ($name =~ m,^(.+/)?ltconfig$, and not $ltinbd) {
tag 'ancient-libtool', $name;
} elsif ($name =~ m,^(.+/)?ltmain\.sh$, and not $ltinbd) {
- open F, '<', $basename or fail "can't open $name: $!";
- while (<F>) {
+ open(my $fd, '<', $basename) or fail "can't open $name: $!";
+ while (<$fd>) {
if (/^VERSION=[\"\']?(1\.(\d)\.(\d+)(?:-(\d))?)/) {
my ($version, $major, $minor, $debian) = ($1, $2, $3, $4);
if ($major < 5 or ($major == 5 and $minor < 2)) {
@@ -440,7 +440,7 @@ sub find_cruft {
last;
}
}
- close F;
+ close($fd);
}
next if $info->is_non_free; # (license issue does not apply to non-free)
diff --git a/checks/debconf b/checks/debconf
index a2dd2aa..cd4a4a5 100644
--- a/checks/debconf
+++ b/checks/debconf
@@ -118,9 +118,9 @@ my $ctrl_config = $info->control('config');
my $ctrl_templates = $info->control('templates');
if ( -f $preinst and not -l $preinst) {
- open(PREINST, '<', $preinst)
+ open(my $fd, '<', $preinst)
or fail "open preinst: $!";
- while (<PREINST>) {
+ while (<$fd>) {
s/\#.*//; # Not perfect for Perl, but should be OK
if (m,/usr/share/debconf/confmodule, or
m/(?:Debconf|Debian::DebConf)::Client::ConfModule/) {
@@ -128,7 +128,7 @@ if ( -f $preinst and not -l $preinst) {
last;
}
}
- close PREINST;
+ close($fd);
}
$seenconfig=1 if -f $ctrl_config and not -l $ctrl_config;
@@ -367,20 +367,20 @@ for my $file (qw(config prerm postrm preinst postinst)) {
my $isdefault='';
my $usesseen='';
- open(IN, '<', $path)
+ open(my $fd, '<', $path)
or fail "open $file: $!";
# Only check scripts.
- my $fl = <IN>;
+ my $fl = <$fd>;
unless ($fl && $fl =~ /^\#!/) {
- close IN;
+ close($fd);
next;
}
- while (<IN>) {
+ while (<$fd>) {
s/#.*//; # Not perfect for Perl, but should be OK
next unless m/\S/;
while (s%\\$%%) {
- my $next = <IN>;
+ my $next = <$fd>;
last unless $next;
$_ .= $next;
}
@@ -459,7 +459,7 @@ for my $file (qw(config prerm postrm preinst postinst)) {
}
}
- close IN;
+ close($fd);
} elsif ($file eq 'postinst') {
tag 'postinst-does-not-load-confmodule'
unless ($type eq 'udeb' || !$seenconfig);
@@ -518,8 +518,8 @@ if ($usespreinst) {
return 0 if ($pkg eq 'debconf') || ($type eq 'udeb');
foreach my $filename (sort keys %{$info->scripts}) {
- open(IN, '<', $info->unpacked($filename)) or fail("cannot open $filename: $!");
- while (<IN>) {
+ open(my $fd, '<', $info->unpacked($filename)) or fail("cannot open $filename: $!");
+ while (<$fd>) {
s/#.*//; # Not perfect for Perl, but should be OK
if (m,/usr/share/debconf/confmodule, or
m/(?:Debconf|Debian::DebConf)::Client::ConfModule/) {
@@ -527,7 +527,7 @@ foreach my $filename (sort keys %{$info->scripts}) {
last;
}
}
- close IN;
+ close($fd);
}
} # </run>
diff --git a/checks/debhelper b/checks/debhelper
index 931adee..70eff97 100644
--- a/checks/debhelper
+++ b/checks/debhelper
@@ -90,10 +90,10 @@ if ( ! -f "$droot/rules" || !is_ancestor_of($droot, "$droot/rules")) {
return;
}
-open(RULES, '<', "$droot/rules") or fail("cannot read debian/rules: $!");
+open(my $rules_fd, '<', "$droot/rules") or fail("cannot read debian/rules: $!");
-while (<RULES>) {
- while (s,\\$,, and defined (my $cont = <RULES>)) {
+while (<$rules_fd>) {
+ while (s,\\$,, and defined (my $cont = <$rules_fd>)) {
$_ .= $cont;
}
if (/^ifn?(?:eq|def)\s/) {
@@ -219,7 +219,7 @@ while (<RULES>) {
$inclcdbs = 1;
}
}
-close RULES;
+close($rules_fd);
unless ($inclcdbs){
my $bdepends = $info->relation('build-depends-all');
@@ -306,16 +306,16 @@ for my $file (sort(readdir($dirfd))) {
# They need to have #DEBHELPER# in their scripts. Search for scripts
# that look like maintainer scripts and make sure the token is there.
my $binpkg = $1 || '';
- open(IN, '<', "$droot/$file")
+ open(my $fd, '<', "$droot/$file")
or fail("Can't open debfiles/$file: $!");
my $seentag = '';
- while (<IN>) {
+ while (<$fd>) {
if (m/\#DEBHELPER\#/) {
$seentag = 1;
last;
}
}
- close IN;
+ close($fd);
if (!$seentag) {
my $binpkg_type = $info->binary_package_type ($binpkg);
unless (($binpkg && defined $binpkg_type
@@ -370,10 +370,10 @@ for my $file (sort(readdir($dirfd))) {
# do not allow any form for wildcards.
next if $level < 3;
- open (IN, '<', "$droot/$file")
+ open(my $fd, '<', "$droot/$file")
or fail("Can't open debfiles/$file: $!");
local $_;
- while (<IN>) {
+ while (<$fd>) {
next if /^\s*$/;
next if (/^\#/ and $level >= 5);
if (m/(?<!\\)\{(?:[^\s\\\}]+?,)+[^\\\}\s]+\}/) {
@@ -382,7 +382,7 @@ for my $file (sort(readdir($dirfd))) {
last;
}
}
- close IN;
+ close($fd);
}
}
}
diff --git a/checks/debian-source-dir b/checks/debian-source-dir
index 7ece2ee..a8f4450 100644
--- a/checks/debian-source-dir
+++ b/checks/debian-source-dir
@@ -50,8 +50,8 @@ if ( ! -l "$dsrc/format" && -e "$dsrc/format") {
}
if ( ! -l "$dsrc/git-patches" && -s "$dsrc/git-patches") {
- open(GITPATCHES, '<', "$dsrc/git-patches");
- if (any { !/^\s*+#|^\s*+$/o} <GITPATCHES>) {
+ open(my $git_patches_fd, '<', "$dsrc/git-patches");
+ if (any { !/^\s*+#|^\s*+$/o} <$git_patches_fd>) {
my $dpseries = $info->debfiles('patches/series');
# gitpkg does not create series as a link, so this is most likely
# a traversal attempt.
@@ -59,16 +59,16 @@ if ( ! -l "$dsrc/git-patches" && -s "$dsrc/git-patches") {
if (! -r $dpseries ) {
tag 'git-patches-not-exported';
} else {
- open(DEBSERIES, '<', $dpseries);
- my $comment_line = <DEBSERIES>;
- my $count = grep { !/^\s*+\#|^\s*+$/o } <DEBSERIES>;
+ open(my $series_fd, '<', $dpseries);
+ my $comment_line = <$series_fd>;
+ my $count = grep { !/^\s*+\#|^\s*+$/o } <$series_fd>;
tag 'git-patches-not-exported'
unless ($count && ($comment_line =~ m/^\s*\#.*quilt-patches-deb-export-hook/o));
- close(DEBSERIES);
+ close($series_fd);
}
}
}
- close(GITPATCHES);
+ close($git_patches_fd);
}
if ( ! -l $dsrc && -d $dsrc ) {
diff --git a/checks/files b/checks/files
index 9c0f3dc..692314c 100644
--- a/checks/files
+++ b/checks/files
@@ -348,14 +348,15 @@ foreach my $file ($info->sorted_index) {
#----------------- /etc/php5/conf.d
elsif ($file =~ m,^etc/php5/conf.d/.+\.ini$,) {
if ($index_info->is_file) {
- open (PHPINI, '<', $info->unpacked($index_info)) or fail("cannot open .ini file: $!");
- while (<PHPINI>) {
+ open(my $fd, '<', $info->unpacked($index_info))
+ or fail("cannot open .ini file: $!");
+ while (<$fd>) {
next unless (m/^\s*#/);
tag 'obsolete-comments-style-in-php-ini', $file;
# only warn once per file:
last;
}
- close(PHPINI);
+ close($fd);
}
}
# ---------------- /etc/rc.d && /etc/rc?.d
@@ -796,13 +797,14 @@ foreach my $file ($info->sorted_index) {
{
my $dep = $info->relation('strong');
if ($index_info->is_file && $file =~ m,\.pm$, && !$dep->implies ('libperl4-corelibs-perl | perl (<< 5.12.3-7)')) {
- open (PM, '<', $info->unpacked($index_info)) or fail("cannot open .pm file: $!");
- while (<PM>) {
+ open(my $fd, '<', $info->unpacked($index_info))
+ or fail("cannot open .pm file: $!");
+ while (<$fd>) {
if (/(?:do|require)\s+(?:'|")(abbrev|assert|bigfloat|bigint|bigrat|cacheout|complete|ctime|dotsh|exceptions|fastcwd|find|finddepth|flush|getcwd|getopt|getopts|hostname|importenv|look|newgetopt|open2|open3|pwd|shellwords|stat|syslog|tainted|termcap|timelocal|validate)\.pl(?:'|")/) {
tag 'perl-module-uses-perl4-libs-without-dep', "$file:$. ${1}.pl";
}
}
- close(PM);
+ close($fd);
}
}
@@ -997,27 +999,29 @@ foreach my $file ($info->sorted_index) {
# ---------------- embedded Feedparser library
if ($file =~ m,/feedparser\.py$, and $pkg ne 'python-feedparser') {
- open(FEEDPARSER, '<', $info->unpacked($index_info)) or fail("cannot open feedparser.py file: $!");
- while (<FEEDPARSER>) {
+ open(my $fd, '<', $info->unpacked($index_info))
+ or fail("cannot open feedparser.py file: $!");
+ while (<$fd>) {
if (m,Universal feed parser,) {
tag 'embedded-feedparser-library', $file;
last;
}
}
- close(FEEDPARSER);
+ close($fd);
}
# ---------------- embedded PEAR modules
foreach my $pearmodule (@pearmodules) {
if ($file =~ m,/$pearmodule->[0], and $pkg ne $pearmodule->[1]) {
- open (PEAR, '<', $info->unpacked($index_info)) or fail("cannot open PHP file: $!");
- while (<PEAR>) {
+ open(my $fd, '<', $info->unpacked($index_info))
+ or fail("cannot open PHP file: $!");
+ while (<$fd>) {
if (m,/pear[/.],i) {
tag 'embedded-pear-module', $file;
last;
}
}
- close(PEAR);
+ close($fd);
}
}
diff --git a/checks/init.d b/checks/init.d
index bf91955..6d882fc 100644
--- a/checks/init.d
+++ b/checks/init.d
@@ -91,9 +91,9 @@ my $exclude_r = qr/if\s+\[\s+-x\s+\S*update-rc\.d/;
# read postinst control file
if ( -f $postinst and not -l $postinst) {
- open(IN, '<', $postinst)
+ open(my $fd, '<', $postinst)
or fail "open postinst: $!";
- while (<IN>) {
+ while (<$fd>) {
next if /$exclude_r/o;
s/\#.*$//o;
next unless /^(?:.+;|^\s*system[\s\(\']+)?\s*update-rc\.d\s+
@@ -108,14 +108,14 @@ if ( -f $postinst and not -l $postinst) {
tag 'output-of-updaterc.d-not-redirected-to-dev-null', "$name postinst";
}
}
- close(IN);
+ close($fd);
}
# read preinst control file
if ( -f $preinst and not -l $preinst) {
- open(IN, '<', $preinst)
+ open(my $fd, '<', $preinst)
or fail "open preinst: $!";
- while (<IN>) {
+ while (<$fd>) {
next if /$exclude_r/o;
s/\#.*$//o;
next unless m/update-rc\.d \s+
@@ -125,14 +125,14 @@ if ( -f $preinst and not -l $preinst) {
next if $opt eq 'remove';
tag 'preinst-calls-updaterc.d', $name;
}
- close(IN);
+ close($fd);
}
# read postrm control file
if ( -f $postrm and not -l $postrm) {
- open(IN, '<', $postrm)
+ open(my $fd, '<', $postrm)
or fail "open postrm: $!";
- while (<IN>) {
+ while (<$fd>) {
next if /$exclude_r/o;
s/\#.*$//o;
next unless m/update-rc\.d\s+($opts_r)*($INITD_NAME_REGEX)/o;
@@ -144,20 +144,20 @@ if ( -f $postrm and not -l $postrm) {
tag 'output-of-updaterc.d-not-redirected-to-dev-null', "$2 postrm";
}
}
- close(IN);
+ close($fd);
}
# read prerm control file
if ( -f $prerm and not -l $prerm) {
- open(IN, '<', $prerm)
+ open(my $fd, '<', $prerm)
or fail "open prerm: $!";
- while (<IN>) {
+ while (<$fd>) {
next if /$exclude_r/o;
s/\#.*$//o;
next unless m/update-rc\.d\s+($opts_r)*($INITD_NAME_REGEX)/o;
tag 'prerm-calls-updaterc.d', $2;
}
- close(IN);
+ close($fd);
}
# init.d scripts have to be removed in postrm
@@ -238,12 +238,12 @@ sub check_init {
return;
}
}
- open IN, '<', $initd_path
+ open(my $fd, '<', $initd_path)
or fail("cannot open init.d file $initd_file: $!");
my (%tag, %lsb);
my $in_file_test = 0;
my %needs_fs = ('remote' => 0, 'local' => 0);
- while (defined(my $l = <IN>)) {
+ while (defined(my $l = <$fd>)) {
if ($. == 1 && $l =~ m,^\#!\s*(/usr/[^\s]+),) {
tag 'init.d-script-uses-usr-interpreter', "etc/init.d/$initd_file $1";
}
@@ -257,7 +257,7 @@ sub check_init {
# We have an LSB keyword section. Parse it and save the data
# in %lsb for analysis.
- while (defined(my $l = <IN>)) {
+ while (defined(my $l = <$fd>)) {
if ($l =~ /^\#\#\# END INIT INFO/) {
$lsb{END} = 1;
last;
@@ -300,7 +300,7 @@ sub check_init {
$tag{$1} = 1;
}
}
- close(IN);
+ close($fd);
# Make sure all of the required keywords are present.
if (not $lsb{BEGIN}) {
diff --git a/checks/menu-format b/checks/menu-format
index 1f51982..9b2b055 100644
--- a/checks/menu-format
+++ b/checks/menu-format
@@ -255,11 +255,11 @@ foreach my $menufile (@menufiles) {
next if !is_ancestor_of($mdir, $menufile);
my $menufile_line ='';
- open (IN, '<', $menufile) or
+ open(my $fd, '<', $menufile) or
fail("cannot open menu file $menufile for reading.");
# line below is commented out in favour of the while loop
# do { $_=<IN>; } while defined && (m/^\s* \#/ || m/^\s*$/);
- while (<IN>) {
+ while (<$fd>) {
if (m/^\s*\#/ || m/^\s*$/) {
next;
} else {
@@ -271,11 +271,11 @@ 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;
- close IN;
+ close($fd);
next;
} elsif ($menufile_line =~ m/^!C\s*menu-2/o) {
# we can't parse that yet
- close IN;
+ close($fd);
next;
}
@@ -296,10 +296,10 @@ foreach my $menufile (@menufiles) {
verify_line($pkg, $info, $proc, $group, $type, $menufile, $fullname, $line, $lc);
$line='';
}
- } while ($menufile_line = <IN>);
+ } while ($menufile_line = <$fd>);
verify_line($pkg, $info, $proc, $group, $type, $menufile, $fullname, $line, $lc);
- close IN;
+ close($fd);
}
}
@@ -566,15 +566,15 @@ sub verify_icon {
return;
}
- open (IN, '<', $iconfile) or fail "open $iconfile: $!";
+ open(my $fd, '<', $iconfile) or fail "open $iconfile: $!";
my $parse = 'XPM header';
my $line;
- do { defined ($line = <IN>) or goto parse_error; }
+ do { defined ($line = <$fd>) or goto parse_error; }
until ($line =~ /\/\*\s*XPM\s*\*\//);
$parse = 'size line';
- do { defined ($line = <IN>) or goto parse_error; }
+ do { defined ($line = <$fd>) or goto parse_error; }
until ($line =~ /"\s*([0-9]+)\s*([0-9]+)\s*([0-9]+)\s*([0-9]+)\s*"/);
my $width = $1 + 0;
my $height = $2 + 0;
@@ -585,11 +585,11 @@ sub verify_icon {
tag 'menu-icon-too-big', "$icon: ${width}x${height} > ${size}x${size}";
}
- close IN or die;
+ close($fd) or die;
return;
parse_error:
- close IN or die;
+ close($fd) or die;
tag 'menu-icon-cannot-be-parsed', "$icon: looking for $parse";
return;
}
@@ -599,11 +599,11 @@ parse_error:
sub verify_desktop_file {
my ($desktopfile, $file, $pkg, $info) = @_;
my %vals;
- open (DESKTOP, '<', $info->unpacked($file))
+ open(my $fd, '<', $info->unpacked($file))
or fail("cannot open desktop file $file: $!");
my ($line, $saw_first, $warned_cr);
my @pending;
- while (defined ($line = <DESKTOP>)) {
+ while (defined ($line = <$fd>)) {
chomp $line;
next if ($line =~ m/^\s*\#/ or $line =~ m/^\s*$/);
if ($line =~ s/\r//) {
@@ -648,7 +648,7 @@ sub verify_desktop_file {
$vals{$tag} = $value;
}
}
- close DESKTOP;
+ close($fd);
# Now validate the data in the desktop file, but only if it's a known type.
return unless ($vals{'Type'} and $known_desktop_types{$vals{'Type'}});
diff --git a/checks/menus b/checks/menus
index 9ccd95a..7cbba10 100644
--- a/checks/menus
+++ b/checks/menus
@@ -119,16 +119,16 @@ for my $file ($info->sorted_index) {
$local_file =~ s,^etc/menu-methods/,,;
$menumethod_file = $file;
- open MM, '<', $info->lab_data_path ("menu/methods/$local_file")
+ open(my $fd, '<', $info->lab_data_path ("menu/methods/$local_file"))
or fail "cannot open menu-method file $local_file: $!";
- while (<MM>) {
+ while (<$fd>) {
chomp;
if (m,^!include menu.h,o) {
$menumethod_includes_menu_h = 1;
last;
}
}
- close MM;
+ close($fd);
tag 'menu-method-should-include-menu-h', $file
unless $menumethod_includes_menu_h or $pkg eq 'menu';
}
@@ -235,7 +235,7 @@ sub check_doc_base_file {
tag 'doc-base-file-uses-obsolete-national-encoding', "$dbfile:$line";
}
- open IN, '<', $dbpath
+ open(my $fd, '<', $dbpath)
or fail "cannot open doc-base file doc-base/$dbfile for reading";
my (@files, $field, @vals);
@@ -244,7 +244,7 @@ sub check_doc_base_file {
my %sawfields = (); # local for each section of control file
my %sawformats = (); # global for control file
- while (<IN>) {
+ while (<$fd>) {
chomp;
# New field. check previous field, if we have any.
@@ -307,7 +307,7 @@ sub check_doc_base_file {
# Make sure we saw at least one format.
tag 'doc-base-file-no-format-section', "$dbfile:$." unless %sawformats;
- close IN;
+ close($fd);
}
# Checks one field of a doc-base control file. $vals is array ref containing
@@ -574,9 +574,9 @@ sub check_script {
# control files are regular files and not symlinks, pipes etc.
return if -l $spath or not -f $spath;
- open(IN, '<', $spath) or
+ open(my $fd, '<', $spath) or
fail("cannot open maintainer script control/$script for reading: $!");
- $interp = <IN>;
+ $interp = <$fd>;
$interp = '' unless defined $interp;
if ($interp =~ m,^\#\!\s*/bin/$known_shells_regex,) {
$interp = 'sh';
@@ -595,7 +595,7 @@ sub check_script {
}
}
- while (<IN>) {
+ while (<$fd>) {
# skip comments
s/\#.*$//o;
@@ -645,7 +645,7 @@ sub check_script {
}
}
}
- close IN;
+ close($fd);
}
1;
diff --git a/checks/patch-systems b/checks/patch-systems
index 4b2c8d9..0cacd3f 100644
--- a/checks/patch-systems
+++ b/checks/patch-systems
@@ -62,34 +62,34 @@ sub run {
my $list_uses_cpp = 0;
if (-f "$dpdir/00options"
&& is_ancestor_of($droot, "$dpdir/00options")) {
- open(OPTS, '<', "$dpdir/00options")
+ open(my $fd, '<', "$dpdir/00options")
or fail "open 00options: $!";
- while(<OPTS>) {
+ while(<$fd>) {
if (/DPATCH_OPTION_CPP=1/) {
$list_uses_cpp = 1;
last;
}
}
- close(OPTS);
+ close($fd);
}
foreach my $listfile (glob("$dpdir/00list*")) {
my @patches;
if ( -f $listfile and is_ancestor_of($droot, $listfile)) {
- open(IN, '<', $listfile)
+ open(my $fd, '<', $listfile)
or fail "open $listfile: $!";
- while(<IN>) {
+ while(<$fd>) {
chomp;
next if (/^\#/); #ignore comments or CPP directive
s%//.*%% if $list_uses_cpp; # remove C++ style comments
if ($list_uses_cpp && m%/\*%) {
# remove C style comments
- $_ .= <IN> while($_ !~ m%\*/%);
+ $_ .= <$fd> while($_ !~ m%\*/%);
s%/\*[^*]*\*/%%g;
}
next if (/^\s*$/); #ignore blank lines
push @patches, split(' ', $_);
}
- close(IN);
+ close($fd);
}
# Check each patch.
@@ -103,16 +103,16 @@ sub run {
tag 'dpatch-index-references-non-existent-patch', $patch_file;
next;
}
- if (open(PATCH_FILE, '<', "$dpdir/$patch_file")) {
+ if (open(my $fd, '<', "$dpdir/$patch_file")) {
my $has_comment = 0;
- while (<PATCH_FILE>) {
+ while (<$fd>) {
#stop if something looking like a patch starts:
last if /^---/;
#note comment if we find a proper one
$has_comment = 1 if (/^\#+\s*DP:\s*(\S.*)$/ && $1 !~ /^no description\.?$/i);
$has_comment = 1 if (/^\# (?:Description|Subject)/);
}
- close(PATCH_FILE);
+ close($fd);
unless ($has_comment) {
tag 'dpatch-missing-description', $patch_file;
}
@@ -132,10 +132,10 @@ sub run {
} elsif (! -r "$dpdir/series") {
tag 'quilt-build-dep-but-no-series-file' unless $quilt_format;
} else {
- if (open(IN, '<', "$dpdir/series")) {
+ if (open(my $series_fd, '<', "$dpdir/series")) {
my @patches;
my @badopts;
- while (my $patch = <IN>) {
+ while (my $patch = <$series_fd>) {
strip ($patch); # Strip leading/trailing spaces
$patch =~ s/(?:^|\s+)#.*$//; # Strip comment
next unless $patch;
@@ -148,7 +148,7 @@ sub run {
}
push @patches, $patch;
}
- close(IN);
+ close($series_fd);
if (scalar(@badopts)) {
tag 'quilt-patch-with-non-standard-options', @badopts;
}
@@ -162,16 +162,16 @@ sub run {
tag 'quilt-series-references-non-existent-patch', $patch_file;
next;
}
- if (open(PATCH_FILE, '<', "$dpdir/$patch_file")) {
+ if (open(my $patch_fd, '<', "$dpdir/$patch_file")) {
my $has_description = 0;
- while (<PATCH_FILE>) {
+ while (<$patch_fd>) {
# stop if something looking like a patch starts:
last if /^---/;
next if /^\s*$/;
# Skip common "lead-in" lines
$has_description = 1 unless m{^(?:Index: |=+$|diff .+|index )};
}
- close(PATCH_FILE);
+ close($patch_fd);
unless ($has_description) {
tag 'quilt-patch-missing-description', $patch_file;
}
@@ -227,13 +227,13 @@ sub run {
tag 'more-than-one-patch-system';
}
my @direct;
- open(STAT, '<', $info->diffstat) or fail("cannot open diffstat file: $!");
- while (<STAT>) {
+ open(my $fd, '<', $info->diffstat) or fail("cannot open diffstat file: $!");
+ while (<$fd>) {
my ($file) = (m,^\s+(.*?)\s+\|,)
or fail("syntax error in diffstat file: $_");
push (@direct, $file) if ($file !~ m,^debian/,);
}
- close (STAT) or fail("error reading diffstat file: $!");
+ close($fd) or fail("error reading diffstat file: $!");
if (@direct) {
my $files = (@direct > 1) ? "$direct[0] and $#direct more" : $direct[0];
diff --git a/checks/po-debconf b/checks/po-debconf
index e8d13ba..057d100 100644
--- a/checks/po-debconf
+++ b/checks/po-debconf
@@ -45,18 +45,18 @@ for my $file (readdir($dirfd)) {
if ($file =~ m/^(.+\.)?templates(\..+)?$/) {
if ($file =~ m/templates\.\w\w(_\w\w)?$/) {
push (@lang_templates, $file);
- open(PO, '<', "$debfiles/$file")
+ open(my $fd, '<', "$debfiles/$file")
or fail("Can't open debfiles/$file file.");
- while (<PO>) {
+ while (<$fd>) {
tag 'untranslatable-debconf-templates', "$file: $."
if (m/^Description: (.+)/i and $1 !~/for internal use/);
}
- close PO;
+ close($fd);
} else {
- open(PO, '<', "$debfiles/$file")
+ open(my $fd, '<', "$debfiles/$file")
or fail("Can't open debfiles/$file file.");
my $in_template = 0;
- while (<PO>) {
+ while (<$fd>) {
tag 'translated-default-field', "$file: $."
if (m{^_Default(?:Choice)?: [^\[]*$});
tag 'untranslatable-debconf-templates', "$file: $."
@@ -74,7 +74,7 @@ for my $file (readdir($dirfd)) {
$in_template = 0;
}
}
- close PO;
+ close($fd);
}
}
}
@@ -103,9 +103,9 @@ for (@lang_templates) {
my $missing_files = 0;
if ( -f "$debfiles/po/POTFILES.in" and not -l "$debfiles/po/POTFILES.in") {
- open(POTFILES, '<', "$debfiles/po/POTFILES.in")
+ open(my $fd, '<', "$debfiles/po/POTFILES.in")
or fail("Can't open debfiles/po/POTFILES.in.");
- while (<POTFILES>) {
+ while (<$fd>) {
chomp;
next if /^\s*\#/;
s/.*\]\s*//;
@@ -116,7 +116,7 @@ if ( -f "$debfiles/po/POTFILES.in" and not -l "$debfiles/po/POTFILES.in") {
$missing_files = 1;
}
}
- close(POTFILES);
+ close($fd);
} else {
tag 'missing-potfiles-in';
$missing_files = 1;
@@ -143,15 +143,15 @@ while (defined(my $file=readdir($po_dirfd))) {
$_ = '';
# skip suspicious "files"
next if -l "$debfiles/po/$file" || ! -f "$debfiles/po/$file";
- open(PO, '<', "$debfiles/po/$file")
+ open(my $fd, '<', "$debfiles/po/$file")
or fail("Can't open debfiles/po/$file file.");
- while (<PO>) {
+ while (<$fd>) {
if (/Language\-Team:.*debian-i18n\@lists\.debian\.org/i) {
tag 'debconf-translation-using-general-list', $file;
}
last if m/^msgstr/m;
}
- close(PO);
+ close($fd);
unless ($_) {
tag 'invalid-po-file', "debian/po/$file";
next;
diff --git a/checks/scripts b/checks/scripts
index 5604f52..ecc1f24 100644
--- a/checks/scripts
+++ b/checks/scripts
@@ -349,13 +349,13 @@ for my $filename (sort keys %{$info->scripts}) {
# Check for obsolete perl libraries
if ($base eq 'perl' &&
!$str_deps->implies ('libperl4-corelibs-perl | perl (<< 5.12.3-7)')) {
- open(FH, '<', $path) or fail("could not open script $path");
- while (<FH>) {
+ open(my $fd, '<', $path) or fail("could not open script $path");
+ while (<$fd>) {
if (/(?:do|require)\s+(?:'|")(abbrev|assert|bigfloat|bigint|bigrat|cacheout|complete|ctime|dotsh|exceptions|fastcwd|find|finddepth|flush|getcwd|getopt|getopts|hostname|importenv|look|newgetopt|open2|open3|pwd|shellwords|stat|syslog|tainted|termcap|timelocal|validate)\.pl(?:'|")/) {
tag 'script-uses-perl4-libs-without-dep', "$filename:$. ${1}.pl";
}
}
- close(FH);
+ close($fd);
}
# If we found the interpreter and the script is executable, check
@@ -439,7 +439,7 @@ foreach (keys %executable) {
);
}
-open SCRIPTS, '<', $info->lab_data_path ('control-scripts')
+open(my $ctrl_fd, '<', $info->lab_data_path('control-scripts'))
or fail("cannot open lintian control-scripts file: $!");
# Handle control scripts. This is an edited version of the code for
@@ -449,7 +449,7 @@ open SCRIPTS, '<', $info->lab_data_path ('control-scripts')
my %added_diversions;
my %removed_diversions;
my $expand_diversions = 0;
-while (<SCRIPTS>) {
+while (<$ctrl_fd>) {
chop;
m/^(\S*) (.*)$/ or fail("bad line in control-scripts file: $_");
@@ -528,7 +528,7 @@ while (<SCRIPTS>) {
}
# now scan the file contents themselves
- open (C, '<', $filename)
+ open(my $fd, '<', $filename)
or fail("cannot open maintainer script $filename for reading: $!");
my %warned;
@@ -536,7 +536,7 @@ while (<SCRIPTS>) {
my $cat_string = '';
my $previous_line = '';
- while (<C>) {
+ while (<$fd>) {
if ($. == 1 && $shellscript && m,/$base\s*.*\s-\w*e\w*\b,) {
$saw_bange = 1;
}
@@ -895,10 +895,10 @@ while (<SCRIPTS>) {
}
}
- close C;
+ close($fd);
}
-close(SCRIPTS);
+close($ctrl_fd);
# If any of the maintainer scripts used a variable in the file or
# diversion name normalise them all
@@ -1015,12 +1015,12 @@ for my $divert (keys %added_diversions) {
sub script_is_evil_and_wrong {
my ($filename) = @_;
my $ret = 0;
- open (IN, '<', $filename) or fail("cannot open $filename: $!");
+ open(my $fd, '<', $filename) or fail("cannot open $filename: $!");
my $i = 0;
my $var = '0';
my $backgrounded = 0;
local $_;
- while (<IN>) {
+ while (<$fd>) {
chomp;
next if m/^#/o;
next if m/^$/o;
@@ -1071,7 +1071,7 @@ sub script_is_evil_and_wrong {
last;
}
}
- close IN;
+ close($fd);
return $ret;
}
diff --git a/checks/shared-libs b/checks/shared-libs
index 08076b5..8dafc1e 100644
--- a/checks/shared-libs
+++ b/checks/shared-libs
@@ -166,9 +166,9 @@ for my $cur_file ($info->sorted_index) {
tag 'sharedobject-in-library-directory-missing-soname', $cur_file;
} elsif ($cur_file =~ m/\.la$/ and not defined $cur_file_data->link) {
local $_;
- open(LAFILE, '<', $info->unpacked($cur_file_data))
+ open(my $fd, '<', $info->unpacked($cur_file_data))
or fail("Could not open $cur_file for reading!");
- while(<LAFILE>) {
+ while(<$fd>) {
next unless (m/^(libdir)='(.+?)'$/) or (m/^(dependency_libs)='(.+?)'$/);
my ($field, $value) = ($1, $2);
if ($field eq 'libdir') {
@@ -185,7 +185,7 @@ for my $cur_file ($info->sorted_index) {
tag 'non-empty-dependency_libs-in-la-file', $cur_file;
}
}
- close(LAFILE);
+ close($fd);
}
}
@@ -339,9 +339,9 @@ if (-l $shlibsf) {
} else {
my %shlibs_control_used;
my @shlibs_depends;
- open(SHLIBS, '<', $shlibsf)
+ open(my $fd, '<', $shlibsf)
or fail("cannot open control/shlibs for reading: $!");
- while (<SHLIBS>) {
+ while (<$fd>) {
chop;
next if m/^\s*$/ or /^#/;
@@ -360,7 +360,7 @@ if (-l $shlibsf) {
unless $udeb;
}
}
- close(SHLIBS);
+ close($fd);
my $shlib_name;
for my $shlib (@shlibs) {
$shlib_name = $SONAME{$shlib};
@@ -418,7 +418,7 @@ if (-l $symbolsf) {
unless is_nss_plugin ($shlib);
}
}
-} elsif (open(IN, '<', $symbolsf)) {
+} elsif (open(my $fd, '<', $symbolsf)) {
my $version_wo_rev = $version;
$version_wo_rev =~ s/^(.+)-([^-]+)$/$1/;
my ($full_version_count, $full_version_sym) = (0, undef);
@@ -431,7 +431,7 @@ if (-l $symbolsf) {
my $warned = 0;
my $symbol_count = 0;
- while (<IN>) {
+ while (<$fd>) {
chomp;
next if m/^\s*$/ or /^#/;
@@ -532,7 +532,7 @@ if (-l $symbolsf) {
tag 'syntax-error-in-symbols-file', $.;
}
}
- close IN;
+ close($fd);
if ($full_version_count) {
$full_version_count--;
my $others = '';
--
Debian package checker
Reply to: