检测句柄的开放性
正如 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);
生产
NULL is opened.
NULL is not openhandled.
NULL is fd 3.
如您所见，您不能使用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;
}
运行时产生的结果：
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 中的两个函数在必要时会使用 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;
运行时会产生以下输出：
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
现在开心吗，施韦恩？ ☺