Re: Rosetta Dispatch Table

[eyepopslikeamosquito]

Thanks to everyone for their interesting and instructive responses.

For completeness, some candidates tried using symrefs, via something like this:

use strict;
use warnings;

sub Invoker::first_callback {
   my $z = shift;
   print "in first_callback, z=$z\n";
   return 1;
}

sub Invoker::last_callback {
   my $z = shift;
   print "in last_callback, z=$z\n";
   return 2;
}

sub invoker
{
   my ($name, $z) = @_;
   my $handler = 'Invoker::' . $name . "_callback";
   no strict 'refs';
   my $rc = eval { &$handler($z) };
   return defined($rc) ? $rc : -1;
}

# Main program for testing ---------------------------------

for my $name ( "first", "last", "fred" ) {
   my $rc = invoker( $name, $name . '-arg' );
   print "$name: rc=$rc\n";
}

or this:

use strict;
use warnings;

package Invoker;

sub first_callback {
   my $z = shift;
   print "in first_callback, z=$z\n";
   return 1;
}

sub last_callback {
   my $z = shift;
   print "in last_callback, z=$z\n";
   return 2;
}

sub invoker
{
   my ($name, $z) = @_;
   my $handler = $name . '_callback';
   no strict 'refs';
   exists(${__PACKAGE__.'::'}{$handler}) or return -1;
   &$handler($z);
}

package main;

# Main program for testing ---------------------------------

for my $name ( "first", "last", "fred" ) {
   my $rc = Invoker::invoker( $name, $name . '-arg' );
   print "$name: rc=$rc\n";
}

For cheap thrills, just now I tried implementing via Class::MOP. I'm a Class::MOP ignoramus, so please feel free to suggest better ways to do it.

use strict;
use warnings;
use Class::MOP;

# Callback functions ---------------------------------------

sub first_callback {
   my $z = $_[1];
   print "in first_callback, z=$z\n";
   return 1;
}

sub last_callback {
   my $z = $_[1];
   print "in last_callback, z=$z\n";
   return 2;
}

# Implementation of dispatch table -------------------------

my $invoker_pkg = Class::MOP::Package->create('Invoker');
$invoker_pkg->add_package_symbol('&first', \&first_callback);
$invoker_pkg->add_package_symbol('&last',  \&last_callback);

# use Data::Dumper;
# my $r = $invoker_pkg->namespace(); warn Dumper($r);

sub invoker
{
   my $name = shift;
   $invoker_pkg->has_package_symbol('&' . $name) or return -1;
   Invoker->$name(@_);
}

# Main program for testing ---------------------------------

for my $name ( "first", "last", "fred" ) {
   my $rc = invoker( $name, $name . '-arg' );
   print "$name: rc=$rc\n";
}