我试图确定给定的标量是否包含文件句柄.它本来可以从一个裸字文件句柄(即\*FH),一个词法文件句柄,一个IO ::句柄,一个IO ::文件等传递给我.到目前为止,在各种风格中唯一似乎是一致的是它们都有reftype的"GLOB".
cjm*_*cjm 24
使用Scalar :: Util的openhandle函数:
openhandle FH如果FH可以用作文件句柄并且打开,或者FH是绑定句柄,则返回FH.否则返回undef.
Run Code Online (Sandbox Code Playgroud)$fh = openhandle(*STDIN); # \*STDIN $fh = openhandle(\*STDIN); # \*STDIN $fh = openhandle(*NOTOPEN); # undef $fh = openhandle("scalar"); # undef
目前的实现类似于Greg Bacon的答案,但它还有一些额外的测试.
Gre*_*con 13
请记住,你可以这样做:
$ perl -le '$fh = "STDOUT"; print $fh "Hi there"' Hi there
这是一个普通的字符串,但仍然可用作文件句柄.
看看它的来源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
但是任何标量都包含可以用作文件句柄的东西。字符串可以是文件句柄：它们是包句柄。
我们总是用来Symbol::qualify()做这个。我不知道这是否仍然是普遍提倡的“方式”，但是如果您传递的是裸字句柄（它们只是字符串），它将起作用。它检查caller的包，适当地限定它。这里还有Symbol::qualify_to_ref()，它可能更接近您要查找的内容。
这是它们的工作方式。在下面的输出中：
qualifyqualify_to_reffileno第二项的文件返回产生这个的脚本包括在下面：
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 预处理器。
我只知道这个会让我谈论。?
| 归档时间： |
|
| 查看次数： |
3602 次 |
| 最近记录： |