Anonymous Monk has asked for the wisdom of the Perl Monks concerning the following question:

I am trying to get my perl code to log all opened files with code like this: 

my @OpenCalls;

BEGIN {
    # See: http://www.perlmonks.org/?node_id=909403
    *CORE::GLOBAL::open = sub(*;$@) {
        push @OpenCalls, [ @_[1..$#_] ];
        use Symbol ();
        my $handle = Symbol::qualify_to_ref($_[0], scalar caller);
        $_[0] = $handle unless defined $_[0];  # pass up to caller

        if (@_ == 1) {
            CORE::open $handle;
        } elsif (@_ == 2) {
            CORE::open $handle, $_[1];
        } elsif (@_ == 3) {
            if (defined $_[2]) {
                CORE::open $handle, $_[1], $_[2];
            } else {
                CORE::open $handle, $_[1], undef;  # special case
            }
        } else {
            CORE::open $handle, $_[1], $_[2], @_[3..$#_];
        }
    };
}

[download]

I am running into an issue with OOPerl where my filehandle is disappearing before the call to the DESTROY method:

"print() on closed filehandle PKG:: at PKG.pm line 104 during global destruction

Note that the CORE::GLOBAL::open override happens in a package different than PKG. I am using perl 5.10.0 on linux.

Dear wise Monks, any insights would be appreciated!

Replies are listed 'Best First'.
Re: Override the open builtin globally.. redux
by Anonymous Monk on Feb 26, 2013 at 20:18 UTC
    See: http://www.perl.com/pub/2002/06/11/threads.html?page=2 (at the end) The key is the handling of the undefined case. 
     *CORE::GLOBAL::open = sub(*;$@) {
        # push @OpenCalls, [ @_[1..$#_] ];

        if (defined($_[0])) {
            use Symbol ();
            my $handle = Symbol::qualify($_[0],(caller)[0]);
            no strict 'refs';
            if(@_ == 1) {
                return CORE::open($handle);
            } elsif(@_ == 2) {
                return CORE::open($handle, $_[1]);
            } else {
                return CORE::open($handle, $_[1], @_[2..$#_]);
            }
        } else {
            if(@_ == 1) {
                return CORE::open($_[0]);
            } elsif(@_ == 2) {
                return CORE::open($_[0], $_[1]);
            } else {
                return CORE::open($_[0], $_[1], @_[2..$#_]);
            }
        }
    };

    [download]
[reply]
[d/l]

Back to Seekers of Perl Wisdom