En Perl, ¿cómo elige dinámicamente qué método usar como devolución de llamada?

Question

En Perl, es bastante trivial especificar una devolución de llamada o una referencia de código si se conoce su paquete:

package Foo;

sub foo { print "in foo" }

# and then
package main;

sub baz {
    my $code = shift;
    $code->();
}

baz( \&Foo::foo );

Y esto imprime en foo .

Digamos que tienes un objeto, siempre tan trivial, como este:

package Foo;

sub new { bless {}, shift }
sub bar { print "in bar" }
sub baz { print "in baz" }

Puede buscar el método usando la forma anterior (\ & amp; Paquete: Método) y llamarlo como

package main;
my $foo = Foo->new();
my $ref = \&Foo::bar;
$foo->$ref();

Pero a veces (bueno, a menudo) no sabes el tipo explícito. Digamos que hay Foo , Bar , Baz , y todos tienen su propio método blat . Desea obtener la referencia al método apropiado, basado en el objeto en lugar del paquete. ¿Cómo harías eso?

Answer 1

my $ref = $obj->can('blat');

Si $ ref es undef, su objeto no puede explotar. Si $ ref no es undef, es una referencia de CÓDIGO válida a la función en cuestión, adecuada para llamar a " $ obj- > $ ref (@args) " ;.

Answer 2

Deje que la búsqueda de métodos haga el trabajo por usted:

$ cat try
#! /usr/bin/perl

use warnings;
use strict;

package Foo;
sub new { bless {} => shift }
sub blat { "Foo blat" }

package Bar;
sub new { bless {} => shift }
sub blat { "Bar blat" }

package Baz;
sub new { bless {} => shift }
sub blat { "Baz blat" }

package main;

my $method = "blat";
foreach my $obj (Foo->new, Bar->new, Baz->new) {
  print $obj->$method, "\n";
}

$ ./try
Foo blat
Bar blat
Baz blat

Si necesita una referencia, tenga en cuenta que Perl no tiene delegados, pero puede acercarse:

my @objs = (Foo->new, Bar->new, Baz->new);

my $method = "blat";
my $obj = $objs[rand @objs];
my $ref = $obj->can($method);

if ($ref) {
  print $ref->($obj), "\n";
}
else {
  print "$obj: no can $method\n";
}

Aún más cerca sería:

my $delegate = sub { $obj->$ref };
#           or sub { $obj->$method }
print $delegate->(), "\n";