Herencia de Perl o efecto similar al asignar subrutinas a escalares: perl, devolución de llamada

Me gustaría asignar un sub a un escalar como devolución de llamada y, al mismo tiempo, archivar la herencia como el comportamiento, es decir, en el código a continuación, llamando foobar->warning() o foobar->croaking() activará la función del padre si no se proporciona ninguna implementación en la clase foobar. Con el requisito adicional, puedo asignarlo a un escalar.

La única forma en que podría resolver esto es hacerlo al revés, es decir, llamando a "warning_check_child" en "barqux" que verificará si hay una implementación específica disponible o ejecutará su propio código.

Espero que alguien tenga una mejor solución para poder evitar la llamada existente al comienzo o al menos confirmar que no hay una mejor manera.

Gracias por adelantado

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

Respuestas

4 para la respuesta № 1

Suena como que necesitas UNIVERSAL::can, que devuelve un referencia a un método si la clase puede realizar ese método, ya sea directamente o por herencia.

Me gusta esto

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

salida

warning_check_child: BarQux

---

1 para la respuesta № 2

Las devoluciones de llamada son referencias de código, los objetos de Perl son referencias bendecidas, por lo tanto, puede bendecir una referencia de CÓDIGO para crear una devolución de llamada con herencia. Si te conviertes Foo::warning en una fábrica, creo que puedes obtener el comportamiento que buscas.

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

El resultado es

Bar::warning_check_child
Foo::warning

Si Foo agrega un warning_check_child método, eso se llamaría en su lugar.

Nota: estoy usando __SUB__ aquí como otra forma de escribir $self ya que el objeto es la subrutina. Si está limitado a una versión de Perl anterior a 5.16, puede declarar previamente $self primero y cree un cierre sobre él en su lugar:

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

---