Question

我有一些我称之为myWrite($fileName, \@data)的子程序。 myWrite()打开文件并以某种方式写出数据。我想修改myWrite，以便我可以将文件句柄作为第一个参数调用上面的或。（这种修改的主要原因是将文件的开头委托给调用脚本而不是模块。如果有一个更好的解决方案来告诉IO子程序在哪里写，我很高兴听到它。）

为了做到这一点，我必须测试第一个输入var是否是文件句柄。我通过阅读this question想出了如何做到这一点。

现在这是我的问题：我还想测试是否可以写入此文件句柄。我无法弄清楚如何做到这一点。

这就是我想要做的事情：

sub myWrite {
  my ($writeTo, $data) = @_;
  my $fh;
  if (isFilehandle($writeTo)) { # i can do this
    die "you're an immoral person\n" 
      unless (canWriteTo($writeTo)); # but how do I do this?
    $fh = $writeTo;
  } else {
    open $fh, ">", $writeTo;
  }
  ...
}

我需要知道的是，如果我可以写入文件句柄，虽然很高兴看到一些通用解决方案告诉您是否使用“＆gt;＆gt;”打开了文件句柄或“＆lt;”，或者如果它没有打开等等。

（请注意，this question是相关的，但似乎没有回答我的问题。）

Answer 1

检测手柄的开放性

正如Axeman指出的那样，$handle->opened()告诉你它是否是开放的。

use strict;
use autodie;
use warnings qw< FATAL all >;
use IO::Handle;
use Scalar::Util qw< openhandle >;

our $NULL = "/dev/null";
open NULL;
printf "NULL is %sopened.\n", NULL->opened() ? "" : "not ";
printf "NULL is %sopenhandled.\n", openhandle("NULL") ? "" : "not ";
printf "NULL is fd %d.\n", fileno(NULL);

产生

NULL is opened.
NULL is not openhandled.
NULL is fd 3.

如你所见，你不能使用Scalar::Util::openhandle()，因为它太愚蠢和错误。

开放式手柄压力测试

正确的方法，如果您未使用IO::Handle->opened，将在以下简单的小三语脚本中进行演示：

eval 'exec perl $0 ${1+"$@"}'
               if 0;

use 5.010_000;
use strict;
use autodie;
use warnings qw[ FATAL all ];

use Symbol;
use IO::Handle;

#define exec(arg)
BEGIN { exec("cpp $0 | $^X") } #!/usr/bin/perl -P
#undef  exec

#define SAY(FN, ARG) printf("%6s %s => %s\n", short("FN"), q(ARG), FN(ARG))
#define STRING(ARG)  SAY(qual_string, ARG)
#define GLOB(ARG)    SAY(qual_glob, ARG)
#define NL           say ""
#define TOUGH        "hard!to!type"

sub comma(@);
sub short($);
sub qual($);
sub qual_glob(*);
sub qual_string($);

$| = 1;

main();
exit();

sub main { 

    our $GLOBAL = "/dev/null";
    open GLOBAL;

    my $new_fh = new IO::Handle;

    open(my $null, $GLOBAL);

    for my $str ($GLOBAL, TOUGH) {
        no strict "refs";
        *$str = *GLOBAL{IO};
    }

    STRING(  *stderr       );
    STRING(  "STDOUT"      );
    STRING(  *STDOUT       );
    STRING(  *STDOUT{IO}   );
    STRING( \*STDOUT       );
    STRING( "sneezy"       );
    STRING( TOUGH );
    STRING( $new_fh        );
    STRING( "GLOBAL"       );
    STRING( *GLOBAL        );
    STRING( $GLOBAL        );
    STRING( $null          );

    NL;

    GLOB(  *stderr       );
    GLOB(   STDOUT       );
    GLOB(  "STDOUT"      );
    GLOB(  *STDOUT       );
    GLOB(  *STDOUT{IO}   );
    GLOB( \*STDOUT       );
    GLOB(  sneezy        );
    GLOB( "sneezy"       );
    GLOB( TOUGH );
    GLOB( $new_fh        );
    GLOB(  GLOBAL        );
    GLOB( $GLOBAL        );
    GLOB( *GLOBAL        );
    GLOB( $null          );

    NL;

}

sub comma(@) { join(", " => @_) }

sub qual_string($) { 
    my $string = shift();
    return qual($string);
} 

sub qual_glob(*) { 
    my $handle = shift();
    return qual($handle);
} 

sub qual($) {
    my $thingie = shift();

    my $qname = qualify($thingie);
    my $qref  = qualify_to_ref($thingie); 
    my $fnum  = do { no autodie; fileno($qref) };
    $fnum = "undef" unless defined $fnum;

    return comma($qname, $qref, "fileno $fnum");
} 

sub short($) {
    my $name = shift();
    $name =~ s/.*_//;
    return $name;
}

运行时产生：

