Come trovare filehandle globali aperti in un programma perl

Question

Ho appena rintracciato un problema in cui dovevo chiudere tutti i filehandle aperti per il mio script cgi Apache per continuare. Ho tracciato il problema su 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; 
} 

La mia domanda è: come trovare tutti i filehandle aperti del pacchetto?

So che fileno restituirà un contatore per un filehandle aperto. C'è un modo per fare una ricerca inversa per questi, o chiudere filehandle dal loro contatore fileno?

Answer 1

Su alcuni sistemi, la directory restituita da "/proc/$$/fd/" contiene l'elenco di descrittori di file aperti. Potresti usare POSIX::close per chiuderli.

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

Answer 2

Si può scendere attraverso l'albero dei pacchetti:

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

Che dire di override a livello globale open con una versione che mantiene un elenco di tutte le maniglie che crea? Qualcosa di simile potrebbe essere un inizio:

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 

Questo dovrebbe prendere tutti i manici a livello mondiale, e anche le eventuali maniglie lessicali che ha ottenuto create, ma non sono mai stati puliti fino (a causa di riferimenti circolari o altri motivi).

Se si posiziona questo comando prioritario (il blocco BEGIN) prima della chiamata a use Parse::RecDescent, allora sostituirà le chiamate a open eseguite dal modulo.

Answer 4

Ho finito per usare il suggerimento di @ ikegami, ma mi interessava il metodo di @ Axeman. Ecco una versione semplificata.

# 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

Quando rintracciare i dettagli close-on-exec per la curiosità di Ikegami, penso che ho trovato che tutto quello che dovete fare è chiudere STDIN, STDOUT e STDERR voi stessi se siete semplicemente eseguendo un altro processo:

Ovviamente, se la tua attività di lunga durata non richiede una chiamata execve(2) per l'esecuzione, il flag close-on-exec non ti aiuterà affatto. Tutto dipende da cosa è lo standard sleep 5.