How to call a grandparent method in perl

Viewed 93

I was recently needing to call the grandparent of a class. Let's say I have:

use strict;
use warnings;
use 5.10.0;

package Superhero;

sub new {
  my $class = shift;
  return bless {}, $class;
}

sub SaveWorld {
    my $self = shift;
    my %args = (
        hero => "nobody",
        @_
        );
    my $hero = $args{hero};

    say "$hero saved the world again";
    $self->{status} = "World saved by $hero";
}

sub WorldStatus() {
    my $self = shift;
    return $self->{status};
}

package Superman;
use parent -norequire, qw(Superhero);

sub SaveWorld {
    my $self = shift;
    my %args = ( hero => "superman" );

    $self->SUPER::SaveWorld(%args);
}

and wanted a new class Spiderman that was like Superman but slightly different:

package Spiderman;
use parent -norequire, qw(Superman);

sub SaveWorld {
    my $self = shift;
    my $hero = "spiderman";

    ??? # Call Superhero->SaveWorld    
}

for being called as:

my $hero = Spiderman->new;
$hero->SaveWorld();
say $hero->WorldStatus();

It seems quite bad documented how to perform that ??? call.

Something like $self->SUPER::SUPER::SaveWorld($hero) doesn't work (it would look for a package called "SUPER::SUPER").

To make matters worse, the parent itself was dynamic, so a literal $self->Superhero::SaveWorld(%args); was not possible.

The class itself can be easily extracted with my $class = $Superman::ISA[0];, though.

A static call could be achieved with something like:

my $eval = $class . '::SaveWorld($self, %args)';
eval $eval;

which was not working, though (it seems to work as expected in this example, though).

2 Answers

You could use the following:

$self->Superhero::SaveWorld(%args);

Doing so would just compound a broken design. You should fix your design rather than using this. It's unclear what the fix would be because your example makes no sense: A spider man isn't a super man.

The trick is to use a string with the method name.

As found from this answer by Borodin:

my $method = join '::', $class, "SaveWorld";

or just

my $method = "${class}::SaveWorld";

(but note the ${class} to not go over the ::, otherwise it tries ${class::SaveWorld}!)

Thus,

package Spiderman;
use parent -norequire, qw(Superman);

sub SaveWorld {
    my $self = shift;
    my %args = ( hero => "spiderman" );

    my $class = $Superman::ISA[0];
    say "I am looking for $class";
    my $method = join '::', $class, "SaveWorld";
    $self->$method(%args);
}
Related