How do I implement a dispatch table in a Perl OO module? - perl

Question

I want to put some subs that are within an OO package into an array - also within the package - to use as a dispatch table. Something like this
package Blah::Blah;
use fields 'tests';
sub new {
my($class )= #_;
my $self = fields::new($class);
$self->{'tests'} = [
$self->_sub1
,$self->_sub2
];
return $self;
}
_sub1 { ... };
_sub2 { ... };
I'm not entirely sure on the syntax for this?
$self->{'tests'} = [
$self->_sub1
,$self->_sub2
];
or
$self->{'tests'} = [
\&{$self->_sub1}
,\&{$self->_sub2}
];
or
$self->{'tests'} = [
\&{_sub1}
,\&{_sub2}
];
I don't seem to be able to get this to work within an OO package, whereas it's quite straightforward in a procedural fashion, and I haven't found any examples for OO.
Any help is much appreciated,
Iain

Answer 1

Your friend is can. It returns a reference to the subroutine if it exists, null otherwise. It even does it correctly walking up the OO chain.
$self->{tests} = [
$self->can('_sub1'),
$self->can('_sub2'),
];
# later
for $tn (0..$#{$self->{tests}}) {
ok defined $self->{tests}[$tn], "Function $tn is available.";
}
# and later
my $ref = $self->{tests}[0];
$self->$ref(#args1);
$ref = $self->{tests}[1];
$self->$ref(#args2);
Or, thanks to this question (which happens to be a variation of this question), you can call it directly:
$self->${\$self->{tests}[0]}(#args1);
$self->${\$self->{tests}[1]}(#args1);
Note that the \ gives us a reference to a the subref, which then gets dereferenced by the ${} after $self->. Whew!
To solve the timeliness issue brain d foy mentions, an alternative would be to simply make the {test} a subroutine itself, that returns a ref, and then you could get it at exactly the time you need it:
sub tests {
return [
$self->can('_sub1'),
$self->can('_sub2')
];
}
and then use it:
for $tn (0..$#{$self->tests()}) {
...
}
Of course, if you have to iterate over the refs anyway, you might as well just go straight for passing the reference out:
for my $ref (0..$#{$self->tests()}) {
$self->$ref(#args);
}

Answer 2

Although Robert P's answer might work for you, it has the problem of fixing the dispatch very early in the process. I tend to resolve the methods as late as I can, so I would leave the things in the tests array as method names until you want to use them:
$self->{tests} = [
qw( _sub1 _sub2 )
];
The strength of a dynamic language is that you can wait as long as you like to decide what's going to happen.
When you want to run them, you can go through the same process that Robert already noted. I'd add an interface to it though:
foreach my $method_name ( $obj->get_test_methods )
{
$obj->$method_name();
}
That might even be better as not tying the test to an existing method name:
foreach my $method_name ( $obj->get_test_methods )
{
$obj->run_test_named( $method_name );
}
That run_test_named could then be your dispatcher, and it can be very flexible:
sub run_test_named
{
my( $self, $name ) = #_;
# do anything you want, like in Robert's answer
}
Some things you might want to do:
Run a method on an object
Pass the object as an argument to something else
Temporarily override a test
Do nothing
etc, etc
When you separate what you decide to do from its implementation, you have a lot more freedom. Not only that, the next time you call the same test name, you can do something different.

Answer 3

use lib Alpha;
my $foo = Alpha::Foo->new; # indirect object syntax is deprecated
$foo->bar();
my %disp_table = ( bar => sub { $foo->bar() } );
$disp_table{bar}->(); # call it
You need a closure because you want to turn a method call into an ordinary subroutine call, so you have to capture the object you're calling the method on.

Answer 4

There are a few ways to do this. Your third approach is closest. That will store a reference to the two subs in the array. Then when you want to call them, you have to be sure to pass them an object as their first argument.
Is there a reason you are using the use fields construct?
if you want to create self contained test subs, you could do it this way:
$$self{test} = [
map {
my $code = $self->can($_); # retrieve a reference to the method
sub { # construct a closure that will call it
unshift #_, $self; # while passing $self as the first arg
goto &$code; # goto jumps to the method, to keep 'caller' working
}
} qw/_sub1 _sub2/
];
and then to call them
for (#{ $$self{test} }) {
eval {$_->(args for the test); 1} or die $#;
}