确定标量是否拥有文件句柄的最佳方法是什么？

Question

我想确定一个给定的标量是否拥有一个文件句柄。它可能已经从一个纯粹的文件句柄（即\*FH），一个词法文件句柄，一个IO :: Handle，一个IO :: File等等传递给我。到目前为止，似乎在各种风格中一致的唯一东西是他们都有reftype的"GLOB"。

Answer 1

使用来自Scalar::Util的openhandle功能：

openhandle FH

返回FH如果FH可以用作 文件句柄并且是打开的，或者FH是 并列句柄。否则，undef返回 。

$fh = openhandle(*STDIN);   # \*STDIN 
    $fh = openhandle(\*STDIN);   # \*STDIN 
    $fh = openhandle(*NOTOPEN);   # undef 
    $fh = openhandle("scalar");   # undef 

当前实现类似于Greg Bacon's answer，但它有一些额外的测试。

Answer 2

请记住，你可以这样做：

$ perl -le '$fh = "STDOUT"; print $fh "Hi there"' 
Hi there

这是一个普通的字符串，但作为一个文件句柄还是有用的。

望着source of IO::Handle，其opened是一个简单包装的fileno，它有一个方便的特性：

返回一个文件句柄的文件描述符，或未定义如果该文件句柄不开。

但有一点需要注意：

文件句柄通过开放新功能连接到内存中的对象可能会返回即使他们是开放的定义。

看来然后沿的

$@ = ""; 
my $fd = eval { fileno $maybefh }; 
my $valid = !$@ && defined $fd; 

线测试会做你想要什么。

下面的

内存
• 检查代表该代码对象
• 命名的文件句柄
• 水珠
• 水珠引用
• 水珠名称
• 标准输入
• FileHandle实例
• IO::File实例
• 管
• 的FIFO
• 插座

运行它自己：

#! /usr/bin/perl 

use warnings; 
use strict; 

use Fatal qw/ open /; 
use FileHandle; 
use IO::File; 
use IO::Socket::INET; 

my $SLEEP = 5; 
my $FIFO = "/tmp/myfifo"; 

unlink $FIFO; 
my $pid = fork; 
die "$0: fork" unless defined $pid; 
if ($pid == 0) { 
    system("mknod", $FIFO, "p") == 0 or die "$0: mknod failed"; 
    open my $fh, ">", $FIFO; 
    sleep $SLEEP; 
    exit 0; 
} 
else { 
    sleep 1 while !-e $FIFO; 
} 

my @ignored = (\*FH1,\*FH2); 
my @handles = (
    [0, "1",   1], 
    [0, "hashref",  {}], 
    [0, "arrayref", []], 
    [0, "globref",  \*INC], 
    [1, "in-memory", do {{ my $buf; open my $fh, "<", \$buf; $fh }}], 
    [1, "FH1 glob", do {{ open FH1, "<", "/dev/null"; *FH1 }}], 
    [1, "FH2 globref", do {{ open FH2, "<", "/dev/null"; \*FH2 }}], 
    [1, "FH3 string", do {{ open FH3, "<", "/dev/null"; "FH3" }}], 
    [1, "STDIN glob", \*STDIN], 
    [1, "plain read", do {{ open my $fh, "<", "/dev/null"; $fh }}], 
    [1, "plain write", do {{ open my $fh, ">", "/dev/null"; $fh }}], 
    [1, "FH read",  FileHandle->new("< /dev/null")], 
    [1, "FH write", FileHandle->new("> /dev/null")], 
    [1, "I::F read", IO::File->new("< /dev/null")], 
    [1, "I::F write", IO::File->new("> /dev/null")], 
    [1, "pipe read", do {{ open my $fh, "sleep $SLEEP |"; $fh }}], 
    [1, "pipe write", do {{ open my $fh, "| sleep $SLEEP"; $fh }}], 
    [1, "FIFO read", do {{ open my $fh, "<", $FIFO; $fh }}], 
    [1, "socket",  IO::Socket::INET->new(PeerAddr => "localhost:80")], 
); 

sub valid { 
    local $@; 
    my $fd = eval { fileno $_[0] }; 
    !$@ && defined $fd; 
} 

