How do you create a callback function (dispatch table) in Perl using hashes?

Question

I want to call a main controller function that dispatches other function dynamically, something like this:

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{
...
}

One caveat is that the subs are defined in other Modules, so the callbacks would have to be able to reference them... plus I'm having a hard time getting the hashes right!

Answer 1

So, it's possible to have a hash that contains anonymous subroutines that you can invoke from stdin.

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

And you can insert more hashvalues into the hash:

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

And you would invoke one like this

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

Or

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

You can get the hashkey from STDIN, or anywhere else.

You can also define them nonymously and then take a reference to them.

sub delete {
    # regular sub definition
}

$callbacks{delete} = \&delete;

I wouldn't call these callbacks, however. Callbacks are subs that get called after another subroutine has returned.

Your code is also rife with syntax errors which may be obscuring the deeper issues here. It's also not clear to me what you're trying to do with the second level of arrays. When are you defining these subs, and who is using them when, and for what?

Answer 2

Perhaps this simplified example will help:

# 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

You've already got some good answers on how to build a dispatch table and call functions through it within a single file, but you also keep talking about wanting the functions to be defined in other modules. If that's the case, then wouldn't it be better to build the dispatch table dynamically based on what dispatchable functions each module says it has rather than having to worry about keeping it up to date manually? Of course it would!

Demonstrating this requires multiple files, of course, and I'm using Module::Pluggable from CPAN to find the modules which provide the function definitions.

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;

Then, on the command line:

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

Adding new functions is now as simple as dropping a new file into the DTable directory with an appropriate dispatchable sub. No need to ever touch dispatch_core.pl just to add a new function again.

Edit: In response to the comment's question about whether this can be done without Module::Pluggable, here's a modified dispatch_core.pl which doesn't use any external modules other than the ones defining the dispatchable functions:

#!/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);
}