【问题标题】:What is the best way to determine if a scalar holds a filehandle?确定标量是否包含文件句柄的最佳方法是什么?
【发布时间】:2010-07-09 16:31:55
【问题描述】:

我正在尝试确定给定的标量是否包含文件句柄。它可能是从一个裸字文件句柄(即\*FH)、一个词法文件句柄、一个 IO::Handle、一个 IO::File 等传递给我的。到目前为止,唯一似乎在各种文件中是一致的风味是它们都有reftype"GLOB"

【问题讨论】:

  • 糟糕,抱歉,这不是一个完全的骗局。我希望我能收回那票势均力敌的投票! (但链接仍然有些相关。)
  • 目的只是为了验证输入参数,还是根据变量类型提供不同的行为(例如,如果传入字符串则打开文件)?最好的办法可能是把它当作一个文件句柄来对待,如果它不像一个文件句柄就抛出一个异常。
  • 如果它是一个普通的标量我想尝试在标量中打开一个具有该名称的文件,如果它已经是一个文件句柄我想使用文件句柄。

标签: perl


【解决方案1】:

使用Scalar::Util中的openhandle函数:

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,但有一些额外的测试。

【讨论】:

    【解决方案2】:

    记住你可以这样做:

    $ perl -le '$fh = "STDOUT";打印 $fh "你好"'
    你好

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

    查看source of IO::Handle,它的openedfileno 的薄包装,它有一个方便的属性:

    返回文件句柄的文件描述符,如果文件句柄未打开,则返回 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:通过
    哈希引用:通过
    数组引用:通过
    全局引用:通过
    内存中:通过
    FH1 全局:通过
    FH2 全局引用:通过
    FH3 字符串:PASS
    标准输入:通过
    普通阅读:通过
    纯写:通过
    FH 读取:通过
    FH 写:通过
    I::F 读取:通过
    I::F 写:通过
    管道读取:通过
    管道写入:通过
    FIFO读取:通过
    套接字:通过

    【讨论】:

    • 看起来tell 不可移植并且无法检测到有效的东西:“标准流(如 STDIN)的tell() 的返回值取决于操作系统:它可能返回 -1或其他东西。管道、fifo 和套接字上的 tell() 通常返回 -1。"
    • 真的很酷。让我想知道为什么 CPAN 上还没有这样的东西。
    • @Robert P,有。它被称为openhandle in Scalar::Util。见my answer
    • 看起来openhandle 未能通过“FH3 字符串”测试,但这可能是正确的响应。
    【解决方案3】:

    但是 any 标量包含可以用作文件句柄的东西。字符串可以是文件句柄:那么它们就是包句柄。

    为此,我们一直使用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 预处理器。

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

    【讨论】:

    • 嘿,看,那个被称为 perlcritic 的愚蠢的风袋甚至不依赖一元 open。显示他们知道什么!
    【解决方案4】:

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

    【讨论】:

      【解决方案5】:

      以下是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'));
      

      【讨论】:

      • Eww。 UNIVERSAL::isa 是做 ISA 的一种糟糕的糟糕方式。我更喜欢eval { $from-&gt;isa('GLOB') },这样继承和覆盖才能正常工作。所以说the isa documentation.。我的意思是,他们给出的不做什么的例子是$is_io = UNIVERSAL::isa($fd, "IO::Handle"); # BAD!
      • @Robert P:实际上对于 GLOB(和其他基本引用类型),最新的建议是使用 Scalar::Util::reftype()。虽然我有点同意这一切,但使用上面的代码会给你带来与核心模块 File::Copy 相同的结果,而且你必须付出一些努力才能让它不起作用。
      • @Robert P:我在 PerlMonks (perlmonks.org/?node_id=615015) 上对此进行了讨论,但对于当前的最佳实践没有真正确凿的答案。
      【解决方案6】:

      我倾向于使用:

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

      或者 can('print') 在我打算写入的句柄的情况下。这主要是因为我真的只想以 OO 方式处理文件句柄,所以这准确地解决了目标是否可以做我期望的事情。如果您已经检查了正在定义的 $fh,您可能可以省略 eval。

      【讨论】:

        猜你喜欢
        • 2023-03-18
        • 1970-01-01
        • 1970-01-01
        • 1970-01-01
        • 2010-09-24
        • 2020-08-09
        • 2023-03-15
        • 1970-01-01
        • 1970-01-01
        相关资源
        最近更新 更多