http://qs1969.pair.com?node_id=1187272


in reply to Re: Track open file handles
in thread Track open file handles

Thank you for spotting the bug.

Also, I am not sure that would work for the cases where the second argument is a string with a file handler embedded, as for instance open($fh, ">&STDOUT") or its three-args form open($fh, ">&", "STDOUT"). You will probably need to prefix those names with the calling package name.

Yes, true. It's actually more complicated than that. A lexical filehandle is made into a GLOB reference by open. But since that open() happens in FileHandle::Track, the associated symbol is generated using that package and the lexical filehandle variable: 

package blorf;
open my $h,">","blorfldyick";
print $h,$/;
print *{$h},$/
__END__
GLOB(0xbf4e78)
*blorf::$h

[download]

I can see no way to circumvent that. Not that it matters much, because it doesn't matter to the lexical filehandle which holds the GLOB reference. It's just that e.g. Data::Dumper shows all filehandles as belonging to the FileHandle::Track package when dumping the hashref returned from get_fds... meh :-(

$VAR1 = {
  'GLOB(0x151ce78)' => {
    'fd' => \*{'FileHandle::Track::$_[...]'},
    'open' => 'GLOB(0x151ce78) > blorfldyick open main -e 1',
    'opentime' => '1491480967.655713'
  }
};

[download]
perl -le'print map{pack c,($-++?1:13)+ord}split//,ESEL'

Replies are listed 'Best First'.
Re^3: Track open file handles
by salva (Canon) on Apr 06, 2017 at 13:35 UTC
    Yes, true. It's actually more complicated than that. A lexical filehandle is made into a GLOB reference by open. But since that open() happens in FileHandle::Track, the associated symbol is generated using that package and the lexical filehandle variable

    Ah, but that is yet another different problem affecting only the name of the glob, which is something quite unimportant.

    I was talking about file handles passed as arguments by name. open looks for then into the caller package, so you would probably have to add specific code to handle those cases and qualify the file handle names yourself, or use some other trick, like creating the wrapper in the DB namespace, or using XS, etc.

    update:

    I can see no way to circumvent that

    Probably some module exists on CPAN allowing you to change the glob name.

[reply]
[d/l]
[select]
Re^3: Track open file handles
by Eily (Monsignor) on Apr 06, 2017 at 16:52 UTC

    How about $_[0] = eval "*".caller."::G".(0+\$_[0]) unless ref $_[0] eq "GLOB" or ref \$_[0]  eq "GLOB"; before the call to $open? This prevents the call to the standard open to autovivify a GLOB when none is available.

[reply]
[d/l]
      This prevents the call to the standard open to autovivify a GLOB when none is available.

      It shouldn't be prevented. If it autovivifies, I want to know about that. This Blorfldyick is meant to be transparent, while adding overhead and slowing things down... ;-)

      It's not easy, open is a complex beast. I'm reaching into the pile of rhinos... open can be provided a lexical var, a package var (populated or not), a typeglob, a bareword, a Symbol (via gensym) and what not, as the first argument. Trying to wrap my head around all that... thanks for your input, Eily++

      perl -le'print map{pack c,($-++?1:13)+ord}split//,ESEL'
[reply]
        In order to avoid the wrong caller package issue, you can create a wrapping sub for open in the caller package and jump there using goto &$sub which overwrites the current stack frame. Something similar to the following code: 
        package MyOpen;
use Carp ();
use Data::Dumper;
use 5.010;

my %cache;

BEGIN {
    *CORE::GLOBAL::open = sub {
        my $pkg = caller;
        my $sub = $cache{$pkg} //= do {
            my $code = <<EOS;
package $pkg;
sub {
    my \$r = CORE::open \$_[0], \@_[1..\$#_];
    Carp::cluck(Data::Dumper::Dumper(\@_));
    return \$r;
}
EOS
            eval $code or die "Bad sub: $@";
        };
        goto &$sub;
    };
}


package main;

open $fh, '>&', 'STDOUT';
open FOO, ">", "/tmp/FOO";

        [download]
[reply]
[d/l]
[select]

In Section Cool Uses for Perl