Как создать функцию обратного вызова (таблицу диспетчеризации) в 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);
}