[SCM] Debian package checker branch, master, updated. 2.5.12-75-g9830f5c
The following commit has been merged in the master branch:
commit b69d102610b8c83d78e2dfa12ef698bf7c020893
Author: Niels Thykier <niels@thykier.net>
Date: Thu May 9 13:54:27 2013 +0200
L::Util: Make touch_file and open_gz exception-based
Change touch_file and open_gz so that they emit a trappable error
rather than returning on error.
Signed-off-by: Niels Thykier <niels@thykier.net>
diff --git a/checks/files b/checks/files
index d63c110..28000d9 100644
--- a/checks/files
+++ b/checks/files
@@ -416,7 +416,7 @@ foreach my $file ($info->sorted_index) {
if ($file =~ m,.gz$, and $index_info->size <= 276
and $index_info->is_file
and $info->file_info ($file) =~ m/gzip compressed/) {
- my $fd = open_gz ($info->unpacked($index_info)) or fail "open $file: $!";
+ my $fd = open_gz($info->unpacked($index_info));
my $f = <$fd>;
close($fd);
unless (defined $f and length $f) {
diff --git a/checks/infofiles b/checks/infofiles
index 8fd4c77..a1feb42 100644
--- a/checks/infofiles
+++ b/checks/infofiles
@@ -81,8 +81,7 @@ foreach my $file ($info->sorted_index) {
# unsafe symlink, skip
next;
}
- my $fd = open_gz ($info->unpacked($index_info));
- fail "open_gz $file: $!" unless defined $fd;
+ my $fd = open_gz($info->unpacked($index_info));
local $_;
my ($section, $start, $end);
while (<$fd>) {
diff --git a/checks/manpages b/checks/manpages
index d0aacbf..0d7e91b 100644
--- a/checks/manpages
+++ b/checks/manpages
@@ -161,10 +161,9 @@ foreach my $file ($info->sorted_index) {
my $path = $info->unpacked($index_info);
my $fd;
if ($file_info =~ m/gzip compressed/) {
- $fd = open_gz($path)
- or fail "cannot open $file: $!";
+ $fd = open_gz($path);
} else {
- open $fd, '<', $path;
+ open($fd, '<', $path);
}
my @manfile = <$fd>;
close $fd;
diff --git a/collection/copyright-file b/collection/copyright-file
index 243f279..35d6dce 100755
--- a/collection/copyright-file
+++ b/collection/copyright-file
@@ -41,8 +41,7 @@ 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")
- or fail "touch $dir/copyright failed: $!";
+ touch_file("$dir/copyright");
return;
}
@@ -54,8 +53,7 @@ my $file = "$dir/unpacked/usr/share/doc/$pkg/copyright";
if (-l $file) {
my $link = readlink($file);
if ($link =~ /\.\./ || ($link =~ m%/% && $link !~ m%^[^/]+(?:/+[^/]+)*\z%)) {
- touch_file("$dir/copyright")
- or fail "touch $dir/copyright: $!";
+ touch_file("$dir/copyright");
} else {
copy ($file, "$dir/copyright") or fail "cannot copy $file: $!";
}
@@ -65,8 +63,7 @@ if (-l $file) {
gunzip_file ("$file.gz", "$dir/copyright");
} else {
# no copyright file found
- touch_file("$dir/copyright")
- or fail "touch $dir/copyright failed: $!";
+ touch_file("$dir/copyright");
}
}
diff --git a/collection/debian-readme b/collection/debian-readme
index 6acd95f..ca04500 100755
--- a/collection/debian-readme
+++ b/collection/debian-readme
@@ -45,8 +45,7 @@ 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")
- or fail "touch $dir/README.debian failed: $!";
+ touch_file("$dir/README.Debian");
return;
}
@@ -60,8 +59,7 @@ for (@readmes) {
if (not defined $file) {
# no README found
- touch_file("$dir/README.Debian")
- or fail "touch $dir/README.debian failed: $!";
+ touch_file("$dir/README.Debian");
} elsif ($file =~ m/\.gz$/) {
gunzip_file ($file, "$dir/README.Debian");
} else {
diff --git a/collection/hardening-info b/collection/hardening-info
index bca0b0b..0ca86ed 100755
--- a/collection/hardening-info
+++ b/collection/hardening-info
@@ -81,8 +81,7 @@ if (%opts) {
close($opts{pipe_in});
reap (\%opts);
} else {
- touch_file("$dir/hardening-info")
- or fail "touch $dir/hardening_info failed: $!";
+ touch_file("$dir/hardening-info");
}
}
diff --git a/lib/Lintian/Collect/Binary.pm b/lib/Lintian/Collect/Binary.pm
index cd74359..8c86d72 100644
--- a/lib/Lintian/Collect/Binary.pm
+++ b/lib/Lintian/Collect/Binary.pm
@@ -226,7 +226,7 @@ sub strings {
open my $fd, '<', '/dev/null' or fail "open /dev/null: $!";
return $fd;
}
- my $fd = open_gz ("$real.gz") or fail "open ${file}.gz: $!";
+ my $fd = open_gz("$real.gz");
return $fd;
}
@@ -343,8 +343,7 @@ sub objdump_info {
my %objdump_info;
my $file;
local $_;
- my $fd = open_gz ($objf)
- or fail "cannot open $objf: $!";
+ my $fd = open_gz($objf);
foreach my $pg (parse_dpkg_control ($fd)) {
my %info = (
'PH' => {},
@@ -489,8 +488,7 @@ sub java_info {
$self->{java_info} = \%java_info;
return $self->{java_info};
}
- my $idx = open_gz ($javaf)
- or fail "cannot open $javaf: $!";
+ my $idx = open_gz($javaf);
my $file;
my $file_list;
my $manifest = 0;
diff --git a/lib/Lintian/Collect/Package.pm b/lib/Lintian/Collect/Package.pm
index fbabc39..2a17a71 100644
--- a/lib/Lintian/Collect/Package.pm
+++ b/lib/Lintian/Collect/Package.pm
@@ -160,8 +160,7 @@ sub file_info {
my %file_info;
my $path = $self->lab_data_path ('file-info.gz');
local $_;
- my $idx = open_gz ($path)
- or croak "cannot open $path: $!";
+ my $idx = open_gz($path);
while (<$idx>) {
chomp;
@@ -309,11 +308,9 @@ sub _fetch_index_data {
my %rhlinks;
my @sorted;
local $_;
- my $idx = open_gz ("$base_dir/${index}.gz")
- or croak "cannot open index file $base_dir/${index}.gz: $!";
+ my $idx = open_gz("$base_dir/${index}.gz");
if ($indexown) {
- $num_idx = open_gz ("$base_dir/${indexown}.gz")
- or croak "cannot open index file $base_dir/${indexown}.gz: $!";
+ $num_idx = open_gz("$base_dir/${indexown}.gz");
}
while (<$idx>) {
chomp;
diff --git a/lib/Lintian/Util.pm b/lib/Lintian/Util.pm
index d83a6f4..f52c303 100644
--- a/lib/Lintian/Util.pm
+++ b/lib/Lintian/Util.pm
@@ -563,16 +563,16 @@ file. If the file is empty, an empty list is returned.
Otherwise, this behaves like:
- open my $fd, '<' FILE or die ...;
+ use autodie;
+
+ open(my $fd, '<', FILE);
my @p = parse_dpkg_control($fd, FLAGS, LINES);
- close $fd;
+ close($fd);
return @p;
This goes without saying that may fail with any of the messages that
L</parse_dpkg_control(HANDLE[, FLAGS[, LINES]])> do. It can also emit
-the following error:
-
- "cannot open %s: %s"
+autodie exceptions if open or close fails.
=cut
@@ -923,6 +923,8 @@ sub gunzip_file {
Opens a handle that reads from the GZip compressed FILE.
+On failure, this sub emits a trappable error.
+
Note: The handle may be a pipe from an external processes.
=cut
@@ -931,16 +933,14 @@ Note: The handle may be a pipe from an external processes.
# is available)
sub __open_gz_pio {
my ($file) = @_;
- no autodie qw(open);
- open my $fd, '<:gzip', $file or return;
+ open(my $fd, '<:gzip', $file);
return $fd;
}
# Fallback implementation of open_gz
sub __open_gz_ext {
my ($file) = @_;
- no autodie qw(open);
- open my $fd, '-|', 'gzip', '-dc', $file or return;
+ open(my $fd, '-|', 'gzip', '-dc', $file);
return $fd;
}
@@ -949,34 +949,22 @@ sub __open_gz_ext {
Updates the "mtime" of FILE. If FILE does not exist, it will be
created.
-Returns 1 on success and 0 on failure. On failure, $! will contain
-the failure.
+On failure, this sub will emit a trappable error.
=cut
sub touch_file {
my ($file) = @_;
- # We have to return 0 if one of these fails and for "close",
- # we don't always want its $! (i.e. if utime fails)
- no autodie qw(open close);
-
# We use '>>' because '>' truncates the file if it has contents
# (which `touch file` doesn't).
- open my $fd, '>>', $file or return 0;
-
+ open(my $fd, '>>', $file);
# open with '>>' does not update the mtime if the file already
# exists, so use utime to solve that.
- if (!utime(undef, undef, $fd)) {
- # utime failed. Preserve the utime error in $! and
- # always return 0
- local $! = 0;
- close($fd);
- return 0;
- }
+ utime(undef, undef, $fd);
+ close($fd);
- # utime succeeded, then close decides the return code (and $!).
- return close($fd);
+ return 1;
}
=item fail (MSG[, ...])
--
Debian package checker
Reply to: