perl: Slurp files more efficiently

Do not read each line to then join it, just switch on slurp mode and
do it in one go. Use the newly created function file_slurp.

Fixes InputOutput::ProhibitJoinedReadline.

Warned-by: perlcritic

scripts/Dpkg/Changelog/Debian.pm

@@ -46,6 +46,7 @@ use warnings;
 our $VERSION = '1.00';
 
 use Dpkg::Gettext;
+use Dpkg::File;
 use Dpkg::Changelog qw(:util);
 use base qw(Dpkg::Changelog);
 use Dpkg::Changelog::Entry::Debian qw($regex_header $regex_trailer);
@@ -121,7 +122,7 @@ sub parse {
 	    # save entries on old changelog format verbatim
 	    # we assume the rest of the file will be in old format once we
 	    # hit it for the first time
-	    $self->set_unparsed_tail("$_\n" . join('', <$fh>));
+	    $self->set_unparsed_tail("$_\n" . file_slurp($fh));
 	} elsif (m/^\S/) {
 	    $self->parse_error($file, $., _g('badly formatted heading line'), "$_");
 	} elsif ($_ =~ $regex_trailer) {

scripts/Dpkg/File.pm

@@ -26,7 +26,7 @@ use Dpkg::Gettext;
 use Dpkg::ErrorHandling;
 
 use base qw(Exporter);
-our @EXPORT = qw(file_lock);
+our @EXPORT = qw(file_lock file_slurp);
 
 sub file_lock($$) {
     my ($fh, $filename) = @_;
@@ -49,4 +49,12 @@ sub file_lock($$) {
     }
 }
 
+sub file_slurp {
+    my ($fh) = @_;
+
+    local $/;
+    my $data = <$fh>;
+    return $data;
+}
+
 1;

scripts/Dpkg/Source/Package/V2.pm

@@ -25,6 +25,7 @@ use base 'Dpkg::Source::Package';
 use Dpkg;
 use Dpkg::Gettext;
 use Dpkg::ErrorHandling;
+use Dpkg::File;
 use Dpkg::Compression;
 use Dpkg::Source::Archive;
 use Dpkg::Source::Patch;
@@ -549,7 +550,7 @@ sub get_patch_header {
     my $text;
     if (-f $ph) {
         open(my $ph_fh, '<', $ph) || syserr(_g('cannot read %s'), $ph);
-        $text = join('', <$ph_fh>);
+        $text = file_slurp($ph_fh);
         close($ph_fh);
         return $text;
     }

scripts/dpkg-genchanges.pl

@@ -26,6 +26,7 @@ use Encode;
 use POSIX qw(:errno_h);
 use Dpkg;
 use Dpkg::Gettext;
+use Dpkg::File;
 use Dpkg::Checksums;
 use Dpkg::ErrorHandling;
 use Dpkg::Arch qw(get_host_arch debarch_eq debarch_is);
@@ -347,7 +348,7 @@ foreach $_ (keys %{$changelog}) {
 if ($changesdescription) {
     open(my $changes_fh, '<', $changesdescription) ||
         syserr(_g('read changesdescription'));
-    $fields->{'Changes'} = "\n" . join('', <$changes_fh>);
+    $fields->{'Changes'} = "\n" . file_slurp($changes_fh);
     close($changes_fh);
 }
 

scripts/t/600_Dpkg_Changelog.t

@@ -17,6 +17,7 @@ use strict;
 use warnings;
 
 use File::Basename;
+use Dpkg::File;
 
 BEGIN {
     my $no_examples = 4;
@@ -51,7 +52,7 @@ foreach my $file ("$datadir/countme", "$datadir/shadow", "$datadir/fields",
     $changes->load($file);
 
     open(my $clog_fh, '<', "$file") || die "Can't open $file\n";
-    my $content = join('', <$clog_fh>);
+    my $content = file_slurp($clog_fh);
     close($clog_fh);
     cmp_ok($content, 'eq', "$changes", "string output of Dpkg::Changelog on $file");
 

src/t/100_dpkg_divert.t

@@ -15,6 +15,7 @@
 
 use Test::More;
 use File::Spec;
+use Dpkg::File;
 use Dpkg::IPC;
 
 use strict;
@@ -97,13 +98,13 @@ sub call {
         is(join('', @output), join('', @expect), "@$args stdout");
     }
     if (defined $opts{expect_stdout_like}) {
-        like(join('', <$output>), $opts{expect_stdout_like}, "@$args stdout");
+        like(file_slurp($output), $opts{expect_stdout_like}, "@$args stdout");
     }
     if (defined $opts{expect_stderr}) {
-        is(join('', <$error>), $opts{expect_stderr}, "@$args stderr");
+        is(file_slurp($error), $opts{expect_stderr}, "@$args stderr");
     }
     if (defined $opts{expect_stderr_like}) {
-        like(join('', <$error>), $opts{expect_stderr_like}, "@$args stderr");
+        like(file_slurp($error), $opts{expect_stderr_like}, "@$args stderr");
     }
 
     close($output);

test/100_critic.t

@@ -53,6 +53,7 @@ my @policies = qw(
     Documentation::RequirePackageMatchesPodName
     InputOutput::ProhibitBarewordFileHandles
     InputOutput::ProhibitInteractiveTest
+    InputOutput::ProhibitJoinedReadline
     InputOutput::ProhibitOneArgSelect
     InputOutput::ProhibitTwoArgOpen
     InputOutput::RequireEncodingWithUTF8Layer