Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

goto superclass method

by avarus (Novice)
on Dec 22, 2004 at 17:48 UTC ( #416841=perlquestion: print w/replies, xml ) Need Help??
avarus has asked for the wisdom of the Perl Monks concerning the following question:

Hi,

OK, this should be dead easy but every permutation I try throws an error.
Slightly cleaned up version is that I have a class 'bar' which ISA 'foo' and I call the method 'dostuff', but under certain conditions I want to delegate to the superclass:

#in package bar sub dostuff { return $_[0]->SUPER::dostuff() if $condition; }
That works, but I really want to say:
sub dostuff { goto &{ $_[0]->SUPER::dostuff } if $condition; }
IE - clean up the stack and continue as if the method in the subclass never existed.
But I cannot summon the correct syntax. Any ideas?

Thanks,

TIM

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

Replies are listed 'Best First'.
Re: goto superclass method
by Ovid (Cardinal) on Dec 22, 2004 at 18:01 UTC

    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; } } }

    I feel dirty just telling you this :)

    Cheers,
    Ovid

    New address of my CGI Course.

      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"

        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:

      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...); ... }

      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.

Re: goto superclass method
by steves (Curate) on Dec 22, 2004 at 19:02 UTC

    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();

Re: goto superclass method
by ikegami (Pope) on Dec 22, 2004 at 17:57 UTC

    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.
Re: goto superclass method
by broquaint (Abbot) on Dec 23, 2004 at 06:48 UTC
    You were almost there, just give that goto code dereference a code reference as produced by can e.g
    sub dostuff { goto &{ $_[0]->can('SUPER::dostuff') } if $condition; # ... }
    Sorry if this repeats what was said above but all those replies were making me cross-eyed.
    HTH

    _________
    broquaint

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

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

      Makeshifts last the longest.

        Heaven forbid someone makes a mistake. {{{sigh}}}
Re: goto superclass method
by Aristotle (Chancellor) on Dec 22, 2004 at 20:58 UTC

    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";

    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( @_ ); }

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

    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;

      -- 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)

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

        Makeshifts last the longest.

        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.

        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;

        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.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://416841]
Approved by jdtoronto
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others browsing the Monastery: (4)
As of 2018-08-17 09:44 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Asked to put a square peg in a round hole, I would:









    Results (176 votes). Check out past polls.

    Notices?