in reply to goto superclass method

Unfortunately, this doesn't work in vanilla Perl:

#!/usr/bin/perl
use strict;
use warnings;

sub Foo::method { return "Foo" }

BEGIN { @Bar::ISA = qw( Foo ); }

sub Bar::method { goto $_[ 0 ]->SUPER::can( 'method' ); }

print Bar->method(), "\n";

[download]

This is an infinite loop, because it dispatches to UNIVERSAL::can with $_[ 0 ] as the first parameter. This means that adorning the call with SUPER:: doesn't make a difference here. And since the package for $_[ 0 ] is Bar, can() finds Bar::method, so round and round we go…

But we can easily make this work. I came up with this before reading steves' reply, but it is just a cleaner, more polished version of that trick. Stick this somewhere in the code:

sub SUPER::can {
    my $caller = ( caller 1 )[ 3 ];
    no strict 'refs';
    local *$caller;
    return UNIVERSAL::can( @_ );
}

[download]

Tiny as it is, maybe this ought to be on CPAN?

See replies.

Makeshifts last the longest.

Replies are listed 'Best First'.
•Re^2: goto superclass method
by merlyn (Sage) on Dec 22, 2004 at 21:34 UTC
    This is an infinite loop
    It's an infinite loop, but not for the reasons you state. SUPER:: is always relative to __PACKAGE__, and when you start saying sub Foo::bar, the __PACKAGE__ doesn't change to Foo, so you have a problem with SUPER.

    In short, Don't Do That. Properly written code works properly: 

    package Base;
sub do_me {
  my $self = shift;
  print "Base do_me\n";
}
package Derived;
@ISA = qw(Base);
sub do_me {
  my ($self) = @_; # no shift, so we can goto
  print "About to jump...\n";
  goto &{$self->can("SUPER::do_me")};
}
package main;
Derived->do_me;

    [download]

    -- Randal L. Schwartz, Perl hacker
    Be sure to read my standard disclaimer if this is a reply.

[reply]
[d/l]

      SUPER:: is always relative to __PACKAGE__, and when you start saying sub Foo::bar, the __PACKAGE__ doesn't change to Foo, so you have a problem with SUPER.

      That's wrong.

      #!/usr/bin/perl
use strict;
use warnings;

package Foo;
sub bar { }

package Baz;
our @ISA = qw( Foo );
sub bar {
    my $self = shift;
    print $self->SUPER::can( "bar" ), "\n";
    print $self->can( "SUPER::bar" ), "\n";
};

package main;

print UNIVERSAL::can( Baz => "bar" ), "\n";

Baz->bar;

__END__
CODE(0x815a230)
CODE(0x815a230)
CODE(0x813bc4c)

      [download]

      Interestingly enough, I thought I had tried the $self->can( "SUPER::foo" ) combination, but apparently I didn't. Huh.

      Makeshifts last the longest.

[reply]
[d/l]
        Huh? Your example shows that both UNIVERSAL::can and SUPER::can on asking how a "Baz" can "bar" return the same code (which is Baz::bar), and that SUPER::bar for Baz is in fact the one in Foo::bar.

        That's exactly what I said. You didn't show "wrong" on anything. Did you mean something else?

        -- Randal L. Schwartz, Perl hacker
        Be sure to read my standard disclaimer if this is a reply.

[reply]

      merlyn shows that it takes a wizard to arrive at the purest form of perverted code.

      Thanks. Now let's all wash our hands. Twice for good measure.

[reply]

        I didn't find this perverted at all. What that says about me is your guess. :-)

        Makeshifts last the longest.

[reply]

      What's wrong with leaving &Derived::do_me out altogether?

      package Base;
sub do_me {
  my $self = shift;
  print "Base do_me\n";
}

package Derived;
@ISA = qw(Base);

package main;
Derived->do_me;

      [download]

      It doesn't use goto but the result is the same as far as I can tell.

      Update: Okay, ignore me. I got distracted from the original question of how to conditionally jump to a super class.

[reply]
[d/l]

In Section Seekers of Perl Wisdom