for (@handles) { 
    my($expect,$desc,$fh) = @$_; 
    print "$desc: "; 

    my $valid = valid $fh; 
    if (!$expect) { 
    print $valid ? "FAIL\n" : "PASS\n"; 
    next; 
    } 

    if ($valid) { 
    close $fh; 
    $valid = valid $fh; 
    print $valid ? "FAIL\n" : "PASS\n"; 
    } 
    else { 
    print "FAIL\n"; 
    } 
} 

print "Waiting for sleeps to finish...\n"; 

所有经过的Ubuntu 9.10中，这样的告诫关于在内存中的对象至少在该平台上似乎并不是一个问题。

1: PASS 
hashref: PASS 
arrayref: PASS 
globref: PASS 
in-memory: PASS 
FH1 glob: PASS 
FH2 globref: PASS 
FH3 string: PASS 
STDIN glob: PASS 
plain read: PASS 
plain write: PASS 
FH read: PASS 
FH write: PASS 
I::F read: PASS 
I::F write: PASS 
pipe read: PASS 
pipe write: PASS 
FIFO read: PASS 
socket: PASS

Answer 3

下面是File::Copy摘录确定变量是否是一个文件句柄：

my $from_a_handle = (ref($from) 
    ? (ref($from) eq 'GLOB' 
     || UNIVERSAL::isa($from, 'GLOB') 
     || UNIVERSAL::isa($from, 'IO::Handle')) 
    : (ref(\$from) eq 'GLOB')); 

Answer 4

io_from_any from IO::Handle::Util负责将任何东西升级为理智的东西。

Answer 5

但是任何标量包含可以用作文件句柄的东西。字符串可以是文件句柄：然后，它们是包句柄。

我们以前一直习惯使用Symbol::qualify()。我不知道这是否仍然是“普遍倡导的”方式，但是如果您通过裸字句柄（它们只是字符串），它就会起作用。它会检查caller的包装，并对其进行适当的限定。 这里也是Symbol::qualify_to_ref()，这可能更接近你要找的东西。

以下是他们如何工作。在下面的输出：

1. 在=的第一个项目>列表是什么获取由qualify
2. 在=>列表中的第二项进行是什么获取由qualify_to_ref
3. 在第三项由=>清单显示在第二项文件fileno返回

产生这种情况的脚本包含如下：

off to NotMain 
string "stderr"  => main::stderr, GLOB(0x811720), fileno 2 
string *stderr  => *NotMain::stderr, GLOB(0x879ec0), fileno undef 
string *sneeze  => *NotMain::sneeze, GLOB(0x811e90), fileno undef 
string *STDERR  => *main::STDERR, GLOB(0x835260), fileno 2 
back to main 
string *stderr  => *main::stderr, GLOB(0x879ec0), fileno 2 
string "STDOUT"  => main::STDOUT, GLOB(0x8116c0), fileno 1 
string *STDOUT  => *main::STDOUT, GLOB(0x811e90), fileno 1 
string *STDOUT{IO} => IO::File=IO(0x8116d0), GLOB(0x811e90), fileno 1 
string \*STDOUT  => GLOB(0x8116c0), GLOB(0x8116c0), fileno 1 
string "sneezy"  => main::sneezy, GLOB(0x879ec0), fileno undef 
string "hard to type" => main::hard to type, GLOB(0x8039e0), fileno 3 
string $new_fh   => IO::Handle=GLOB(0x8046c0), IO::Handle=GLOB(0x8046c0), fileno undef 
string "GLOBAL"  => main::GLOBAL, GLOB(0x891ff0), fileno 3 
string *GLOBAL   => *main::GLOBAL, GLOB(0x835260), fileno 3 
string $GLOBAL   => main::/dev/null, GLOB(0x817320), fileno 3 
string $null   => GLOB(0x8907d0), GLOB(0x8907d0), fileno 4 

off to NotMain 
    glob "stderr"  => main::stderr, GLOB(0x811720), fileno 2 
    glob  stderr  => main::stderr, GLOB(0x811720), fileno 2 
    glob  sneeze  => main::sneeze, GLOB(0x81e490), fileno undef 
    glob *sneeze  => GLOB(0x892b90), GLOB(0x892b90), fileno undef 
    glob *stderr  => GLOB(0x892710), GLOB(0x892710), fileno undef 
    glob *STDERR  => GLOB(0x811700), GLOB(0x811700), fileno 2 
