The following commit has been merged in the master branch:
commit 05f9f4b00a2675c346b6e6fe025254dfe5d64ad5
Author: Guillem Jover <[email protected]>
Date: Thu Jan 3 00:11:24 2013 +0100
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
diff --git a/scripts/Dpkg/Changelog/Debian.pm b/scripts/Dpkg/Changelog/Debian.pm
index bad97a6..f308c83 100644
--- a/scripts/Dpkg/Changelog/Debian.pm
+++ b/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) {
diff --git a/scripts/Dpkg/File.pm b/scripts/Dpkg/File.pm
index f56c1e2..99e16d6 100644
--- a/scripts/Dpkg/File.pm
+++ b/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;
diff --git a/scripts/Dpkg/Source/Package/V2.pm
b/scripts/Dpkg/Source/Package/V2.pm
index be1d363a..68d0062 100644
--- a/scripts/Dpkg/Source/Package/V2.pm
+++ b/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;
}
diff --git a/scripts/dpkg-genchanges.pl b/scripts/dpkg-genchanges.pl
index 808bc75..b97d5d0 100755
--- a/scripts/dpkg-genchanges.pl
+++ b/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);
}
diff --git a/scripts/t/600_Dpkg_Changelog.t b/scripts/t/600_Dpkg_Changelog.t
index fa3d17f..a0bee9a 100644
--- a/scripts/t/600_Dpkg_Changelog.t
+++ b/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");
diff --git a/src/t/100_dpkg_divert.t b/src/t/100_dpkg_divert.t
index 40af7a9..2e79807 100644
--- a/src/t/100_dpkg_divert.t
+++ b/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);
diff --git a/test/100_critic.t b/test/100_critic.t
index 489c13a..c034c51 100644
--- a/test/100_critic.t
+++ b/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
--
dpkg's main repository
--
To UNSUBSCRIBE, email to [email protected]
with a subject of "unsubscribe". Trouble? Contact [email protected]
