我正在尝试确定给定的标量是否包含文件句柄。它本来可以从一个裸字文件句柄（即\*FH），一个词法文件句柄，一个IO ::句柄，一个IO ::文件等传递给我。到目前为止，唯一似乎是一致的各种口味都是reftype "GLOB"。
答案 0 :(得分：24)
使用openhandle中的Scalar::Util功能：
openhandle FH如果FH可以用作a，则返回FH 文件句柄是打开的，或者FH是一个 捆绑手柄。否则undef是 返回。
$fh = openhandle(*STDIN); # \*STDIN $fh = openhandle(\*STDIN); # \*STDIN $fh = openhandle(*NOTOPEN); # undef $fh = openhandle("scalar"); # undef
当前的实现类似于Greg Bacon's answer，但它还有一些额外的测试。
答案 1 :(得分：13)
请记住，你可以这样做：
$ perl -le '$fh = "STDOUT"; print $fh "Hi there"' Hi there
这是一个普通的字符串，但仍可用作文件句柄。
查看source of IO::Handle，其opened是fileno周围的薄包装，有一个方便的属性：
返回文件句柄的文件描述符，如果文件句柄未打开则返回undefined。
但有一点需要注意：
通过open的新功能连接到内存对象的文件句柄可能会返回undefined，即使它们是打开的。
然后看来是
的测试$@ = "";
my $fd = eval { fileno $maybefh };
my $valid = !$@ && defined $fd;
会做你想做的事。
以下代码检查
的代表FileHandle个实例IO::File个实例自己动手：
#! /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
答案 2 :(得分：4)
但任何标量都包含可用作文件句柄的内容。字符串可以是文件句柄：它们是包句柄。
我们总是习惯使用Symbol::qualify()。我不知道这是否仍然是“通常提倡的”方式，但是如果你传递了裸字句柄（它只是字符串），它就会起作用。它会检查caller的包，并对其进行适当的限定。
这里也是Symbol::qualify_to_ref()，它可能更接近你正在寻找的东西。
以下是它们的工作方式。在下面的输出中：
qualify qualify_to_ref 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预处理器。
我只是知道这个会让我谈谈。 ☺
答案 3 :(得分：3)
io_from_any from IO::Handle::Util负责升级任何事情。
答案 4 :(得分：2)
以下摘录自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'));
答案 5 :(得分：0)
我倾向于使用：
eval { $fh->can('readline') }
或者在我打算写入的句柄的情况下可以（'print'）。这主要是因为我真的只想以OO方式处理文件句柄，所以这准确地解决了目标是否可以达到我期望的目标。如果你已经检查了定义的$ fh，你可以放弃eval。