确定标量是否包含文件句柄的最佳方法是什么?

使用 openhandle 函数从 Scalar::Util :

openhandle FH

如果fh可用作 文件句柄打开,或者fh是 系带手柄。否则,undef是 返回。

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

当前的实现类似于 Greg Bacon's answer 但是它还有一些附加的测试。

请记住,您可以这样做:

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

这是一个普通的字符串,但仍然可以用作文件句柄。

看着 source of IO::Handle 它的 opened 是个薄包装吗 fileno 具有便利的特性:

返回文件句柄的文件描述符,如果文件句柄未打开,则返回未定义的文件描述符。

但有一点需要注意:

通过open的新功能连接到内存对象的文件句柄可能返回未定义的,即使它们是打开的。

然后,一个沿着

$@ = "";
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";

所有的代码都在一个Ubuntu9.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 __s软件包,对其进行适当的限定。 这里还有 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预处理器。

我只是 知道 这一个会让我谈起的。艾斯

这是摘录 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'));

io_from_any from IO::Handle::Util 注意把任何东西升级到正常的状态。

我倾向于使用:

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

或者可以(“打印”)在我打算写信给的情况下处理。这主要是因为我真的只想以OO方式处理文件句柄,所以这准确地解决了目标是否可以做我期望的事情。如果您已经检查了正在定义的$fh,您可能可以不进行评估。