Как в Perl динамически выбирать, какой метод использовать в качестве обратного вызова?

В Perl довольно просто указать обратный вызов или ссылку на код, если его пакет известен:

package Foo;

sub foo { print "in foo" }

# and then
package main;

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

baz( \&Foo::foo );

И это печатает in foo.

Допустим, у вас есть объект, такой тривиальный, как этот:

package Foo;

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

Вы можете найти метод, используя указанный выше способ (\&Package:Method) и вызвать его как

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

Но иногда (хорошо, часто) вы не знаете явный тип. Допустим, есть Foo, Bar, Baz, и у каждого из них есть собственный метод blat. Вы хотите получить ссылку на соответствующий метод, основанный на объекте, а не на пакете. Как бы вы это сделали?


person Robert P    schedule 24.06.2009    source источник


Ответы (2)


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

Если $ref равен undef, ваш объект не может блеать. Если $ref не равен undef, это допустимая ссылка CODE на рассматриваемую функцию, подходящая для вызова "$obj->$ref(@args)".

person Tanktalus    schedule 24.06.2009

Позвольте поиску метода сделать всю работу за вас:

$ 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

Если вам нужна ссылка, имейте в виду, что в Perl нет делегатов, но вы можете приблизиться:

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

Еще ближе было бы:

my $delegate = sub { $obj->$ref };
#           or sub { $obj->$method }
print $delegate->(), "\n";
person Greg Bacon    schedule 24.06.2009
comment
can - это определенно правильный путь, но на странице UNIVERSAL perldoc явно указано НЕ делать UNIVERSAL::can() напрямую - это делает так, что переопределения не работают. см. perldoc.perl.org/UNIVERSAL.html - person Robert P; 24.06.2009