open( my $handle, '<', 'file.dat' ) or die $!;
my @data = map { do_things($_) } <$handle>;
close $handle;
上面的命令式open和close在其他方面很好的代码中引人注目。有没有办法以更清洁的方式写这个？我可以编写自己的read_file子程序，但应该有类似的东西。
sub read_file {
open( my $handle, '<', $_[0] ) or croak $!;
return <$handle>;
}
my @data = map { do_things($_) } read_file('file.dat');
效率并不重要，但解决方案应该是跨平台的。
答案 0 :(得分：13)
免费处理，使用File::Slurp:
use File::Slurp;
my @data = map {...} read_file($filename);
答案 1 :(得分：3)
每个人总是写下自己的这些。至少我有正确的默认值。
#############################################################
# File::Clowder - a herd of obedient cats
#
# Tom Christiansen <tchrist@perl.com>
# Sat May 28 09:17:32 MDT 2011
#############################################################
##
## ** THIS IS AN UNSUPPORTED, PRE-RELEASE VERSION ONLY **
##
#############################################################
package File::Clowder;
use v5.10.1;
use strict;
use warnings;
use Carp;
#############################################################
use parent "Exporter";
our $VERSION = v0.0.1;
our @EXPORT = qw<cat>;
our @EXPORT_OK = qw[
cat catfile catfiles
catascii catlatin piglatin
rawfile catbytes file_bytes
file_string file_line file_lines
file_paras file_records
utf8_file decode_file
];
our %EXPORT_TAGS = (
all => [ @EXPORT, @EXPORT_OK ],
);
#############################################################
sub cat ( @ );
sub catfiles ( @ );
sub catbytes ( _ );
sub rawfile ( _ );
sub catascii ( _ ; $ );
sub catfile ( _ ; $ );
sub catlatin ( _ ; $ );
sub piglatin ( _ ; $ );
sub file_bytes ( $ );
sub file_line ( $ );
sub file_lines ( $ );
sub file_paras ( $ );
sub file_records ( $ $ );
sub file_string ( $ );
sub utf8_file ( $ ; $ );
sub decode_file ( $ $ ; $ );
sub _contents ( $ ; $ );
sub choke ( $ @ );
our $_ENCODING;
#############################################################
sub choke($@) {
my $func = (caller(1))[3];
my $args = join q() => @_;
local $Carp::CarpLevel = 2 unless our $DEBUG;
confess "$func(): $args";
}
sub catfiles(@) {
my $many = wantarray();
if ($many) {
return map {catfile} @_;
}
elsif (defined $many) {
return join q() => map { scalar catfile } @_;
}
else {
catfile for @_;
}
return scalar @_;
}
BEGIN { *cat = \&catfiles }
sub catfile(_;$) {
@_ == 1 || @_ == 2 || choke q<usage: [data =] catfile($;$)>;
if (defined wantarray()) { return &utf8_file }
else { say for &utf8_file }
}
sub catascii(_;$) {
@_ == 1 || @_ == 2 || choke q<usage: [data =] catascii($;$)>;
if (defined wantarray()) { return &decode_file("US-ASCII", @_) }
else { say for &decode_file("US-ASCII", @_) }
}
sub catlatin(_;$) {
@_ == 1 || @_ == 2 || choke q<usage: [data =] catlatin($;$)>;
if (defined wantarray()) { return &decode_file("ISO-8859-1", @_) }
else { say for &decode_file("ISO-8859-1", @_) }
}
sub piglatin(_;$) {
@_ == 1 || @_ == 2 || choke q<usage: [data =] piglatin($;$)>;
if (defined wantarray()) { return &decode_file("CP1252", @_) }
else { say for &decode_file("CP1252", @_) }
}
sub file_bytes($) {
!wantarray() || choke q<call me in scalar context>;
@_ == 1 || choke q<usage: $data = file_bytes($)>;
local $_ENCODING;
return scalar _contents($_[0], undef);
}
sub rawfile(_) {
@_ == 1 || choke q<usage: $data = rawfile($)>;
my $data = &file_bytes;
return $data;
}
BEGIN { *catbytes = \&rawfile }
sub file_line($) {
@_ == 1 || choke q<usage: @lines = file_lines($)>;
return utf8_file($_[0], qr/\R/);
}
sub file_lines($) {
wantarray() || choke q<call me in list context>;
@_ == 1 || choke q<usage: @lines = file_lines($)>;
return utf8_file($_[0], qr/\R/);
}
sub file_paras($) {
wantarray() || choke q<call me in list context>;
@_ == 1 || choke q<usage: @paras = file_paras($)>;
return utf8_file($_[0], qr/\R+/);
}
sub file_records($$) {
wantarray() || choke q<call me in list context>;
@_ == 2 || choke q<usage: @recs = file_records($$)>;
return &utf8_file;
}
sub file_string($) {
!wantarray() || choke q<call me in scalar context>;
@_ == 1 || choke q<usage: $data = file_string($)>;
return scalar utf8_file($_[0], undef);
}
sub utf8_file($;$) {
@_ == 1 || @_ == 2 || choke q<usage: data = utf8_file($;$)>;
return &decode_file("UTF-8", @_);
}
sub decode_file($$;$) {
@_ == 2 || @_ == 3 || choke q<usage: data = decode_file($$;$)>;
local $_ENCODING = shift();
return &_contents;
}
sub _contents($;$) {
my $many = wantarray() // choke "don't call me in void context";
@_ == 1 || @_ == 2 || choke q<usage: data = _contents($;$)>;
my ( $fname, $eol ) =
( shift(), );
if (@_) {
$eol = shift();
$eol = qr/\R+/ if grep {defined && !length} $eol;
} else {
$eol = qr/\R/;
}
$fname !~ / ^ \s* \+? > /x || choke "'$fname' looks like output file";
$fname !~ / ^ \s* -? \| /x || choke "'$fname' looks like output pipe";
open(my $fh, $fname) || choke "can't open '$fname': $!";
my $enc = $_ENCODING
? ":encoding($_ENCODING)"
: ":raw"
;
binmode($fh, $enc) || choke "can't binmode('$fname','$enc'): $!";
my $data = do {
local $/ = undef;
use warnings FATAL => "all";
<$fh>;
};
my $piping = ($fname =~ / \| \s* \z /x );
$! = 0;
close($fh) || choke "can't close '$fname': "
. ($piping
? qq<\$?=$? >
: qq<>
) . $!;
unless ($many) {
$data =~ s/ $eol \z //x if defined $eol;
return $data;
}
my @data = split($eol // qr{\R}, $data);
pop(@data) if @data && !length( $data[-1] );
return @data;
}
'ig00' ; __END__ #
答案 2 :(得分：1)
清洁工，但以产生新工艺为代价：
my @data = map { do_things($_) } split "\n", `cat file.dat`;