[SCM] Debian package checker branch, master, updated. 2.5.12-60-gea11dc5
The following commit has been merged in the master branch:
commit ea11dc51fcf61c1dcd22f20af1dc4011f91d4328
Author: Niels Thykier <niels@thykier.net>
Date: Tue Apr 30 18:39:40 2013 +0200
coll/*: Use autodie and check calls to touch_file
Signed-off-by: Niels Thykier <niels@thykier.net>
diff --git a/collection/ar-info b/collection/ar-info
index 7cc00dd..a004d38 100755
--- a/collection/ar-info
+++ b/collection/ar-info
@@ -29,7 +29,6 @@ use lib "$ENV{LINTIAN_ROOT}/lib";
use FileHandle;
use Lintian::Collect;
use Lintian::Command qw(spawn);
-use Lintian::Util qw(fail);
sub collect {
my ($pkg, $type, $dir) = @_;
diff --git a/collection/bin-pkg-control b/collection/bin-pkg-control
index 97e9c50..9bd096c 100755
--- a/collection/bin-pkg-control
+++ b/collection/bin-pkg-control
@@ -23,6 +23,7 @@ package Lintian::coll::bin_pkg_control;
use strict;
use warnings;
+use autodie;
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Lintian::Command qw(spawn reap);
@@ -35,12 +36,10 @@ my (@jobs, $job);
if ( -e "$dir/control"){
delete_dir ("$dir/control") or fail 'Cannot remove old control dir';
}
-unlink "$dir/control-index" or fail "control-index: $!"
- if -e "$dir/control-index";
-unlink "$dir/control-index.gz" or fail "control-index.gz: $!"
- if -e "$dir/control-index.gz";
+unlink("$dir/control-index") if -e "$dir/control-index";
+unlink("$dir/control-index.gz") if -e "$dir/control-index.gz";
-mkdir ("$dir/control", 0777) or fail "mkdir control: $!";
+mkdir("$dir/control", 0777);
# The following calls use knowledge of the .deb format for speed
@@ -70,7 +69,7 @@ spawn($job,
reap(@jobs);
undef @jobs;
# clean up control.tar
-unlink "$dir/control.tar" or fail "unlink control.tar: $!";
+unlink("$dir/control.tar");
# fix permissions
spawn({ fail => 'error' },
diff --git a/collection/copyright-file b/collection/copyright-file
index a3e3dba..243f279 100755
--- a/collection/copyright-file
+++ b/collection/copyright-file
@@ -23,6 +23,7 @@ package Lintian::coll::copyright_file;
use strict;
use warnings;
+use autodie;
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Lintian::Util qw(fail gunzip_file is_ancestor_of touch_file);
@@ -33,14 +34,15 @@ sub collect {
my ($pkg, $type, $dir) = @_;
if ( -e "$dir/copyright" ) {
- unlink "$dir/copyright" or fail "unlink copyright: $!";
+ unlink("$dir/copyright");
}
if (-d "$dir/unpacked/usr/share/doc/$pkg"
&& !is_ancestor_of("$dir/unpacked", "$dir/unpacked/usr/share/doc/$pkg")) {
# if the parent dir is outside the package, just stop here before we
# do something we will regret.
- touch_file("$dir/copyright");
+ touch_file("$dir/copyright")
+ or fail "touch $dir/copyright failed: $!";
return;
}
@@ -50,20 +52,21 @@ my $file = "$dir/unpacked/usr/share/doc/$pkg/copyright";
# to the symlink may leave a relative symlink into a directory we can't
# unpack. Be careful about what symlinks we allow, though.
if (-l $file) {
- my $link = readlink($file) or fail("cannot readlink $file: $!");
+ my $link = readlink($file);
if ($link =~ /\.\./ || ($link =~ m%/% && $link !~ m%^[^/]+(?:/+[^/]+)*\z%)) {
- touch_file "$dir/copyright";
+ touch_file("$dir/copyright")
+ or fail "touch $dir/copyright: $!";
} else {
copy ($file, "$dir/copyright") or fail "cannot copy $file: $!";
}
} elsif (-f $file) {
- link ($file, "$dir/copyright")
- or fail("cannot link $file to copyright: $!");
+ link($file, "$dir/copyright");
} elsif (-f "$file.gz") {
gunzip_file ("$file.gz", "$dir/copyright");
} else {
# no copyright file found
- touch_file ("$dir/copyright");
+ touch_file("$dir/copyright")
+ or fail "touch $dir/copyright failed: $!";
}
}
diff --git a/collection/debian-readme b/collection/debian-readme
index e9073f4..6acd95f 100755
--- a/collection/debian-readme
+++ b/collection/debian-readme
@@ -23,6 +23,7 @@ package Lintian::coll::debian_readme;
use strict;
use warnings;
+use autodie;
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Lintian::Util qw(fail gunzip_file touch_file is_ancestor_of);
@@ -31,7 +32,7 @@ sub collect {
my ($pkg, $type, $dir) = @_;
if ( -f "$dir/README.Debian") {
- unlink "$dir/README.Debian" or fail "Could not remove old README.Debian: $!";
+ unlink("$dir/README.Debian");
}
# Pick the first of these files that exists.
@@ -44,7 +45,8 @@ my @readmes = ("$dir/unpacked/usr/share/doc/$pkg/README.Debian.gz",
if (-d "$dir/unpacked/usr/share/doc/$pkg"
&& !is_ancestor_of("$dir/unpacked", "$dir/unpacked/usr/share/doc/$pkg")) {
# Unsafe path, stop here
- touch_file("$dir/README.Debian");
+ touch_file("$dir/README.Debian")
+ or fail "touch $dir/README.debian failed: $!";
return;
}
@@ -58,12 +60,12 @@ for (@readmes) {
if (not defined $file) {
# no README found
- touch_file ("$dir/README.Debian");
+ touch_file("$dir/README.Debian")
+ or fail "touch $dir/README.debian failed: $!";
} elsif ($file =~ m/\.gz$/) {
gunzip_file ($file, "$dir/README.Debian");
} else {
- link ($file, "$dir/README.Debian")
- or fail("cannot link $file to README.Debian: $!");
+ link($file, "$dir/README.Debian");
}
}
diff --git a/collection/diffstat b/collection/diffstat
index 910e557..f13a38f 100755
--- a/collection/diffstat
+++ b/collection/diffstat
@@ -44,7 +44,7 @@ my $ver;
$data = get_dsc_info ("$dir/dsc");
$ver = $data->{'version'};
-unlink "$dir/debian-patch" or fail "cannot unlink debian-patch: $!"
+unlink("$dir/debian-patch")
if -e "$dir/debian-patch" or -l "$dir/debian-patch";
$ver =~ s/^\d://; #Remove epoch for this
diff --git a/collection/doc-base-files b/collection/doc-base-files
index 6c7e250..96e2494 100755
--- a/collection/doc-base-files
+++ b/collection/doc-base-files
@@ -24,6 +24,7 @@ package Lintian::coll::doc_base_files;
use strict;
use warnings;
+use autodie;
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Lintian::Util qw(copy_dir delete_dir fail is_ancestor_of);
@@ -39,14 +40,14 @@ if ( -e "$dir/doc-base") {
if ( -d "$dir/unpacked/usr/share/doc-base") {
if (!is_ancestor_of("$dir/unpacked", "$dir/unpacked/usr/share/doc-base")) {
# Unsafe
- mkdir ("$dir/doc-base", 0777) or fail "cannot mkdir doc-base: $!";
+ mkdir("$dir/doc-base", 0777);
return;
}
copy_dir ("$dir/unpacked/usr/share/doc-base", "$dir/doc-base")
or fail('cannot copy directory unpacked/usr/share/doc-base');
} else {
# no doc-base directory
- mkdir ("$dir/doc-base", 0777) or fail "cannot mkdir doc-base: $!";
+ mkdir("$dir/doc-base", 0777);
}
}
diff --git a/collection/file-info b/collection/file-info
index 536c6c2..31e3558 100755
--- a/collection/file-info
+++ b/collection/file-info
@@ -23,13 +23,13 @@ package Lintian::coll::file_info;
use strict;
use warnings;
+use autodie;
use Cwd qw(realpath);
use FileHandle;
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Lintian::Collect;
use Lintian::Command qw(spawn reap);
-use Lintian::Util qw(fail);
my $helper = realpath (__FILE__ . '-helper');
@@ -40,15 +40,14 @@ my $info = Lintian::Collect->new ($pkg, $type, $dir);
my $outfile = "$dir/file-info.gz";
if ( -e "$dir/file-info" ) {
- unlink ("$dir/file-info") or fail "unlink file-info: $!";
+ unlink("$dir/file-info");
}
if ( -e $outfile ) {
- unlink ($outfile) or fail "unlink file-info.gz: $!";
+ unlink($outfile);
}
-chdir ("$dir/unpacked")
- or fail("cannot chdir to unpacked directory: $!");
+chdir("$dir/unpacked");
# We ignore failures from file because sometimes file returns a non-zero exit
# status when it can't parse a file. So far, the resulting output still
@@ -64,7 +63,7 @@ foreach my $file ($info->sorted_index) {
printf {$opts{pipe_in}} "%s\0", $file;
}
-close $opts{pipe_in};
+close($opts{pipe_in});
reap(\%opts);
}
diff --git a/collection/file-info-helper b/collection/file-info-helper
index fdc005c..528ce05 100755
--- a/collection/file-info-helper
+++ b/collection/file-info-helper
@@ -2,6 +2,7 @@
use strict;
use warnings;
+use autodie;
while ( my $line = <> ) {
my ($file, $type) = $line =~ (m/^(.*?)\x00(.*)$/o);
@@ -9,25 +10,24 @@ while ( my $line = <> ) {
# While file could be right, it is unfortunately
# regularly wrong here as well; double check the type
my $text = '';
- if (open(my $gzf, '<', $file)) {
- my $buff;
- # We need to read at least 9 bytes
- if (sysread($gzf, $buff, 1024) >= 9) {
- # translation of the unpack
- # nn nn , NN NN NN NN, nn nn, cc - bytes read (in hex, network order)
- # $magic, __ __ __ __, __ __, $comp - variables
- my ($magic, undef, undef, $comp) = unpack('nNnc', $buff);
- if ($magic == 0x1f8b){ # the gzip file magic
- $text = 'gzip compressed data';
- # 2 for max compression; RFC1952 suggests this is a flag and not a value,
- # hench the bit and operation
- if (($comp & 2) == 2){
- $text = "$text, max compression";
- }
+ my $buff;
+ open(my $gzf, '<', $file);
+ # We need to read at least 9 bytes
+ if (sysread($gzf, $buff, 1024) >= 9) {
+ # translation of the unpack
+ # nn nn , NN NN NN NN, nn nn, cc - bytes read (in hex, network order)
+ # $magic, __ __ __ __, __ __, $comp - variables
+ my ($magic, undef, undef, $comp) = unpack('nNnc', $buff);
+ if ($magic == 0x1f8b){ # the gzip file magic
+ $text = 'gzip compressed data';
+ # 2 for max compression; RFC1952 suggests this is a flag and not a value,
+ # hench the bit and operation
+ if (($comp & 2) == 2){
+ $text = "$text, max compression";
}
}
- close($gzf);
}
+ close($gzf);
$type = "$type, $text" if $text;
}
printf "%s%c%s\n", $file , 0, $type;
diff --git a/collection/hardening-info b/collection/hardening-info
index d40c825..bca0b0b 100755
--- a/collection/hardening-info
+++ b/collection/hardening-info
@@ -30,6 +30,7 @@ package Lintian::coll::hardening_info;
use strict;
use warnings;
+use autodie;
use Cwd qw(realpath);
use FileHandle;
@@ -46,12 +47,11 @@ my ($pkg, $type, $dir) = @_;
my $info = Lintian::Collect->new ($pkg, $type, $dir);
if ( -e "$dir/hardening-info" ) {
- unlink "$dir/hardening-info" or fail "unlink hardening-info: $!";
+ unlink("$dir/hardening-info");
}
# Prepare to examine the file tree.
-chdir ("$dir/unpacked")
- or fail("unable to chdir to unpacked: $!");
+chdir("$dir/unpacked");
my %opts;
my $open_hardening_info = sub {
@@ -78,10 +78,11 @@ foreach my $bin ($info->sorted_index) {
}
if (%opts) {
- close $opts{pipe_in};
+ close($opts{pipe_in});
reap (\%opts);
} else {
- touch_file ("$dir/hardening-info");
+ touch_file("$dir/hardening-info")
+ or fail "touch $dir/hardening_info failed: $!";
}
}
diff --git a/collection/hardening-info-helper b/collection/hardening-info-helper
index 756a6c7..5671041 100755
--- a/collection/hardening-info-helper
+++ b/collection/hardening-info-helper
@@ -21,12 +21,12 @@
use strict;
use warnings;
+use autodie;
use FileHandle;
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Lintian::Command qw(spawn reap);
-use Lintian::Util qw(fail);
# To reduce the number of false-positives in hardening-check for
# fortify-functions, we have to "double-check" its output in some
@@ -59,17 +59,16 @@ my %whitelisted_funcs = (
'memmove' => 1,
);
-pipe ($cread, $cwrite) or fail "pipe failed: $!";
+pipe($cread, $cwrite);
$cpid = fork();
-fail "fork failed: $!" unless defined $cpid;
if ($cpid) {
# parent
- close $cread; # read end not needed
+ close($cread); # read end not needed
$in = \*STDIN;
$out = $cwrite;
} else {
# child
- close $cwrite; # write end not needed.
+ close($cwrite); # write end not needed.
$in = $cread;
$out = \*STDOUT;
}
@@ -86,7 +85,7 @@ while (my $line = <$in>) {
# End of "first pass" marker (for the child).
last if $line eq '__VERBOSE__';
}
- print $out "$line\n";
+ print {$out} "$line\n";
}
@@ -100,7 +99,7 @@ if (not $cpid) {
# At this point we are reading "verbose" hardening-check output
if ($line =~ m,^(\S.+):$,) {
if ($emit) {
- print $out "no-fortify-functions:$bin\n";
+ print {$out} "no-fortify-functions:$bin\n";
}
$bin = $1;
$infsf = 0;
@@ -116,10 +115,10 @@ if (not $cpid) {
}
}
if ($emit) {
- print $out "no-fortify-functions:$bin\n";
+ print {$out} "no-fortify-functions:$bin\n";
}
# ensure $out is flushed before exiting.
- close $out or fail "close output: $!";
+ close($out);
require POSIX;
POSIX::_exit (0);
} elsif (@recheck) {
@@ -130,19 +129,19 @@ if (not $cpid) {
fail => 'never'
);
# End the first pass for the child
- print $out "__VERBOSE__\n";
+ print {$out} "__VERBOSE__\n";
spawn(\%opts, ['xargs', '-0r', 'hardening-check', '--verbose', '--']);
$opts{pipe_in}->blocking (1);
foreach my $file (@recheck) {
printf {$opts{pipe_in}} "%s\0", $file;
}
- close $opts{pipe_in};
+ close($opts{pipe_in});
reap (\%opts);
}
# Close the out handle, else the child process will wait for
# ever.
-close $out;
+close($out);
# wait for the child process.
wait();
exit $?;
diff --git a/collection/index b/collection/index
index 7934afa..7973957 100755
--- a/collection/index
+++ b/collection/index
@@ -27,29 +27,26 @@ package Lintian::coll::index;
use strict;
use warnings;
+use autodie;
# import perl libraries
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Cwd();
use Lintian::Command qw(spawn reap);
use Lintian::Processable::Package;
-use Lintian::Util qw(fail get_dsc_info);
+use Lintian::Util qw(get_dsc_info);
sub collect {
my ($pkg, $type, $dir) = @_;
-unlink "$dir/index" or fail "Could not unlink index: $!"
- if -e "$dir/index";
-unlink "$dir/index.gz" or fail "Could not unlink index.gz: $!"
- if -e "$dir/index.gz";
-unlink "$dir/index-errors" or fail "Could not unlink index-errors: $!"
- if -e "$dir/index-errors";
+for my $file (qw(index index.gz index-errors)) {
+ unlink("$dir/$file") if -e "$dir/$file";
+}
if ($type ne 'source') {
index_deb ($dir);
} else {
- chdir "$dir/unpacked"
- or fail "chdir $dir/unpacked: $!";
+ chdir("$dir/unpacked");
spawn ({ fail => 'error', out => "$dir/index.gz" },
['find', '(', '-type', 'l',
# If symlink
@@ -70,9 +67,7 @@ sub index_deb {
my ($dir) = @_;
my (@jobs, $job);
- foreach my $file (qw(index index-errors index-owner-id)) {
- unlink "$dir/$file" or fail "$file: $!" if -f "$dir/$file";
- }
+ unlink("$dir/index-owner-id") if -f "$dir/index-owner-id";
$job = { fail => 'error',
out => "$dir/index.gz",
diff --git a/collection/init.d b/collection/init.d
index 5ce22d6..fd4fe12 100755
--- a/collection/init.d
+++ b/collection/init.d
@@ -23,6 +23,7 @@ package Lintian::coll::init_d;
use strict;
use warnings;
+use autodie;
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Lintian::Util qw(copy_dir delete_dir fail is_ancestor_of);
@@ -38,7 +39,7 @@ if (-e "$dir/init.d") {
if (-d "$dir/unpacked/etc/init.d") {
if (!is_ancestor_of("$dir/unpacked", "$dir/unpacked/etc/init.d")) {
# Unsafe, stop
- mkdir ("$dir/init.d", 0777) or fail "cannot mkdir init.d: $!";
+ mkdir("$dir/init.d", 0777);
return;
}
@@ -46,7 +47,7 @@ if (-d "$dir/unpacked/etc/init.d") {
or fail('cannot copy init.d directory');
} else {
# no etc/init.d
- mkdir ("$dir/init.d", 0777) or fail "cannot mkdir init.d: $!";
+ mkdir("$dir/init.d", 0777);
}
}
diff --git a/collection/java-info b/collection/java-info
index c1bd1d6..26d8604 100755
--- a/collection/java-info
+++ b/collection/java-info
@@ -23,6 +23,7 @@ package Lintian::coll::java_info;
use strict;
use warnings;
+use autodie;
use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
use FileHandle;
@@ -42,10 +43,10 @@ unless ( -d "$dir/unpacked/") {
}
if ( -f "$dir/java-info" ) {
- unlink "$dir/java-info" or fail "unlink $dir/java-info: $!";
+ unlink("$dir/java-info");
}
if ( -f "$dir/java-info.gz" ) {
- unlink "$dir/java-info.gz" or fail "unlink $dir/java-info.gz: $!";
+ unlink("$dir/java-info.gz");
}
# We lazily start the gzip process to avoid creating the java-info.gz
@@ -65,8 +66,7 @@ my $errorhandler = sub {
print {$opts{pipe_in}} "-- ERROR: $err\n";
};
-chdir ("$dir/unpacked")
- or fail "unable to chdir to unpacked: $!";
+chdir("$dir/unpacked");
# Without this Archive::Zip will emit errors to standard error for
# faulty zip files - but that is not what we want. AFAICT, it is
@@ -137,7 +137,7 @@ foreach my $file ($info->sorted_index) {
Archive::Zip::setErrorHandler ($oldhandler);
if (%opts) {
- close $opts{pipe_in} or fail "cannot write java-info.gz: $!";
+ close($opts{pipe_in});
reap (\%opts);
}
diff --git a/collection/md5sums b/collection/md5sums
index 252baf4..6ab581a 100755
--- a/collection/md5sums
+++ b/collection/md5sums
@@ -23,23 +23,22 @@ package Lintian::coll::md5sums;
use strict;
use warnings;
+use autodie;
use FileHandle;
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Lintian::Collect;
use Lintian::Command qw(spawn reap);
-use Lintian::Util qw(fail);
sub collect {
my ($pkg, $type, $dir) = @_;
my $info = Lintian::Collect->new ($pkg, $type, $dir);
if ( -e "$dir/md5sums" ) {
- unlink "$dir/md5sums" or fail "unlink md5sums: $!";
+ unlink("$dir/md5sums");
}
-chdir ("$dir/unpacked")
- or fail("cannot chdir to unpacked directory: $!");
+chdir("$dir/unpacked");
my %opts = ( pipe_in => FileHandle->new,
out => "$dir/md5sums",
@@ -52,7 +51,7 @@ foreach my $file ($info->sorted_index) {
printf {$opts{pipe_in}} "%s\0", $file;
}
-close $opts{pipe_in};
+close($opts{pipe_in});
reap(\%opts);
}
diff --git a/collection/menu-files b/collection/menu-files
index 734b26d..501af99 100755
--- a/collection/menu-files
+++ b/collection/menu-files
@@ -23,6 +23,7 @@ package Lintian::coll::menu_files;
use strict;
use warnings;
+use autodie;
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Lintian::Util qw(copy_dir delete_dir fail is_ancestor_of);
@@ -35,7 +36,7 @@ if ( -e "$dir/menu") {
or fail('cannot rm old menu directory');
}
-mkdir ("$dir/menu", 0777) or fail ("cannot mkdir menu: $!");
+mkdir("$dir/menu", 0777);
my %dirs;
$dirs{'share'} = 'usr/share/menu';
@@ -46,14 +47,14 @@ while (my ($shortn, $path) = each %dirs) {
if (-d "$dir/unpacked/$path") {
if (!is_ancestor_of("$dir/unpacked", "$dir/unpacked/$path")) {
# Unsafe, skip
- mkdir ("$dir/menu/$shortn", 0777) or fail ("cannot mkdir menu/$shortn: $!");
+ mkdir("$dir/menu/$shortn", 0777);
next;
}
copy_dir ("$dir/unpacked/$path", "$dir/menu/$shortn")
or fail("cannot copy unpacked/$path/ directory");
} else {
# no menu directory
- mkdir ("$dir/menu/$shortn", 0777) or fail ("cannot mkdir menu/$shortn: $!");
+ mkdir("$dir/menu/$shortn", 0777);
}
}
diff --git a/collection/objdump-info b/collection/objdump-info
index 617f7f4..2c68db0 100755
--- a/collection/objdump-info
+++ b/collection/objdump-info
@@ -27,6 +27,7 @@ package Lintian::coll::objdump_info;
use strict;
use warnings;
+use autodie;
use Cwd qw(realpath);
use FileHandle;
@@ -34,7 +35,6 @@ use FileHandle;
use lib "$ENV{'LINTIAN_ROOT'}/lib/";
use Lintian::Collect;
use Lintian::Command qw(spawn reap);
-use Lintian::Util qw(fail);
my $helper = realpath (__FILE__ . '-helper');
@@ -43,15 +43,14 @@ my ($pkg, $type, $dir) = @_;
my $info = Lintian::Collect->new ($pkg, $type, $dir);
if ( -e "$dir/objdump-info" ) {
- unlink "$dir/objdump-info" or fail "unlink objdump-info: $!"
+ unlink("$dir/objdump-info");
}
if ( -e "$dir/objdump-info.gz" ) {
- unlink "$dir/objdump-info.gz" or fail "unlink objdump-info.gz: $!"
+ unlink("$dir/objdump-info.gz");
}
-chdir ("$dir/unpacked")
- or fail ("unable to chdir to unpacked: $!\n");
+chdir("$dir/unpacked");
my %opts = ( pipe_in => FileHandle->new,
out => "$dir/objdump-info.gz",
@@ -67,7 +66,7 @@ foreach my $bin ($info->sorted_index) {
}
}
-close $opts{pipe_in} or fail "cannot write objdump-info.gz: $!";
+close($opts{pipe_in});
reap(\%opts);
};
diff --git a/collection/objdump-info-helper b/collection/objdump-info-helper
index 6f022f0..51ec04b 100755
--- a/collection/objdump-info-helper
+++ b/collection/objdump-info-helper
@@ -28,6 +28,7 @@
use strict;
use warnings;
+use autodie;
my @sections;
my @symbol_versions;
@@ -40,14 +41,11 @@ my $bin;
# it would have been nice to do open '-|', "readelf ... 2>&1" but
# then we have to escape the args and that puts us over the
# argument limit in some cases...
-my $pid = open my $readelf, '-|';
+my $pid = open(my $readelf, '-|');
-if (not defined $pid) {
- die "fork: $!";
-}
if (not $pid) {
# child - re-direct standerr and exec
- open STDERR, '>&', STDOUT or die "redirect STDERR: $!";
+ open(STDERR, '>&', \*STDOUT);
exec 'readelf', '-WltdVs', @ARGV;
}
@@ -179,7 +177,7 @@ while ( my $line = <$readelf> ) {
# Finish the last file
finish_file ();
-close $readelf;
+close($readelf);
exit 0;
diff --git a/collection/override-file b/collection/override-file
index 689f28c..2e8b7a3 100755
--- a/collection/override-file
+++ b/collection/override-file
@@ -24,6 +24,7 @@ package Lintian::coll::override_file;
use strict;
use warnings;
+use autodie;
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Lintian::Util qw(fail gunzip_file is_ancestor_of);
@@ -34,7 +35,7 @@ my ($pkg, $type, $dir) = @_;
-d "$dir/unpacked" or fail 'override-file invoked with wrong dir argument';
if ( -e "$dir/override"){
- unlink "$dir/override" or fail "could not remove old override file: $!";
+ unlink("$dir/override");
}
# Pick the first of these files that exists. Prefer source/lintian-overrides
@@ -64,8 +65,7 @@ if (not defined $file) {
} elsif ($file =~ /\.gz$/) {
gunzip_file ($file, "$dir/override");
} else {
- link ($file, "$dir/override")
- or fail("cannot link $file to override: $!");
+ link($file, "$dir/override");
}
}
diff --git a/collection/src-orig-index b/collection/src-orig-index
index bbfa652..63f9e58 100755
--- a/collection/src-orig-index
+++ b/collection/src-orig-index
@@ -23,6 +23,7 @@ package Lintian::coll::src_orig_index;
use strict;
use warnings;
+use autodie;
# import perl libraries
use lib "$ENV{'LINTIAN_ROOT'}/lib";
@@ -37,15 +38,13 @@ my ($pkg, $type, $dir) = @_;
my $info = Lintian::Collect->new ($pkg, $type, $dir);
if ( -f "$dir/orig-index.gz" ) {
- unlink "$dir/orig-index.gz"
- or fail "unlink orig-index.gz for $pkg failed: $!"
+ unlink("$dir/orig-index.gz");
}
# Nothing to do for native packages where the two indices are
# identical.
if ($info->native) {
- link "$dir/index.gz", "$dir/orig-index.gz"
- or fail "link index.gz orig-index.gz: $!";
+ link("$dir/index.gz", "$dir/orig-index.gz");
return;
}
diff --git a/collection/strings b/collection/strings
index 30795cb..fbce92c 100755
--- a/collection/strings
+++ b/collection/strings
@@ -23,6 +23,7 @@ package Lintian::coll::strings;
use strict;
use warnings;
+use autodie;
use Cwd qw(realpath);
use FileHandle;
@@ -42,22 +43,19 @@ my $info = Lintian::Collect->new ($pkg, $type, $dir);
my @manual = ();
if ( -e "$dir/elf-index" ) {
- unlink "$dir/elf-index" or fail "unlink elf-index: $!";
+ unlink("$dir/elf-index");
}
if ( -d "$dir/strings" ) {
delete_dir ("$dir/strings") or fail "rmdir strings: $!";
}
-open my $elf_fd, '>', "$dir/elf-index"
- or fail "Could not open 'elf-index' for writing: $!";
+open(my $elf_fd, '>', "$dir/elf-index");
# The directory is required, even if it would be empty.
-mkdir "$dir/strings" or
- fail "mkdir $dir/strings: $!";
+mkdir("$dir/strings");
-chdir ("$dir/unpacked")
- or fail("cannot chdir to unpacked directory: $!");
+chdir("$dir/unpacked");
my %opts;
my $open_strings_pipe = sub {
@@ -83,7 +81,7 @@ foreach my $bin ($info->sorted_index) {
}
if (%opts) {
- close $opts{pipe_in};
+ close($opts{pipe_in});
reap (\%opts);
}
@@ -103,7 +101,7 @@ if (@manual) {
['strings', "$dir/unpacked/$file"], '|', ['gzip', '-9nc']);
}
}
-close $elf_fd or fail "cannot write elf-index file: $!";
+close($elf_fd);
}
diff --git a/collection/strings-helper b/collection/strings-helper
index 3e780c7..68b56d0 100755
--- a/collection/strings-helper
+++ b/collection/strings-helper
@@ -21,6 +21,7 @@
use strict;
use warnings;
+use autodie;
use File::Basename qw(dirname);
use IO::Handle;
@@ -42,7 +43,7 @@ while ( my $line = <STDIN> ) {
if ($curfname ne $fname) {
# new file, prepare for it.
if ($out) {
- close $out;
+ close($out);
reap (\%opts);
}
my $dir = $strdir . '/' . dirname ($fname);
@@ -58,11 +59,11 @@ while ( my $line = <STDIN> ) {
$curfname = $fname;
}
- print $out "$string\n";
+ print {$out} "$string\n";
}
if ($out) {
- close $out;
+ close($out);
reap (\%opts);
}
diff --git a/collection/unpacked b/collection/unpacked
index d0e7314..dbf204e 100755
--- a/collection/unpacked
+++ b/collection/unpacked
@@ -24,6 +24,7 @@ package Lintian::coll::unpacked;
use strict;
use warnings;
+use autodie;
use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Lintian::Command qw(spawn);
@@ -37,8 +38,7 @@ if (-d "$dir/unpacked/") {
fail("failed to remove unpacked directory of $pkg");
}
if (-f "$dir/unpacked-errors") {
- unlink ("$dir/unpacked-errors") or
- fail("failed to remove unpacked-errors file of $pkg");
+ unlink("$dir/unpacked-errors");
}
# If we are asked to only remove the files stop right here
if ($type =~ m/^remove-/) {
@@ -67,7 +67,7 @@ if ($type eq 'source') {
['chmod', '-R', 'u+rwX,o+rX,o-w', "$dir/unpacked"]);
} else {
- mkdir ("$dir/unpacked", 0777) or fail "mkdir unpacked: $!";
+ mkdir("$dir/unpacked", 0777);
# avoid using dpkg-deb -x; this pipeline is far faster. I got a factor 2
# improvement on large debs, and factor 1.5 on small debs.
@@ -91,11 +91,11 @@ if ($type eq 'source') {
sub dump_errors {
my ($file) = @_;
- open my $fd, '<', $file or fail "cannot open unpacked-errors: $!";
+ open(my $fd, '<', $file);
while (my $line = <$fd> ) {
print STDERR $line;
}
- close $fd;
+ close($fd);
}
sub libdpkg_unpack_dsc {
@@ -106,7 +106,7 @@ sub libdpkg_unpack_dsc {
'quiet' => 1
};
require Dpkg::Source::Package;
- open(STDOUT, '>', '/dev/null') or fail "Redirecting stdout failed: $!";
+ open(STDOUT, '>', '/dev/null');
# Create the object that does everything
my $srcpkg = Dpkg::Source::Package->new(filename => $dsc, options => $opt);
--
Debian package checker
Reply to: