如何在 Perl 程序中查找打开的全局文件句柄

Question

我刚刚发现一个问题，我必须关闭所有打开的文件句柄才能让我的 Apache cgi 脚本继续。我将问题追溯到 Parse::RecDescent。

#!/usr/bin/env perl

use strict;
use warnings;
use feature qw/say/;
$|++;

print "Content-Type: text/plain\n\n";

use Parse::RecDescent;

say "$$: pre-fork: ". time;

if(my $pid = fork) {
    # parent
    say "$$: return immediately: ". time;
}
else {
    # child 
    say "$$: kicked off big process: ". time;
    close STDIN;
    close STDOUT;
    close STDERR;
    # close *{'Parse::RecDescent::ERROR'};
    sleep 5;
}

我的问题是如何找到所有打开的包文件句柄？

我知道 fileno 会返回一个打开的文件句柄的计数器。 有没有办法对这些进行反向查找，或者通过其 fileno 计数器关闭文件句柄？

Answer 1

在某些系统上，“/proc/$$/fd/”返回的目录包含打开文件描述符的列表。您可以使用 POSIX::close 来关闭它们。

# close all filehandles
for (glob "/proc/$/fd/*") { POSIX::close($1) if m{/(\d+)$}; }

Answer 2

当出于 ikegami 的好奇心追踪 close-on-exec 详细信息时，我想我发现您需要做的就是关闭 STDIN、STDOUT 和 STDERR< /code> 自己，如果您只是执行另一个进程：

   $SYSTEM_FD_MAX
   $^F     The maximum system file descriptor, ordinarily 2.
           System file descriptors are passed to exec()ed
           processes, while higher file descriptors are not.
           Also, during an open(), system file descriptors are
           preserved even if the open() fails.  (Ordinary file
           descriptors are closed before the open() is
           attempted.)  The close-on-exec status of a file
           descriptor will be decided according to the value of
           $^F when the corresponding file, pipe, or socket was
           opened, not the time of the exec().

当然，如果您的长期任务不需要 execve(2) 调用来运行，那么 close-on-exec 标志将不会'对你一点帮助都没有。这完全取决于 sleep 5 的替代品。

Answer 3

您可以向下浏览包树：

use strict;
use warnings;
use constant BREAK_DESCENT => {};

use Carp    qw<croak>;
use English qw<$EVAL_ERROR>; # $@

sub break_descent { 
    return BREAK_DESCENT if defined wantarray;
    die BREAK_DESCENT;
}

sub _package_descend {
    my ( $package_name, $stash, $selector ) = @_;
    my $in_main     = $package_name =~ m/^(?:main)?::$/; 
    foreach my $name ( keys %$stash ) { 
        next if ( $in_main and $name eq 'main::' );
        my $full_name = $package_name . $name;
        local $_      = do { no strict 'refs'; \*$full_name; };
        my $return 
            = $name =~ m/::$/ 
            ? _package_descend( $full_name, *{$_}{HASH}, $selector ) 
            : $selector->( $package_name, $name => $_ )
            ;
        return BREAK_DESCENT if ( ref( $return ) and $return == BREAK_DESCENT );
    }
    return;
}

sub package_walk {

    my ( $package_name, $selector ) 
        = @_ == 1 ? ( '::', shift )
        :           @_
        ;

    $package_name  .= '::' unless substr( $package_name, -2 ) eq '::';
    local $EVAL_ERROR;

    eval { 
       no strict 'refs';
       _package_descend( $package_name, \%$package_name, $selector ); 
    };

    return unless $EVAL_ERROR;
    return if     do { no warnings 'numeric'; $EVAL_ERROR == BREAK_DESCENT; };

    say STDERR $EVAL_ERROR;
    croak( 'Failed in selector!' );
}

package_walk( sub { 
    my ( $pkg, $name ) = @_;
    #say "$pkg$name";
    # to not close handles in ::main::
    #return if $pkg =~  m/^(?:main)?::$/;
    # use IO::Handle methods...
    map { defined and $_->opened and $_->close } *{$_}{IO}; 
});

Answer 4

使用保留其创建的所有句柄列表的版本来全局覆盖 open 怎么样？像这样的事情可能是一个开始：

use Scalar::Util 'weaken';
use Symbol ();
my @handles;
BEGIN {
    *CORE::GLOBAL::open = sub (*;$@) {
        if (defined $_[0] and not ref $_[0]) {
            splice @_, 0, 1, Symbol::qualify_to_ref($_[0])
        }
        my $ret =
            @_ == 1 ? CORE::open $_[0] :
            @_ == 2 ? CORE::open $_[0], $_[1] :
                      CORE::open $_[0], $_[1], @_[2 .. $#_];
        if ($ret) {
            push @handles, $_[0];
            weaken $handles[-1];
        }
        $ret
    }
}

sub close_all_handles {
    $_ and eval {close $_} for @handles
}

open FH, $0;

say scalar <FH>;  # prints "use Scalar::Util 'weaken';"

close_all_handles;

say scalar <FH>;  # error: readline() on closed file handle

这应该捕获所有全局句柄，甚至任何已创建但从未清理过的词法句柄（由于循环引用或其他原因）。

如果您将此覆盖（BEGIN 块）放在对 use Parse::RecDescent 的调用之前，那么它将覆盖对 open 的调用，模块使.

Answer 5

我最终使用了@ikegami的建议，但我对@Axeman的方法感兴趣。这是一个简化版本。

# Find all file-handles in packages.
my %seen;
sub recurse {
    no strict 'refs';
    my $package = shift or return;
    return if $seen{$package}++;

    for my $part (sort keys %{$package}) {
        if (my $fileno = fileno($package.$part)) {
            print $package.$part." => $fileno\n";
        }
    }
    for my $part (grep /::/, sort keys %{$package}) {
        (my $sub_pkg = $package.$part) =~ s/main:://;
        recurse($sub_pkg);
    }
}
recurse('main::');