string    *stderr        => *main::stderr, GLOB(0x8368f7b0), fileno 2
string    "STDOUT"       => main::STDOUT, GLOB(0x8868ffd0), fileno 1
string    *STDOUT        => *main::STDOUT, GLOB(0x84ef4750), fileno 1
string    *STDOUT{IO}    => IO::Handle=IO(0x8868ffe0), GLOB(0x84ef4750), fileno 1
string   \*STDOUT        => GLOB(0x8868ffd0), GLOB(0x8868ffd0), fileno 1
string   "sneezy"        => main::sneezy, GLOB(0x84169f10), fileno undef
string   "hard!to!type"  => main::hard!to!type, GLOB(0x8868f1d0), fileno 3
string   $new_fh         => IO::Handle=GLOB(0x8868f0b0), IO::Handle=GLOB(0x8868f0b0), fileno undef
string   "GLOBAL"        => main::GLOBAL, GLOB(0x899a4840), fileno 3
string   *GLOBAL         => *main::GLOBAL, GLOB(0x84ef4630), fileno 3
string   $GLOBAL         => main::/dev/null, GLOB(0x7f20ec00), fileno 3
string   $null           => GLOB(0x86f69bb0), GLOB(0x86f69bb0), fileno 4

  glob    *stderr        => GLOB(0x84ef4050), GLOB(0x84ef4050), fileno 2
  glob     STDOUT        => main::STDOUT, GLOB(0x8868ffd0), fileno 1
  glob    "STDOUT"       => main::STDOUT, GLOB(0x8868ffd0), fileno 1
  glob    *STDOUT        => GLOB(0x8868ffd0), GLOB(0x8868ffd0), fileno 1
  glob    *STDOUT{IO}    => IO::Handle=IO(0x8868ffe0), GLOB(0x84ef4630), fileno 1
  glob   \*STDOUT        => GLOB(0x8868ffd0), GLOB(0x8868ffd0), fileno 1
  glob    sneezy         => main::sneezy, GLOB(0x84169f10), fileno undef
  glob   "sneezy"        => main::sneezy, GLOB(0x84169f10), fileno undef
  glob   "hard!to!type"  => main::hard!to!type, GLOB(0x8868f1d0), fileno 3
  glob   $new_fh         => IO::Handle=GLOB(0x8868f0b0), IO::Handle=GLOB(0x8868f0b0), fileno undef
  glob    GLOBAL         => main::GLOBAL, GLOB(0x899a4840), fileno 3
  glob   $GLOBAL         => main::/dev/null, GLOB(0x7f20ec00), fileno 3
  glob   *GLOBAL         => GLOB(0x899a4840), GLOB(0x899a4840), fileno 3
  glob   $null           => GLOB(0x86f69bb0), GLOB(0x86f69bb0), fileno 4

那是你测试打开文件句柄的方法！

但我相信，这甚至不是你的问题。

尽管如此，我觉得需要解决这个问题，因为有太多不正确的解决方案来解决这个问题。人们需要睁开眼睛看看这些东西是如何运作的。请注意，Symbol中的两个函数会在必要时使用caller的包 - 这当然是常见的。

确定打开手柄的读/写模式

此是您问题的答案：

#!/usr/bin/env perl

use 5.10.0;
use strict;
use autodie;
use warnings qw< FATAL all >;

use Fcntl;

