Well, I don't know if this is necessarily the best way to go about it, but then, I don't know what problem you're trying to solve. It sounds like a design issue rather than a syntax issue (i.e., are you sure you don't have a design flaw?) In any event, here's a rough way to do it:

sub dostuff {
  # you'll want to walk your inheritance tree rather than hardcode thi
+s
  foreach my $super (search_isa()) {# <-- you implement :)
    if (my $method = UNIVERSAL::can($super, 'dostuff')) {
      goto $method;
    }
  }
}
[download]

I feel dirty just telling you this :)

search_isa() is simply @ISA, because can searches the whole inheritance tree of the supplied class.

use strict;
use warnings;

package AA;

sub dostuff { print(scalar(caller()), $/); }


package BB;


package CC;

BEGIN { our @ISA = 'AA'; }


package DD;

use vars qw(@ISA);
BEGIN { @ISA = qw(BB CC); }

sub dostuff {
   foreach my $super (@ISA) {
     #if (my $method = $super->can('dostuff')) {
     #  -or-
      if (my $method = UNIVERSAL::can($super, 'dostuff')) {
         #print($super,  $/);
         #print($method, $/);
         goto $method;
      }
   }
}


package main;

#print(\&AA::dostuff, $/);

bless({},'DD')->dostuff();  # Prints "main"
[download]

search_isa() is simply @ISA, because can searches the whole inheritance tree of the supplied class.

D'oh! I knew that. Silly me :)

Cheers,
Ovid

New address of my CGI Course.

Here's an alternative that doesn't use a loop:

Read more... (487 Bytes)

You probably know that dostuff exists in a parent, you can simplify it down to:

package MyModule;

use vars qw(@ISA);
BEGIN {
   @ISA = ...;
   *MyModule::Super::ISA = \@ISA;
}

sub dostuff {
   goto(MyModule::Super->can('dostuff')) if (...condition...);

   ...
}
[download]

Don't put any methods (or at least not 'dostuff') in the MyModule::Super package (namespace) for this to work.

Why go to so much work to try to make polymorphism work only to break it by calling a UNIVERSAL method explicitly?

Well, calling can directly can break if you have something in @ISA that isn't a class (such as a coderef: Class::Dynamic). Out of habit I try to call UNIVERSAL::can unless the $object->can('can');

Perhaps I'm being overly paranoid.

Cheers,
Ovid

New address of my CGI Course.

Hi Ovid,

Aha - You can feel less dirty as I promise not to actually implement your code for anything important!

Considering your code example cleared up my misunderstanding regarding the $obj->SUPER syntax, and I have cleaned up my code.

Thanks - TIM
--
#Tip: use 'no strict' to make those nasty errors vanish.

I feel dirty just telling you this

And so you should.

This method of searching is flawed, since if perl does the work, it will scan the whole isa tree looking for a declared "dostuff", and then fall back on searching the whole tree for "AUTOLOAD". Your code will find an AUTOLOAD in a package with no declared "dostuff" sometimes when it shouldn't.

This breaks superclasses that are using AUTOLOAD correctly, i.e. with a declaration of each function that may be autoloaded.

Since we're all feeling dirty, you could also do what you want by temporarily faking the symbol table out so there is, for an instant, no child class method. Playing with Perl symbol tables will put hair on your chest, but you may also go blind.

use strict;

package Super;

sub new
{
    return bless {}, shift;
}

sub dostuff
{
    print "In Parent dostuff -- caller: ", join('|', caller()), "\n";
}

package Child;

our @ISA = qw(Super);

sub dostuff
{
    my $self = @_[0];

    print "In Child dostuff -- caller: ", join('|', caller()), "\n";

    local *SAVE = *Child::dostuff;
    undef *Child::dostuff;
    my $method = $self->SUPER::can('dostuff');
    *Child::dostuff = *SAVE;

    goto(&$method);
}

package main;

my $x = Child->new();
$x->dostuff();
$x->dostuff();
[download]

sub dostuff {
  goto &{ $_[0]->can('SUPER::dostuff') }
    if $condition;
  # ...
}
[download]

You don't need the curlies there. It will work just fine without them:

goto $_[0]->can( 'SUPER::dostuff' );
[download]

Makeshifts last the longest.

Sorry if this repeats what was said above

Yes, and unfortunately, you cut-n-pasted the wrong code. You want can("SUPER::dostuff"), not SUPER::can("dostuff"). {sigh}

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

Heaven forbid someone makes a mistake. {{{sigh}}}

Why? The latter sounds like a useless "optimization" to me, especially since you say the first one works. If there is a reason, let us know and maybe we can address the real problem.

And no, there's no easy way that wouldn't require heavy symbol table manipulation. Well, maybe a module, but I find that unlikely.

Actually, it's very easy to do, as shown in my reply below. can returns a code ref and you can goto a code reference. The only tricky part is writing code that pulls in the entire inheritance heirarchy in the correct order so it can be searched. I suspect the original poster may find that less fast than "optimizing" the stack (if that's what was intended.)

Cheers,
Ovid

New address of my CGI Course.

can returns a code ref

I did not know that until I saw your snippet below. Very nice!

I never said I thought it was a good idea - I just want to know how it can be done!
TIM
--
#Tip: use 'no strict' to make those nasty errors vanish.

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…

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

See replies.

Makeshifts last the longest.

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.

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.

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.

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.