Как вызвать метод прародителя в perl

Question

Мне недавно нужно было позвонить дедушке класса. Допустим, у меня есть:

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

и я хотел новый класс Spiderman, который был бы похож на Супермена, но немного отличался:

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

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

    ??? # Call Superhero->SaveWorld    
}

для вызова как:

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

Кажется, довольно плохо документировано, как выполнить этот вызов ???.

Что-то вроде $self->SUPER::SUPER::SaveWorld($hero) не работает (он будет искать пакет с именем "SUPER :: SUPER").

Что еще хуже, сам родитель был динамическим c, поэтому литерал $self->Superhero::SaveWorld(%args); был невозможен.

Однако сам класс можно легко извлечь с помощью my $class = $Superman::ISA[0];.

Статистический c вызов может быть выполнен с помощью чего-то вроде:

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

, который, однако, не работал (хотя в этом примере это работает, как и ожидалось).

Answer 1

Вы можете использовать следующее:

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

Это может привести к смешанному дизайну. Вы должны исправить свой дизайн, а не использовать это. Непонятно, каким будет исправление, потому что ваш пример не имеет смысла: человек-паук не супер человек.

Answer 2

Хитрость заключается в том, чтобы использовать строку с именем метода.

Как найдено из этого ответа Бородина:

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

или просто

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

(но обратите внимание на ${class}, а не go над ::, в противном случае он пытается ${class::SaveWorld}!)

Таким образом,

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