my (%flags, @fh);
my $DEVICE  = "/dev/null";
my @F_MODES = map { $_ => "+$_" } qw[ < > >> ];
my @O_MODES = map { $_ | O_WRONLY }
        O_SYNC                          ,
                 O_NONBLOCK             ,
        O_SYNC              | O_APPEND  ,
                 O_NONBLOCK | O_APPEND  ,
        O_SYNC | O_NONBLOCK | O_APPEND  ,
    ;

   open($fh[++$#fh], $_, $DEVICE) for @F_MODES;
sysopen($fh[++$#fh], $DEVICE, $_) for @O_MODES;

eval { $flags{$_} = main->$_ } for grep /^O_/, keys %::;

for my $fh (@fh) {
    printf("fd %2d: " => fileno($fh));
    my ($flags => @flags) = 0+fcntl($fh, F_GETFL, my $junk);
    while (my($_, $flag) = each %flags) {
        next if $flag == O_ACCMODE;
        push @flags => /O_(.*)/ if $flags & $flag;
    }
    push @flags => "RDONLY" unless $flags & O_ACCMODE;
    printf("%s\n",  join(", " => map{lc}@flags));
}

close $_ for reverse STDOUT => @fh;

运行时，产生此输出：

fd  3: rdonly
fd  4: rdwr
fd  5: wronly
fd  6: rdwr
fd  7: wronly, append
fd  8: rdwr, append
fd  9: wronly, sync
fd 10: ndelay, wronly, nonblock
fd 11: wronly, sync, append
fd 12: ndelay, wronly, nonblock, append
fd 13: ndelay, wronly, nonblock, sync, append

现在开心，施文？ ☺

Answer 2

仍在试验这个，但也许您可以尝试将零字节的syswrite写入文件句柄并检查错误：

open A, '<', '/some/file';
open B, '>', '/some/other-file';

{
    local $! = 0;
    my $n = syswrite A, "";
    # result: $n is undef, $! is "Bad file descriptor"
}
{
    local $! = 0;
    my $n = syswrite B, "";
    # result: $n is 0, $! is ""
}

fcntl看起来很有希望。您的里程可能会有所不同，但这样的事情可能会走上正轨：

use Fcntl;
$flags = fcntl HANDLE, F_GETFL, 0;  # "GET FLags"
if (  ($flags & O_ACCMODE) & (O_WRONLY|O_RDWR) ) {
    print "HANDLE is writeable ...\n"
}

Answer 3

听起来你正在尝试重新发明异常处理。不要那样做。除了提交只写句柄之外，还有很多潜在的错误。如何处理一个封闭的手柄？有现有错误的句柄？

mobrule的use Fcntl;方法正确地确定了文件句柄上的标志，但这通常不会处理错误和警告。

如果要委托调用者负责打开文件，请委托调用者适当处理异常。这允许调用者选择适当的响应。绝大多数情况下，它要么死了，要么警告或修复那些让你处理不好的违规代码。

有两种方法可以处理传递给您的文件句柄的异常。

首先，如果您可以在CPAN上查看TryCatch或Try::Tiny并使用该异常处理方法。我使用TryCatch，它很棒。

第二种方法是使用eval并在eval完成后捕获相应的错误或警告。

如果尝试写入只读文件句柄，则会生成警告。捕获您尝试写入时生成的警告，然后您可以将成功或失败返回给调用者。

以下是一个例子：

use strict; use warnings;

sub perr {
    my $fh=shift;
    my $text=shift;
    my ($package, $file, $line, $sub)=caller(0);
    my $oldwarn=$SIG{__WARN__};
    my $perr_error;

    {
        local $SIG{__WARN__} = sub { 
            my $dad=(caller(1))[3];
            if ($dad eq "(eval)" ) {
                $perr_error=$_[0];
                return ;
            }   
            oldwarn->(@_);
        };
        eval { print $fh $text }; 
    }    

    if(defined $perr_error) {
        my $s="$sub, line: $line";
        $perr_error=~s/line \d+\./$s/ ;
        warn "$sub called in void context with warning:\n" .  
             $perr_error 
             if(!defined wantarray);
        return wantarray ? (0,$perr_error) : 0;
    }
    return wantarray ? (1,"") : 1;
}

my $fh;
my @result;
my $res;
my $fname="blah blah file";

open $fh, '>', $fname;

print "\n\n","Successful write\n\n" 
     if perr $fh, "opened by Perl and writen to...\n";

close $fh;

open $fh, '<', $fname;

# void context:
perr $fh, "try writing to a read-only handle";

# scalar context:
$res=perr $fh, "try writing to a read-only handle";


@result=perr $fh, "try writing to a read-only handle";
if  ($result[0]) {
   print "SUCCESS!!\n\n";
} else {
    print "\n","I dunno -- should I die or warn this:\n";
    print $result[1];
}   

close $fh;
@result=perr $fh, "try writing to a closed handle";
if  ($result[0]) {
   print "SUCCESS!!\n\n";
} else {
    print "\n","I dunno -- should I die or warn this:\n";
    print $result[1];
}

输出：

Successful write

main::perr called in void context with warning:
Filehandle $fh opened only for input at ./perr.pl main::perr, line: 49

I dunno -- should I die or warn this:
Filehandle $fh opened only for input at ./perr.pl main::perr, line: 55

I dunno -- should I die or warn this:
print() on closed filehandle $fh at ./perr.pl main::perr, line: 64

Answer 4

-w运算符可用于测试文件或文件句柄是否可写

open my $fhr, '<', '/etc/passwd' or die "$!";
printf("%s read from fhr\n", -r $fhr ? 'Can' : "Can't");
printf("%s write to fhr\n",  -w $fhr ? 'Can' : "Can't");

open my $fhw, '>', '/tmp/test' or die "$!";
printf("%s read from fhw\n", -r $fhw ? 'Can' : "Can't");
printf("%s write to fhw\n",  -w $fhw ? 'Can' : "Can't");

输出：

Can read from fhr
Can't write to fhr
Can read from fhw
Can write to fhw

Answer 5

如果您正在使用IO（您应该），那么$handle->opened会告诉您句柄是否已打开。可能需要更深入地研究它的模式。

如何测试我是否可以写入文件句柄？

5 个答案:

检测手柄的开放性

开放式手柄压力测试

确定打开手柄的读/写模式