Perl-Vererbung oder ähnlicher Effekt beim Zuweisen von Subroutinen zu Skalaren - Perl, Callback

Ich möchte einem Skalar ein Sub als Rückruf zuweisen und gleichzeitig das vererbungsähnliche Verhalten, d. H. Im Code unterhalb des Aufrufs, archivieren foobar->warning() oder foobar->croaking() Löst die Funktion des übergeordneten Elements aus, wenn in class foobar keine Implementierung angegeben ist. Mit der zusätzlichen Anforderung kann ich es einem Skalar zuordnen.

Die einzige Möglichkeit, dies zu lösen, besteht darin, es umgekehrt zu tun, d. H. "Warning_check_child" in "barqux" aufzurufen, um zu überprüfen, ob eine bestimmte Implementierung verfügbar ist, oder einen eigenen Code auszuführen.

Ich hoffe, dass jemand da draußen eine bessere Lösung hat, damit ich den bestehenden Anruf am Anfang vermeiden oder zumindest bestätigen kann, dass es keinen besseren Weg gibt.

Danke im Voraus

use strict;
use warnings;

warn "When methods accessed as class from foobar";
foobar->warning();

my $sub;
# assign class method to sub reference does not work
# $sub = &foobar->warning;
# $sub->();

# Have the sub in other package check for custom functionality
$sub = &barqux::warning_check_child;
$sub->();

### Child class
package foobar;
use parent -norequire, "barqux";

sub warning{
warn "warning: foobarn";
}
sub warning_check_child{
warn "warning: foobar";
}

### Parent class
package barqux;

sub warning{
warn "warning: barquxn";
}
sub croaking{
warn "croaking: barquxn";
}
sub warning_check_child{
if ( exists &foobar::warning_check_child ){
foobar::warning_check_child()
}
else {
warn "warning: barquxn";
}
}

Antworten:

4 für die Antwort № 1

Es klingt wie Sie brauchen UNIVERSAL::can, die a zurückgibt Referenz auf eine Methode, wenn die Klasse diese Methode entweder direkt oder durch Vererbung ausführen kann.

So was

use strict;
use warnings;

my $sub = FooBar->can("warning_check_child");
$sub->();


### Parent class
package BarQux;

sub warning{
warn "warning: BarQuxn";
}

sub croaking{
warn "croaking: BarQuxn";
}

sub warning_check_child{
warn "warning_check_child: BarQuxn";
}


### Child  class
package FooBar;
use base "BarQux";

sub croaking{
warn "croaking: FooBarn";
}

Ausgabe

warning_check_child: BarQux

---

1 für die Antwort № 2

Rückrufe sind Codereferenzen, Perl-Objekte sind gesegnete Referenzen. Daher können Sie eine CODE-Referenz segnen, um einen Rückruf mit Vererbung zu erstellen. Wenn Sie konvertieren Foo::warning Ich denke, Sie können in einer Fabrik das Verhalten erreichen, nach dem Sie suchen.

use 5.016; # needed for __SUB__
use strict;
use warnings;

package Bar {
sub warning {
my $class = shift;
my $self  = sub {
__SUB__->warning_check_child();
say "Bar::warning";
};
return bless $self, $class;
}

sub warning_check_child {
my $self = shift;
say "Bar::warning_check_child";
}
}

package Foo {
use base "Bar";

sub warning {
my $class = shift;
my $self  = sub {
__SUB__->warning_check_child();
say "Foo::warning"
};
return bless $self, $class;
}
}

package main {
my $f = Foo->warning();
$f->();
}

Die Ausgabe ist

Bar::warning_check_child
Foo::warning

Wenn Foo eine hinzufügt warning_check_child Methode, die stattdessen aufgerufen würde.

Hinweis: Ich verwende __SUB__ hier als eine andere Schreibweise $self da das Objekt das Unterprogramm ist. Wenn Sie auf eine Version von Perl vor 5.16 beschränkt sind, können Sie dies vorab deklarieren $self zuerst und erstelle stattdessen einen Verschluss darüber:

sub warning {
my $class = shift;
my $self;
$self = sub {
$self->warning_check_child();
say "Foo"
};
return bless $self, $class;
}

---