2011-05-28 8 views
5
open(my $handle, '<', 'file.dat') or die $!; 
my @data = map { do_things($_) } <$handle>; 
close $handle; 

Este imperativo open y close de arriba se destacan como un monstruo en otro código agradable. ¿Hay alguna manera de escribir esto de una manera más limpia? Podría escribir mi propia subrutina read_file, pero debería haber algo como esto ya.¿Cómo deshacerse de la apertura obligatoria de archivos en Perl?

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

La eficiencia no es importante, pero la solución debe ser multiplataforma.

+1

Hay un error en ese código: se olvidó de comprobar el valor de retorno de 'cerrar'. – tchrist

+0

@tchrist: Gracias. Nunca pensé que 'cerrar' puede fallar. – Tim

Respuesta

13

proceso libre, utilizar File::Slurp:

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

limpiador, pero a costa de genere un nuevo proceso:

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

Limpiador de hecho. Engendrar un nuevo proceso está bien, pero me gustaría algo multiplataforma. – Tim

3

Todo el mundo siempre escribe su propio de éstos. Al menos el mío tiene los valores predeterminados correctos.

############################################################# 
# 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([email protected]) { 
    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__ # 
+0

Gracias. Supongo que '' ig00'' es solo una manera tonta de devolver '1', pero ¿cuál es el punto de terminar explícitamente con' __END__' + comment? – Tim

+1

@Tim se asegura de que nunca agregue más código. Me gusta mi versión de estos funcionamientos maliciosos porque tienen los valores predeterminados correctos, que incluyen, pero no se limitan a, el comportamiento de conmutación por error correcto cuando apuntan accidentalmente a alguna codificación heredada de 8 bits. Y '' ig00'' es una cadena especial, que debido a la razón de su especialidad está exenta del uso inútil de advertencias constantes; también lo es '' di'', y por exactamente la misma razón. – tchrist

Cuestiones relacionadas