Как создать функцию обратного вызова (таблицу диспетчеризации) в Perl с использованием хешей?

Question

Я хочу вызвать функцию основного контроллера, которая динамически отправляет другую функцию, примерно так:

package Controller;

my %callback_funcs = ();

sub register_callback{
   my ($class,$callback,$options) = _@;
   #apppend to %callback_funcs hash ... ?
}

sub main{
%callback_funcs = ( add => 'add_func', rem => 'remove_func', edit => 'edit_func');  
  while(<STDIN>){
     last if ($_ =~ /^\s*$/);
     if($_ == 'add' || _$ == 'rem' || _$ == 'edit'){
        $result = ${callback_funcs['add']['func']}(callback_funcs['add']['options']);
     }
  }
}

sub add_func{
...
}

Одно предостережение заключается в том, что сабвуферы определены в других модулях, поэтому обратные вызовы должны быть в состоянии ссылаться на них... плюс мне трудно получить правильные хэши!

Answer 1

Таким образом, возможно иметь хеш, содержащий анонимные подпрограммы, которые вы можете вызывать из stdin.

my %callbacks = (
    add => sub {
        # do stuff
    },
    fuzzerbligh => sub {
        # other stuff
    },
);

И вы можете вставить больше хеш-значений в хеш:

$callbacks{next} = sub {
    ...
};

И вы бы призвали один такой

$callbacks{next}->(@args);

Или же

my $coderef = $callbacks{next};
$coderef->(@args);

Вы можете получить хеш-ключ из STDIN или где-либо еще.

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

sub delete {
    # regular sub definition
}

$callbacks{delete} = \&delete;

Я бы не назвал эти обратные вызовы, однако. Обратные вызовы - это подпрограммы, которые вызываются после возврата другой подпрограммы.

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

Answer 2

Возможно, этот упрощенный пример поможет:

# Very important.
use strict;
use warnings;

# Define some functions.
sub multiply { $_[0] * $_[1] }
sub divide   { $_[0] / $_[1] }
sub add      { $_[0] + $_[1] }
sub subtract { $_[0] - $_[1] }

# Create a hash of references to those functions (dispatch table).
my %funcs = (
    multiply => \&multiply,
    divide   => \&divide,
    add      => \&add,
    subtract => \&subtract,
);

# Register some more functions.
sub register {
    my ($key, $func) = @_;
    $funcs{$key} = $func;
}

register('+', \&add);    # As above.
register('sum', sub {    # Or using an anonymous subroutine.
    my $s = 0;
    $s += $_ for @_;
    return $s;
});

# Invoke them dynamically.
while (<>){
    my ($op, @args) = split;
    last unless $op and exists $funcs{$op}; # No need for equality tests.
    print $funcs{$op}->(@args), "\n";
}

Answer 3

У вас уже есть несколько хороших ответов о том, как построить таблицу диспетчеризации и вызывать функции через нее в одном файле, но вы также продолжаете говорить о желании определить функции в других модулях. Если это так, то не лучше ли динамически строить таблицу диспетчеризации, основываясь на том, какие диспетчерские функции, как говорит каждый модуль, у него есть, а не беспокоиться о том, чтобы обновлять ее вручную? Конечно, это будет!

Демонстрация этого требует, конечно, нескольких файлов, и я использую Module::Pluggable из CPAN, чтобы найти модули, которые предоставляют определения функций.

dispatch_core.pl:

#!/usr/bin/env perl

use strict;
use warnings;

my %dispatch;

use lib '.'; # a demo is easier if I can put modules in the same directory
use Module::Pluggable require => 1, search_path => 'DTable';
for my $plugin (plugins) {
    %dispatch = (%dispatch, $plugin->dispatchable);
}

for my $func (sort keys %dispatch) {
    print "$func:\n";
    $dispatch{$func}->(2, 5);
}

DTable / Add.pm:

package DTable::Add;

use strict;
use warnings;

sub dispatchable {
    return (add => \&add);
}

sub add {
    my ($num1, $num2) = @_;
    print "$num1 + $num2 = ", $num1 + $num2, "\n";
}

1;

DTable / MultDiv.pm:

package DTable::MultDiv;

use strict;
use warnings;

sub dispatchable {
    return (multiply => \&multiply, divide => \&divide);
}

sub multiply {
    my ($num1, $num2) = @_;
    print "$num1 * $num2 = ", $num1 * $num2, "\n";
}

sub divide {
    my ($num1, $num2) = @_;
    print "$num1 / $num2 = ", $num1 / $num2, "\n";
}

1;

Затем в командной строке:

$ ./dispatch_core.pl 
add:
2 + 5 = 7
divide:
2 / 5 = 0.4
multiply:
2 * 5 = 10

Добавление новых функций теперь так же просто, как перенос нового файла в каталог DTable с соответствующим dispatchable к югу. Не нужно когда-либо трогать dispatch_core.pl просто чтобы снова добавить новую функцию.

Изменить: В ответ на вопрос комментария о том, можно ли это сделать без Module::Pluggable, вот модифицированный dispatch_core.pl, который не использует никаких внешних модулей, кроме тех, которые определяют диспетчеризируемые функции:

#!/usr/bin/env perl

use strict;
use warnings;

my %dispatch;

my @dtable = qw(
  DTable::Add
  DTable::MultDiv
);

use lib '.';
for my $plugin (@dtable) { 
    eval "use $plugin";
    %dispatch = (%dispatch, $plugin->dispatchable);
}   

for my $func (sort keys %dispatch) {
    print "$func:\n";
    $dispatch{$func}->(2, 5);
}