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

Question

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

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

为了做到这一点,我必须测试第一个输入var是否是文件句柄.我通过阅读这个问题想出了如何做到这一点.

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

这就是我想要做的事情:

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;
  }
  ...
}

Run Code Online (Sandbox Code Playgroud)

我需要知道的是,如果我可以写入文件句柄,虽然看到一些通用解决方案可以告诉您是否使用">>"或"<"打开文件句柄,或者如果不是开放等

(请注意,这个问题是相关的,但似乎没有回答我的问题.)

Answer 1

tch*_*ist 13

检测手柄的开放性

正如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);

Run Code Online (Sandbox Code Playgroud)

产生

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

Run Code Online (Sandbox Code Playgroud)

如你所见,你不能使用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;
}

Run Code Online (Sandbox Code Playgroud)

哪个运行时产生:

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

Run Code Online (Sandbox Code Playgroud)

这就是你测试打开文件句柄的方法!

但我相信,这甚至不是你的问题.

尽管如此,我觉得它需要解决,因为有太多不正确的解决方案来解决这个问题.人们需要睁开眼睛看看这些东西是如何运作的.请注意,如果需要,这两个函数可以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;

Run Code Online (Sandbox Code Playgroud)

运行时,会产生以下输出:

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

Run Code Online (Sandbox Code Playgroud)

Schwern,现在开心吗？☺

是.您是否知道Stack Overflow会将每条评论的10%发送给月球上的饥饿儿童？所以,请务必在评论中留下少于15个字符.想想Mooninites. (4认同)
为什么？⁠⁠⁠⁠⁠⁠⁠⁠⁠⁠☺ (2认同)
@Jakub它确定了当前系统的所有O_*标志名称和数字,并对它们进行哈希处理. (2认同)
`%::`(`%main ::`)是主符号表,而`main - > $ _`是为了避免调用子程序(这就是[常量](http://p3rl.org/constant)所在的Perl)按名称(这将要求`没有严格的'refs';`,不是吗？我理解正确吗？好戏! (2认同)

Answer 2

mob*_*mob 7

还在试验这个,但也许你可以尝试一个零字节的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 ""
}

Run Code Online (Sandbox Code Playgroud)

fcntl看起来很有希望.您的里程可能会有所不同,但这样的事情可能会在正确的轨道上:

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

Run Code Online (Sandbox Code Playgroud)

这真的应该是IO :: Handle上的API. (3认同)

归档时间：	14 年，11 月前
查看次数：	4351 次
最近记录：	14 年，9 月前