[SCM] Debian package checker branch, master, updated. 2.5.11-206-g5150b93
The following commit has been merged in the master branch:
commit 5150b9386ec6af31f73f088906f330367972568f
Author: Niels Thykier <niels@thykier.net>
Date: Sat Mar 30 17:25:37 2013 +0100
Replace some bareword handles with regular variables
Signed-off-by: Niels Thykier <niels@thykier.net>
diff --git a/checks/changelog-file b/checks/changelog-file
index b03ef23..68cf61b 100644
--- a/checks/changelog-file
+++ b/checks/changelog-file
@@ -392,12 +392,12 @@ sub check_dch {
# pesky to replicate. Demanding a match of $prefix and $suffix ought to
# be enough to avoid false positives.
- open IN, '<', $path
+ open my $fd, '<', $path
or fail("cannot find changelog for $type package $pkg");
my ($prefix, $suffix);
my $lineno = 0;
my ($estart, $tstart) = (0, 0);
- while (<IN>) {
+ while (<$fd>) {
unless ($tstart) {
$lineno++;
@@ -422,7 +422,7 @@ sub check_dch {
tag 'debian-changelog-file-contains-obsolete-user-emacs-settings';
}
}
- close IN;
+ close $fd;
return $lineno;
}
diff --git a/checks/conffiles b/checks/conffiles
index 66d2a31..a9f0029 100644
--- a/checks/conffiles
+++ b/checks/conffiles
@@ -41,8 +41,8 @@ return if -l $cf;
if (-f $cf) {
- open(IN, '<', $cf) or fail("cannot open $cf for reading: $!");
- while (<IN>) {
+ open my $fd, '<', $cf or fail "cannot open $cf for reading: $!";
+ while (<$fd>) {
chop;
next if m/^\s*$/;
@@ -69,7 +69,7 @@ if (-f $cf) {
}
}
- close(IN);
+ close $fd;
}
diff --git a/checks/control-file b/checks/control-file
index cd00a6f..a39c789 100644
--- a/checks/control-file
+++ b/checks/control-file
@@ -54,9 +54,9 @@ if ($line) {
# Nag about dh_make Vcs comment only once
my $seen_vcs_comment = 0;
-open (CONTROL, '<', $dcontrol)
+open my $fd, '<', $dcontrol
or fail "Couldn't read debfiles/control: $!";
-while (<CONTROL>) {
+while (<$fd>) {
s/\s*\n$//;
if (m,^\# \s* Vcs-(?:Git|Browser): \s* (?:git|http)://git\.debian\.org/(?:\?p=)?collab-maint/<pkg>\.git,ox) {
@@ -85,7 +85,7 @@ while (<CONTROL>) {
}
}
}
-close CONTROL;
+close $fd;
eval {
# check we can parse it, but ignore the result - we will fetch
diff --git a/checks/deb-format b/checks/deb-format
index e5871b3..b86fc25 100644
--- a/checks/deb-format
+++ b/checks/deb-format
@@ -97,22 +97,21 @@ 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: $!";
- local $_;
- while (<ERRORS>) {
- chomp;
- s,^(?:[/\w]+/)?tar: ,,;
+ open my $fd, '<', $path or fail "cannot open $file: $!";
+ while ( my $line = <$fd> ) {
+ chomp ($line);
+ $line =~ s,^(?:[/\w]+/)?tar: ,,;
# Record size errors are harmless. Ignore implausibly old
# timestamps in the data section since we already check for that
# elsewhere, but still warn for control.
- next if /^Record size =/;
+ next if $line =~ /^Record size =/;
if ($tag eq 'tar-errors-from-data') {
- next if /implausibly old time stamp/;
+ next if $line =~ /implausibly old time stamp/;
}
- tag $tag, $_;
+ tag $tag, $line;
}
- close ERRORS;
+ close $fd;
}
}
diff --git a/collection/strings b/collection/strings
index 5f3e0b9..30795cb 100755
--- a/collection/strings
+++ b/collection/strings
@@ -49,7 +49,7 @@ if ( -d "$dir/strings" ) {
delete_dir ("$dir/strings") or fail "rmdir strings: $!";
}
-open ELF_INDEX, '>', "$dir/elf-index"
+open my $elf_fd, '>', "$dir/elf-index"
or fail "Could not open 'elf-index' for writing: $!";
# The directory is required, even if it would be empty.
@@ -70,7 +70,7 @@ my $open_strings_pipe = sub {
foreach my $bin ($info->sorted_index) {
my $finfo = $info->file_info ($bin);
next unless $finfo =~ m/\bELF\b/o;
- print ELF_INDEX "$bin\n";
+ print {$elf_fd} "$bin\n";
next if $bin =~ m,^usr/lib/debug/,;
if ($bin =~ m/[:\n\r]/) {
@@ -103,7 +103,7 @@ if (@manual) {
['strings', "$dir/unpacked/$file"], '|', ['gzip', '-9nc']);
}
}
-close(ELF_INDEX) or fail("cannot write elf-index file: $!");
+close $elf_fd or fail "cannot write elf-index file: $!";
}
diff --git a/collection/unpacked b/collection/unpacked
index 4a5d503..d0e7314 100755
--- a/collection/unpacked
+++ b/collection/unpacked
@@ -54,10 +54,7 @@ if ($type eq 'source') {
push @args, '--no-check' if $ENV{'LINTIAN_COLL_UNPACKED_SKIP_SIG'};
print "N: Using dpkg-source to unpack $pkg\n" if $ENV{'LINTIAN_DEBUG'};
unless (spawn ($opts, ['dpkg-source', @args, '-x', "$dir/dsc", "$dir/unpacked"])) {
- open ERRORS, '<', "$dir/unpacked-errors"
- or fail("cannot open unpacked-errors: $!");
- print STDERR while <ERRORS>;
- close ERRORS;
+ dump_errors ("$dir/unpacked-errors");
fail('dpkg-source -x failed with status ', $opts->{harness}->result);
}
} else {
@@ -81,10 +78,7 @@ if ($type eq 'source') {
['dpkg-deb', '--fsys-tarfile', "$dir/deb"],
'|', ['tar', 'xf', '-', '-C', "$dir/unpacked"]);
unless ($opts->{success}) {
- open ERRORS, '<', "$dir/unpacked-errors"
- or fail("cannot open unpacked-errors: $!");
- print STDERR while <ERRORS>;
- close ERRORS;
+ dump_errors ("$dir/unpacked-errors");
fail('dpkg-deb | tar failed with status ', $opts->{harness}->result);
}
@@ -95,6 +89,15 @@ if ($type eq 'source') {
}
+sub dump_errors {
+ my ($file) = @_;
+ open my $fd, '<', $file or fail "cannot open unpacked-errors: $!";
+ while (my $line = <$fd> ) {
+ print STDERR $line;
+ }
+ close $fd;
+}
+
sub libdpkg_unpack_dsc {
my ($dsc, $target) = @_;
my $opt = {
diff --git a/frontend/lintian b/frontend/lintian
index 0a79e5b..8a4fabe 100755
--- a/frontend/lintian
+++ b/frontend/lintian
@@ -707,9 +707,9 @@ unless ($no_conf) {
# read configuration file
if ($opt{'LINTIAN_CFG'}) {
- open(CFG, '<', $opt{'LINTIAN_CFG'})
+ open my $fd, '<', $opt{'LINTIAN_CFG'}
or die("cannot open configuration file $opt{'LINTIAN_CFG'} for reading: $!");
- while (<CFG>) {
+ while (<$fd>) {
chop;
s/\#.*$//go;
s/\"//go;
@@ -765,7 +765,7 @@ if ($opt{'LINTIAN_CFG'}) {
die "syntax error in configuration file: $_\n";
}
}
- close(CFG);
+ close $fd;
}
# check permitted values for --color / color
diff --git a/lib/Lintian/Collect/Binary.pm b/lib/Lintian/Collect/Binary.pm
index 5039a78..5524c04 100644
--- a/lib/Lintian/Collect/Binary.pm
+++ b/lib/Lintian/Collect/Binary.pm
@@ -300,13 +300,13 @@ sub scripts {
my $scrf = $self->lab_data_path ('scripts');
my %scripts;
local $_;
- open SCRIPTS, '<', $scrf
+ open my $fd, '<', $scrf
or fail "cannot open scripts $scrf: $!";
- while (<SCRIPTS>) {
- chomp;
+ while ( my $line = <$fd> ) {
my (%file, $name);
+ chomp ($line);
- m/^(env )?(\S*) (.*)$/o
+ $line =~ m/^(env )?(\S*) (.*)$/o
or fail("bad line in scripts file: $_");
($file{calls_env}, $file{interpreter}, $name) = ($1, $2, $3);
@@ -315,7 +315,7 @@ sub scripts {
$file{name} = $name;
$scripts{$name} = \%file;
}
- close SCRIPTS;
+ close $fd;
$self->{scripts} = \%scripts;
return $self->{scripts};
diff --git a/lib/Lintian/Util.pm b/lib/Lintian/Util.pm
index 8dd9a14..df7c093 100644
--- a/lib/Lintian/Util.pm
+++ b/lib/Lintian/Util.pm
@@ -700,15 +700,15 @@ This sub is a convenience wrapper around Digest::{MD5,SHA}.
sub get_file_checksum {
my ($alg, $file) = @_;
- open (FILE, '<', $file) or fail("Couldn't open $file");
+ open my $fd, '<', $file or fail("Couldn't open $file");
my $digest;
if ($alg eq 'md5') {
$digest = Digest::MD5->new;
} elsif ($alg =~ /sha(\d+)/) {
$digest = Digest::SHA->new($1);
}
- $digest->addfile(*FILE);
- close FILE or fail("Couldn't close $file");
+ $digest->addfile($fd);
+ close $fd or fail("Couldn't close $file");
return $digest->hexdigest;
}
@@ -722,10 +722,10 @@ sub file_is_encoded_in_non_utf8 {
my ($file, $type, $pkg) = @_;
my $non_utf8 = 0;
- open (ICONV, '<', $file)
+ open my $fd, '<', $file
or fail("failure while checking encoding of $file for $type package $pkg");
my $line = 0;
- while (<ICONV>) {
+ while (<$fd>) {
if (m,\e[-!"\$%()*+./],) {
# ISO-2022
$line = $.;
@@ -739,7 +739,7 @@ sub file_is_encoded_in_non_utf8 {
last;
}
}
- close ICONV;
+ close $fd;
return $line;
}
--
Debian package checker
Reply to: