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

這個命令openclose在其他不錯的代碼中脫穎而出。有沒有辦法以更清晰的方式寫這個?我可以寫我自己的read_file子程序,但應該有這樣的東西了。如何擺脫Perl中的命令式文件打開?

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

效率並不重要,但解決方案應該是跨平臺的。

+1

該代碼中存在一個錯誤:您忘記檢查'close'的返回值。 – tchrist 2011-05-28 11:56:40

+0

@tchrist:謝謝。我從來沒有想到,「close」可能會失敗。 – Tim 2011-05-28 11:58:39

回答

13

過程中,使用File::Slurp:

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

清潔,但產生一個新的進程的成本:免費

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

的確很清潔。產生一個新的過程很好,但我想要一個跨平臺的東西。 – Tim 2011-05-28 08:59:03

3

大家總是寫自己的這些。至少我的默認值是正確的。

############################################################# 
# 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

謝謝。我想''ig00''只是返回'1'的一種愚蠢的方式,但是用'__END__' +註釋顯式結束的意義是什麼? – Tim 2011-05-28 16:15:59

+1

@Tim它確保你永遠不會添加更多的代碼。我喜歡我的這些小部件funcs的版本,因爲它們有正確的默認值,包括但不限於意外指向某些傳統8位編碼時的正確故障轉移行爲。而''ig00''是一個特殊的字符串,由於其特殊性的原因免除了無用的常量警告的使用; 「di」也是如此,原因完全一樣。 – tchrist 2011-05-28 16:48:13

相關問題