How to get rid of imperative file opening in Perl?

Question

open( my $handle, '<', 'file.dat' ) or die $!;
my @data = map { do_things($_) } <$handle>;
close $handle;

This imperative open and close above stand out like an eyesore in otherwise nice code. Is there a way to write this in a cleaner way? I could write my own read_file subroutine, but there should be something like this already.

sub read_file {
    open( my $handle, '<', $_[0] ) or croak $!;
    return <$handle>;
}
my @data = map { do_things($_) } read_file('file.dat');

Efficiency is not important, but the solution should be cross-platform.

Answer 1

Process free, use File::Slurp:

use File::Slurp;
my @data = map {...} read_file($filename);

Answer 2

Everybody always writes their own of these. At least mine has the right defaults.

#############################################################
#  File::Clowder - a herd of obedient cats
#
#   Tom Christiansen <[email protected]>
#   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__ #

Answer 3

Cleaner, but at the cost of spawning a new process:

my @data = map { do_things($_) } split "\n", `cat file.dat`;