back to main 
    glob *stderr  => GLOB(0x811720), GLOB(0x811720), fileno 2 
    glob  STDOUT  => main::STDOUT, GLOB(0x8116c0), fileno 1 
    glob "STDOUT"  => main::STDOUT, GLOB(0x8116c0), fileno 1 
    glob *STDOUT  => GLOB(0x8116c0), GLOB(0x8116c0), fileno 1 
    glob *STDOUT{IO} => IO::File=IO(0x8116d0), GLOB(0x811d50), fileno 1 
    glob \*STDOUT  => GLOB(0x8116c0), GLOB(0x8116c0), fileno 1 
    glob sneezy   => main::sneezy, GLOB(0x879ec0), fileno undef 
    glob "sneezy"  => main::sneezy, GLOB(0x879ec0), fileno undef 
    glob "hard to type" => main::hard to type, GLOB(0x8039e0), fileno 3 
    glob $new_fh   => IO::Handle=GLOB(0x8046c0), IO::Handle=GLOB(0x8046c0), fileno undef 
    glob GLOBAL   => main::GLOBAL, GLOB(0x891ff0), fileno 3 
    glob $GLOBAL   => main::/dev/null, GLOB(0x817320), fileno 3 
    glob *GLOBAL   => GLOB(0x891ff0), GLOB(0x891ff0), fileno 3 
    glob $null   => GLOB(0x8907d0), GLOB(0x8907d0), fileno 4 

及这里的生成输出脚本：

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") } # nyah nyah nyah-NYAH nhah!! 
#undef exec 

#define CPP(FN, ARG) printf(" %6s %s => %s\n", main::short("FN"), q(ARG), FN(ARG)) 
#define QS(ARG)  CPP(main::qual_string, ARG) 
#define QG(ARG)  CPP(main::qual_glob, ARG) 
#define NL   say "" 

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, "/dev/null"); 

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

    fake_qs(); 

    QS( *stderr  ); 
    QS( "STDOUT"  ); 
    QS( *STDOUT  ); 
    QS( *STDOUT{IO} ); 
    QS(\*STDOUT  ); 
    QS("sneezy"  ); 
    QS("hard to type"); 
    QS($new_fh  ); 
    QS("GLOBAL"  ); 
    QS(*GLOBAL  ); 
    QS($GLOBAL  ); 
    QS($null   ); 

    NL; 

    fake_qg(); 

    QG( *stderr  ); 
    QG( STDOUT  ); 
    QG( "STDOUT"  ); 
    QG( *STDOUT  ); 
    QG( *STDOUT{IO} ); 
    QG(\*STDOUT  ); 
    QG( sneezy  ); 
    QG("sneezy"  ); 
    QG("hard to type"); 
    QG($new_fh  ); 
    QG( GLOBAL  ); 
    QG($GLOBAL  ); 
    QG(*GLOBAL  ); 
    QG($null   ); 

    NL; 

} 

package main; 

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


sub fake_qg { &NotMain::fake_qg } 
sub fake_qs { &NotMain::fake_qs } 

package NotMain; # this is just wicked 

sub fake_qg { 
    say "off to NotMain"; 
    QG( "stderr"  ); 
    QG( stderr  ); 
    QG( sneeze  ); 
    QG( *sneeze  ); 
    QG( *stderr  ); 
    QG( *STDERR  ); 
    say "back to main"; 
} 

sub fake_qs { 
    say "off to NotMain"; 
    package NotMain; 
    QS( "stderr"  ); 
    QS( *stderr  ); 
    QS( *sneeze  ); 
    QS( *STDERR  ); 
    say "back to main"; 
} 

我能说什么？有时我真的很想念C预处理器。

我只是知道这个人会让我谈论。 ☺

Answer 6

我倾向于使用：

eval { $fh->can('readline') } 

，或者可以在手柄的情况下（“打印”），我打算就写。这主要是因为我真的只想用OO方式处理文件句柄，所以这能够准确地解决目标是否能做到我期望的。如果您已经检查了正在定义的$ fh，则可以忽略该eval。