Unconfuse filehandles and classes

[tilly]

At Filehandles vs. Packages: And the winner is... converter found an "interesting" feature of Perl. A short demonstration of it is:

perl -e 'sub new {die@_} main->new(); open main, "foo"'

which fails to find your new method in package main because main is being interpreted as a glob, not as a class name. The following snippet fixes that for some values of fix (as long as you don't later want to use IO::Handle of course).

Of course if in package IO::Handle you were to open a filehandle named CGI, then the workaround stops working...

package IO::Handle;

sub new {
  *{shift(@_)}{NAME}->new(@_);
}

[tye]

Here is a more robust patch:

package IO::patch;

# The following code:
#    use CGI;  my $q= CGI->new();  open CGI, "< $0";
# gives:
#    Can't locate object method "new" via package "IO::Handle"
#
# But download this code and put it into lib/IO/patch.pm and
# either add "use IO::patch;" to your script or add
# PERL5OPT=-MIO::patch to your environment, and this problem
# goes away.

require IO::Handle;

my $oldNew= \&IO::Handle::new;

*IO::Handle::new= \&newNew;

sub newNew {
    my $pkg= $_[0];
    if(  UNIVERSAL::isa( $pkg, "GLOB" )  ) {
        my $name= *{$pkg}{NAME};
        my $can= UNIVERSAL::can( $name, "new" );
        if(  $can  ) {
            $_[0]= $name;
            goto &$can;
        }
        require Carp;
        Carp::cluck( "Called new() on an open IO::Handle?" )
            if  $^W;
    }
    goto &$oldNew;
}

I've tested this quite a bit and it seems to work well. This suggests an update to IO/Handle.pm if Perl itself can't be easily patched...

Update: tilly noted that there could be conflicts for methods other than new(). This problem doesn't happen for object methods and many modules only have a single class methods, new(), so I'll be adding an AUTOLOAD but the above should still be quite useful in the mean time.

        - tye (but my friends call me "Tye")

[tye]

Here is the new monster:

package IO::patch;

# The following code:
#    use CGI;  my $q= CGI->new();  open CGI, "< $0";
# gives:
#    Can't locate object method "new" via package "IO::Handle"
#
# But download this code and put it into lib/IO/patch.pm and
# either add "use IO::patch;" to your script or add
# PERL5OPT=-MIO::patch to your environment, and this problem
# goes away.
#
# Only class methods are subject to this problem.  This version
# of IO::patch even handles class methods that are AUTOLOADed,
# but doesn't trap class methods that have the same name as
# methods (or routines) in IO::Handle except for new().

require IO::Handle;

use vars qw( $AUTOLOAD );

my $oldNew= \&IO::Handle::new;

*IO::Handle::new= \&newNew;

*IO::Handle::AUTOLOAD= \&AUTOLOAD;

sub newNew {
    my $pkg= $_[0];
    if(  UNIVERSAL::isa( $pkg, "GLOB" )  ) {
        my $name= *{$pkg}{NAME};
        my $can= UNIVERSAL::can( $name, "new" );
        require Carp   if  $^W;
        if(  $can  ) {
            Carp::carp(
                "File handle vs. package name conflict ($name)"
            )   if  $^W;
            $_[0]= $name;
            goto &$can;
        }
        Carp::carp(
            qq(Called new() on an open IO::Handle or can't locate)
            . qq( object method "new" via package "$name")
        )   if  $^W;
    }
    goto &$oldNew;
}

sub AUTOLOAD {
    my $pkg= $_[0];
    my $meth= $AUTOLOAD;
    require Carp;
    if(  UNIVERSAL::isa( $pkg, "GLOB" )  ) {
        my $name= *{$pkg}{NAME};
        $meth =~ s/^IO::Handle:://;
        my $can= UNIVERSAL::can( $name, $meth );
        if(  $can  ) {
            Carp::carp(
                "File handle vs. package name conflict ($name)"
            )   if  $^W;
            $_[0]= $name;
            goto &$can;
        }
        $can= UNIVERSAL::can( $name, "AUTOLOAD" );
        if(  $can  ) {
            eval { require Devel::Peek }
                or  Carp::croak( 
                    qq(Can't AUTOLOAD method "$meth" via package "$nam
+e")
                    . qq( unless you install Devel::Peek\n)
                    . $@
                );
            my $gv= Devel::Peek::CvGV( $can );
            {
                my $alPkg= *{$gv}{PACKAGE};
                no strict 'refs';
                ${$alPkg."::AUTOLOAD"}= $name . "::" . $meth;
            }
            Carp::carp(
                "File handle vs. package name conflict ($name)"
            )   if  $^W;
            $_[0]= $name;
            goto &$can;
        }
        Carp::croak(
            qq(Can't locate object method "$meth" via package "$name")
        );
    }
    Carp::croak(
        qq(Can't locate object method "$meth" via package "IO::Handle"
+)
    );
}

I've tested it and it works well in lots of situations. The code could probably be drastically cleaned up, but that is less important than getting this out there.

Update: Thanks, bbfu, fixed.

        - tye (but my friends call me "Tye")

[bbfu]

Hrm. Unless I'm missing something, if warnings are off and Devel::Peek is not installed, the calls to Carp::croak are going to fail since you only require in Carp if warnings are on, and you croak regardless.

bbfu
Seasons don't fear The Reaper.
Nor do the wind, the sun, and the rain.
We can be like they are.