Fatal编程技术网
  • perl/
  • Perl 如何测试是否可以写入文件句柄？

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

perl file-io

Perl 如何测试是否可以写入文件句柄？,perl,file-io,filehandle,Perl,File Io,Filehandle,我有一些子程序，我这样调用myWrite（$fileName，\@data）myWrite（）打开文件并以某种方式写出数据。我想修改myWrite，这样我就可以像上面那样调用它，或者使用filehandle作为第一个参数。（此修改的主要原因是将文件的打开委托给调用脚本而不是模块。如果有更好的解决方案告诉IO子例程在何处写入，我很乐意听到。） 为了做到这一点，我必须测试第一个输入变量是否是filehandle。我通过阅读了解了如何做到这一点 现在是我的问题：我还想测试是否可以写入此文件句柄。我不知

我有一些子程序，我这样调用
myWrite（$fileName，\@data）
myWrite（）
打开文件并以某种方式写出数据。我想修改
myWrite
，这样我就可以像上面那样调用它，或者使用filehandle作为第一个参数。（此修改的主要原因是将文件的打开委托给调用脚本而不是模块。如果有更好的解决方案告诉IO子例程在何处写入，我很乐意听到。）

为了做到这一点，我必须测试第一个输入变量是否是filehandle。我通过阅读了解了如何做到这一点

现在是我的问题：我还想测试是否可以写入此文件句柄。我不知道该怎么做

以下是我想做的：

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;
  }
  ...
}
我需要知道的是我是否可以写入filehandle，不过如果能看到一些通用的解决方案，告诉您filehandle是用“>>”还是“打开的，那就太好了，-w操作符可以用来测试文件还是filehandle是可写的

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");
仍在尝试此操作，但您可以尝试对文件句柄进行零字节系统写入，并检查错误：

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 ""
}
听起来你好像在尝试重新设计异常处理。不要这样做。除了交给只写句柄之外，还有很多潜在的错误。交给关闭句柄如何？一个有错误的句柄

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

如果要将打开文件的责任委托给调用者，请将异常的适当处理委托给调用者。这允许调用者选择适当的响应。绝大多数情况下，要么死亡，要么警告或修复给你一个错误句柄的违规代码

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

首先，如果您可以在CPAN上查看或使用该异常处理方法，我使用TryCatch，它非常棒

第二种方法是在评估完成后使用并捕获适当的错误或警告

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

以下是一个例子：

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];
}
如果您正在使用（并且应该使用），则
$handle->opened
将告诉您句柄是否已打开。可能需要更深入地了解其模式。

检测句柄的打开程度 正如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);
如您所见，您不能使用标量：：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
中的两个函数在必要时使用
调用者
的包，这当然是经常使用的

确定打开句柄的读/写模式 以下是你问题的答案：

#!/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;
现在高兴了吗，Schwern？☺

不确定这是否正确。我认为这只是测试文件句柄是否已打开可写文件，而不是测试文件句柄本身是否可写。请使用您有权限写入的文件尝试第一个示例。mobrule是否正确。
-w
测试打开文件句柄的文件是否可写，而不是测试文件句柄是否可写已在写模式下打开。这解释了为什么第二个文件句柄看起来是可读的（尽管只在写模式下打开）我必须承认，这确实让我感到奇怪。请注意，的答案忽略了。为什么不很好地记录您的模块，即调用方需要给您一个合法的可写句柄，然后死亡，或者如果传递的句柄不可写，则优雅地处理错误？我是否遗漏了什么？@drewk die在什么情况下？如何识别错误引用的代码无法可靠地确定标量值是否包含文件句柄！！@tchrist好吧，然后对这些答案进行评论，或者发布一个包含文件句柄的答案。坏了吗？修复它！fcntl似乎是我追求的解决方案，尽管它提醒我为什么我从来都不喜欢C。这应该是IO:：Handle上的API。大多数现代人更喜欢
Try:：Tiny<“代码> >代码> Traskcatch 。考虑一下。Randal Schwartz：我将尝试：：Time.我想您仍然必须重定向$sig {警告}以用于Trycatch。“仅凭警告？我想我可以试试……@Randal Schwartz:我确实试过：：Tiny。它不捕捉警告。只有致命错误。Try:：Tiny小巧优雅，但它不允许像TryCatch那样捕获具有类型约束的各种类型的异常——这两种类型在现代Perl中都有用途。TryCatch由于其所依赖的Devel:：Declare已失效而被破坏。使用它可以像在其他编程语言中一样真实完整地实现try-catch块，包括with-catch、变量赋值和finally.Yes。你知道吗，Stack Overflow会将10%的评论发送给月球上的饥饿儿童？因此，请确保在你的评论中不要留下少于15个字符。想想Mooninites，这行代码的作用是什么：
eval{$flags{$\u}=main->$\u}对于grep/^O/，keys%：
@Jakub它计算出当前系统的所有O_*标志名称和数字，并对O进行哈希运算

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



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



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