Cách tìm tập tin mở toàn cầu trong một chương trình perl

Question

Tôi vừa theo dõi một vấn đề mà tôi phải đóng tất cả các tập tin mở cho tập lệnh Apache cgi của mình để tiếp tục. Tôi đã theo dõi vấn đề với 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; 
} 

Câu hỏi của tôi là làm cách nào để tìm tất cả các tệp mở gói?

Tôi biết fileno sẽ trả lại bộ đếm cho một tệp mở. Có cách nào để thực hiện tra cứu ngược lại các mục này hoặc đóng các tập tin bằng bộ đếm fileno không?

Answer 1

Trên một số hệ thống, thư mục được trả về bởi "/proc/$$/fd/" chứa danh sách các bộ mô tả tệp đang mở. Bạn có thể sử dụng POSIX::close để đóng chúng.

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

Answer 2

Bạn có thể đi xuống qua cây gói:

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 3

gì về trọng trên toàn cầu open với một phiên bản mà giữ một danh sách của tất cả các xử lý nó tạo ra? Một cái gì đó như thế này có thể là một sự khởi đầu:

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 

Điều này sẽ nắm bắt tất cả các xử lý toàn cầu, nhưng không bao giờ được làm sạch (do tham chiếu vòng tròn hoặc các lý do khác).

Nếu bạn đặt ghi đè này (khối BEGIN) trước khi gọi tới use Parse::RecDescent thì nó sẽ ghi đè các cuộc gọi đến open mà mô-đun tạo ra.

Answer 4

Tôi đã kết thúc bằng đề xuất @ ikegami nhưng tôi đã quan tâm đến phương pháp @ Axeman. Đây là một phiên bản đơn giản.

# 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::'); 

Answer 5

Khi theo dõi xuống các chi tiết gần-on-exec cho sự tò mò Ikegami, tôi nghĩ rằng tôi thấy rằng tất cả các bạn cần làm là gần STDIN, STDOUT, và STDERR mình nếu bạn chỉ đơn giản là thực hiện một tiến trình khác:

$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(). 

Tất nhiên, nếu tác vụ lâu dài của bạn không yêu cầu cuộc gọi execve(2) để chạy, thì cờ close-on-exec sẽ không giúp bạn gì cả. Tất cả phụ thuộc vào những gì sleep 5 là một stand-in cho.