Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

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

Tags:

oop

perl

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

like image 876
ian Avatar asked May 07 '10 21:05

ian


3 Answers

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);
}
like image 105
Robert P Avatar answered Nov 16 '22 01:11

Robert P


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.

like image 45
brian d foy Avatar answered Nov 16 '22 02:11

brian d foy


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.

like image 36
cjm Avatar answered Nov 16 '22 00:11

cjm