perl: Always check open() return value

Fixes InputOutput::RequireCheckedOpen.

Warned-by: perlcritic

dselect/methods/ftp/install

@@ -468,7 +468,8 @@ sub getdebinfo($) {
     my $type = chkdeb($fn);
     my ($pkg, $ver);
     if($type == 1) {
-	open(my $pkgfile_fh, '-|', "dpkg-deb --field $fn");
+	open(my $pkgfile_fh, '-|', "dpkg-deb --field $fn")
+	    or die "cannot create pipe for 'dpkg-deb --field $fn'";
 	my %fields = getblk($pkgfile_fh);
 	close($pkgfile_fh);
 	$pkg = $fields{'package'};
@@ -476,7 +477,8 @@ sub getdebinfo($) {
 	if($fields{'package_revision'}) { $ver .= '-' . $fields{'package_revision'}; }
 	return $pkg, $ver;
     } elsif ( $type == 2) {
-	open(my $pkgfile_fh, '-|', "dpkg-split --info $fn");
+	open(my $pkgfile_fh, '-|', "dpkg-split --info $fn")
+	    or die "cannot create pipe for 'dpkg-split --info $fn'";
 	while (<$pkgfile_fh>) {
 	    /Part of package:\s*(\S+)/ and $pkg = $+;
 	    /\.\.\. version:\s*(\S+)/ and $ver = $+;

scripts/Dpkg/Changelog/Parse.pm

@@ -102,7 +102,8 @@ sub changelog_parse {
 
     # Extract the format from the changelog file if possible
     unless($force or ($changelogfile eq '-')) {
-	open(my $format_fh, '-|', 'tail', '-n', '40', $changelogfile);
+	open(my $format_fh, '-|', 'tail', '-n', '40', $changelogfile)
+	    or syserr(_g('cannot create pipe for %s'), 'tail');
 	while (<$format_fh>) {
 	    $format = $1 if m/\schangelog-format:\s+([0-9a-z]+)\W/;
 	}

scripts/dpkg-shlibdeps.pl

@@ -846,7 +846,8 @@ sub find_packages {
     if (!$pid) {
 	# Child process running dpkg --search and discarding errors
 	close STDERR;
-	open STDERR, '>', '/dev/null';
+	open STDERR, '>', '/dev/null'
+	    or syserr(_g('cannot open file %s'), '/dev/null');
 	$ENV{LC_ALL} = 'C';
 	exec('dpkg', '--search', '--', @files)
 	    || syserr(_g('unable to execute %s'), 'dpkg');

scripts/t/800_Dpkg_IPC.t

@@ -30,7 +30,8 @@ my $tmp_fh;
 my $string1 = "foo\nbar\n";
 my $string2;
 
-open $tmp_fh, '>', $tmp1_name;
+open $tmp_fh, '>', $tmp1_name
+    or die "cannot open $tmp1_name: $!";
 print $tmp_fh $string1;
 close $tmp_fh;
 
@@ -50,7 +51,8 @@ ok($pid);
 
 wait_child($pid);
 
-open $tmp_fh, '<', $tmp2_name;
+open $tmp_fh, '<', $tmp2_name
+    or die "cannot open $tmp2_name: $!";
 $string2 = <$tmp_fh>;
 close $tmp_fh;
 
@@ -64,7 +66,8 @@ $pid = spawn(exec => 'cat',
 
 ok($pid);
 
-open $tmp_fh, '<', $tmp2_name;
+open $tmp_fh, '<', $tmp2_name
+    or die "cannot open $tmp2_name: $!";
 $string2 = <$tmp_fh>;
 close $tmp_fh;
 

src/t/100_dpkg_divert.t

@@ -49,20 +49,23 @@ sub cleanup {
 
 sub install_diversions {
     my ($txt) = @_;
-    open(my $db_fh, '>', "$admindir/diversions");
+    open(my $db_fh, '>', "$admindir/diversions")
+        or die "cannot create $admindir/diversions";
     print $db_fh $txt;
     close($db_fh);
 }
 
 sub install_filelist {
     my ($pkg, $arch, @files) = @_;
-    open(my $fileslist_fh, '>', "$admindir/info/$pkg.list");
+    open(my $fileslist_fh, '>', "$admindir/info/$pkg.list")
+        or die "cannot create $admindir/info/$pkg.list";
     for my $file (@files) {
         print $fileslist_fh "$file\n";
     }
     close($fileslist_fh);
     # Only installed packages have their files list considered.
-    open(my $status_fh, '>>', "$admindir/status");
+    open(my $status_fh, '>>', "$admindir/status")
+        or die "cannot append to $admindir/status";
     print $status_fh <<"EOF";
 Package: $pkg
 Status: install ok installed
@@ -138,7 +141,8 @@ sub diversions_pack {
 
 sub diversions_eq {
     my (@expected) = split /^/, shift;
-    open(my $db_fh, '<', "$admindir/diversions");
+    open(my $db_fh, '<', "$admindir/diversions")
+        or die "cannot open $admindir/diversions";
     my (@contents) = <$db_fh>;
     close($db_fh);
 

test/100_critic.t

@@ -65,6 +65,7 @@ my @policies = qw(
     InputOutput::ProhibitOneArgSelect
     InputOutput::ProhibitReadlineInForLoop
     InputOutput::ProhibitTwoArgOpen
+    InputOutput::RequireCheckedOpen
     InputOutput::RequireEncodingWithUTF8Layer
     Miscellanea::ProhibitFormats
     Miscellanea::ProhibitUnrestrictedNoCritic