एक पर्ल प्रोग्राम

Question

में खुली वैश्विक फ़ाइल हैंडल कैसे खोजें I मैंने अभी एक समस्या को ट्रैक किया है जहां मुझे जारी रखने के लिए मेरे अपाचे सीजीआई स्क्रिप्ट के लिए सभी खुले फ़ाइल हैंडल बंद करना था। मैंने पार्स :: रिकडेसेंट को समस्या का पता लगाया।

#!/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

आप पैकेज पेड़ के माध्यम से उतर सकते हैं:

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

क्या विश्व स्तर पर एक संस्करण है कि हैंडल यह बनाता है के सभी की एक सूची रखता है साथ 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 

यह वैश्विक हैंडल के सभी को पकड़ने चाहिए, और यहां तक ​​कि किसी भी शाब्दिक हैंडल बना लिया गया है कि लेकिन (वृत्तीय संदर्भ या अन्य कारणों की वजह से) साफ कभी नहीं गया: कुछ इस तरह एक शुरुआत हो सकता है।

यदि आप use Parse::RecDescent पर कॉल करने से पहले इस ओवरराइड (BEGIN ब्लॉक) को स्थानांतरित करते हैं तो यह कॉल open पर कॉल को ओवरराइड करेगा जो मॉड्यूल बनाता है।

Answer 4

मैं @ ikegami के सुझाव का उपयोग कर समाप्त हुआ लेकिन मुझे @ एक्समन की विधि में रूचि थी। यहां एक सरलीकृत संस्करण है।

# 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

जब Ikegami की जिज्ञासा के लिए करीब-ऑन-कार्यकारी विवरण पर नज़र रखने, मैं मैंने पाया कि करीब STDIN है तुम सब करने की जरूरत है, STDOUT लगता है, और STDERR खुद अगर आप बस किसी अन्य प्रक्रिया को क्रियान्वित कर रहे हैं:

$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) चलाने के लिए कॉल की आवश्यकता नहीं है, तो क्लोज-ऑन-फ़ोर ध्वज आपकी सहायता नहीं करेगा। यह सब इस बात पर निर्भर करता है कि sleep 5 किसके लिए स्टैंड-इन है।