Re: A way to report open file handles a Perl script has open? -- using ${^LAST_FH} ?

[Discipulus]

Hello nysus,

For sure the best thing to do is to open always lexical filehandles to let Perl close them for you. The habit to close them esplicitally is a sane one anyway.

Extra scope can help if you have many declared into the top scope.

But the strange behaviour you announce (leaking file handles like a sieve)

I'd expand the mr_mischief's solution: take count of what you open.

You can override open builtin function very soon in the program or in a BEGIN block, and you can profit of the ${^LAST_FH} special variable: if I understand the doc correctly it tracks the last open $fh (only read-fh ?) taking a reference to it

You probably need to override close to erase from your tracking variable.

An END block can dump the tracking datastructure.

So given a %fhs in the outher scope you can store there your fh

# TOTALLY UNTESTED!!
no warning 'redefine';

my %fhs;

BEGIN {
        *CORE::GLOBAL::open = sub { 
          my ($fh,$mode,$path) = @_;
          
          # open the file
          
          $fhs{fileno($fh)} = $path.' '.${^LAST_FH};
      };
    }


END{
     print "Files already opened:\n", map {"fileno $_ $fhs{$_}\n"} sor
+t keys %fhs;
}

PS sorry the node was composed on a spare PC where was impossible to test anything..

L*

[shmem]

Nice. A sub wrapping open before overriding is missing... and for close. Combining your and my approach:

At toplevel:

use Hash::Util::FieldHash qw(id_2obj);

my %fd;

BEGIN{
    Hash::Util::FieldHash::fieldhash %fd;
    my $open = sub {
        @_ > 2 ? open $_[0],$_[1],$_[2] : open $_[0], $_[1];
    };
    my $close = sub { close $_[0] };

    *CORE::GLOBAL::open = sub {
        my $result = $open->(@_);
        if ($result) {
            $fd{$_[0]} = join " ",@_[1,2],caller;
        }
        $result;
    };
    *CORE::GLOBAL::close = sub {
        my $result = $close->(@_);
        if ($result) {
            $fd{$_[0]} .= " (closed)";
        } else {
            $fd{$_[0]} .= " (close failed)";
        }
        $result;
    };
}

open my $devnull, '>/dev/null' or die;

{
    open my $fh, '>', "blorfldyick" or die;
    print $fh "foo!\n" or die;
    print "(1) ", id_2obj($_), " => $fd{$_}\n" for keys %fd;
    close $fh;
    print "after close\n";
    print "(2) ", id_2obj($_), " => $fd{$_}\n" for keys %fd;
}
print "after scope:\n";
print "(3) ", id_2obj($_), " => $fd{$_}\n" for keys %fd;

open my $devzero, '<', '/dev/zero' or die;

# time passes...

print "later:\n";
print "(4) ", id_2obj($_), " => $fd{$_}\n" for keys %fd;
__END__
(1) GLOB(0xb22190) => >/dev/null  main open.pl 29
(1) GLOB(0xb63780) => > blorfldyick main open.pl 32
after close
(2) GLOB(0xb22190) => >/dev/null  main open.pl 29
(2) GLOB(0xb63780) => > blorfldyick main open.pl 32 (closed)
after scope:
(3) GLOB(0xb22190) => >/dev/null  main open.pl 29
later:
(4) GLOB(0xb363b8) => < /dev/zero main open.pl 42
(4) GLOB(0xb22190) => >/dev/null  main open.pl 29

Combine with Time::HiRes and you can sort the history.

update: done, made into a package.

[huck]

That is a neat trick i need to remember