A dispatch table to match named params of a sub

[neilwatson]

Greetings,

I'm trying to craft a dispatch table that will feed a sub that uses named parameters ( my %args = @_ ). I've tried a few combinations, but nothing seems to come out right. What can I do?

#!/usr/bin/perl

use strict;
use warnings;
use Data::Dumper;
use Test::More;

my %sub = ( 
   t01 =>
   {
      name => \&mine,
      arg => [ qw/one first two second/ ]
   }
);

$sub{t01}->{name}->( $sub{t01}->{arg} );

sub mine
{
   my %args = @_;

   ok( $args{one} eq 'first', 'arg one' );
   ok( $args{two} eq 'second', 'arg two' );
   done_testing;
}

[Corion]

If you want to pass a list into your handler, you need to pass the list, not a reference:

$sub{t01}->{name}->( @{ $sub{t01}->{arg} } );

[RichardK]

that's what the error message was telling you :-

Reference found where even-sized list expected at 1132487.pl line 20.

updated to fix typo

[roboticus]

You were very close:

$ cat sploot.pl
#!/usr/bin/env perl
use strict;
use warnings;
use Data::Dumper;
use Test::More;

my %sub = (
    t01=>{ name=>\&mine, args=>[qw/one first two second/] },
);

$sub{t01}{name}(@{$sub{t01}{args}});

sub mine {
    my %args = @_;

    ok( $args{one} eq 'first', 'arg one' );
    ok( $args{two} eq 'second', 'arg two' );
    done_testing;
}

$ perl sploot.pl
ok 1 - arg one
ok 2 - arg two
1..2

The bit that hurt you was that you didn't tell perl to expand the arguments into a list. So your function just got an array ref, so you probably got the "odd number of elements for hash" error. I elided the '->' since they're not strictly necessary, but they don't hurt either. (I typed it in, rather than cut & paste for some odd reason...)

...roboticus

When your only tool is a hammer, all problems look like your thumb.

[neilwatson]

The trouble with dereferencing: $sub{t01}{name}(@{$sub{t01}{args}});, is that all my other subs take a single argument, their dispatch entry looks like:

{
   name => \&mysub,
   arg => "some string"
}

So I have this one snowflake-of-a-sub that wants named params :( How can handle this exception elegantly?

[roboticus]

nielwatson:

That shouldn't be a problem: Just put all arguments in your dispatch has in arrayrefs, and when they're unwrapped, they'll be simple positional parameters. Having one is just fine. It's probably the most general form, as you can also pass an array of arguments, too, so you get it all: single arguments, multiple arguments, arrays, hashes and named arguments (hashes!).

$ cat sploot.pl
#!/usr/bin/env perl
use strict;
use warnings;
use Data::Dumper;
use Test::More;

my %sub = (
    t01=>{ name=>\&mine, args=>[qw/one first two second/] },
    t02=>{ name=>\&yours, args=>[ 'foo' ] },
    t03=>{ name=>\&ours,  args=>[qw/The quick red fox/] },
);

for my $T (keys %sub) {
    $sub{$T}->{name}->(@{$sub{$T}{args}});
}
done_testing;

sub mine {
    # named arguments example
    my %args = @_;

    ok( $args{one} eq 'first', 'arg one' );
    ok( $args{two} eq 'second', 'arg two' );
}

sub yours {
    # single argument example
    my $message = shift;

    ok( $message eq 'foo', 'A single argument' );
}

sub ours {
    # array example
    my @args = @_;

    ok( "The quick red fox" eq join(" ", @args), 'Argument array' );
}

Roboticus@Waubli ~
$ perl sploot.pl
ok 1 - Argument array
ok 2 - A single argument
ok 3 - arg one
ok 4 - arg two
1..4

Update: Added array example & text

...roboticus

When your only tool is a hammer, all problems look like your thumb.

[roboticus]

nielwatson:

Note: I posted this as a separate reply to prevent it from getting tangled up in the update above.

Since all your other subroutines take a single argument, you could also pass in an arrayref (as you currently do) and expand it into a hash inside the subroutine, *or* pass in a hashref and use it directly:

$ cat sploot2.pl
#!/usr/bin/env perl
use strict;
use warnings;
use Data::Dumper;
use Test::More;

my %sub = (
    t01=>{ name=>\&mine, args=>[qw/one first two second/] },
    t02=>{ name=>\&mine2, args=>{qw/one first two second/} },
);

for my $T (keys %sub) {
    $sub{$T}->{name}->($sub{$T}{args});
}
done_testing;

sub mine {
    # named arguments example
    my %args = @{$_[0]};

    ok( $args{one} eq 'first', 'arg one' );
    ok( $args{two} eq 'second', 'arg two' );
}

sub mine2 {
    # named arguments example
    my $args = shift;

    ok( $args->{one} eq 'first', 'arg one (b)' );
    ok( $args->{two} eq 'second', 'arg two (b)' );
}

Roboticus@Waubli ~
$ perl sploot2.pl
ok 1 - arg one (b)
ok 2 - arg two (b)
ok 3 - arg one
ok 4 - arg two
1..4

...roboticus

When your only tool is a hammer, all problems look like your thumb.

[Monk::Thomas]

btw. since you're already using Test::More you could go on and optimize the tests a bit:

sub mine
{
   my %args = @_;

   is( $args{one}, 'first', 'arg one' );
   is( $args{two}, 'second', 'arg two' );
   done_testing;
}

If the test fails it provides a bit more detail what went wrong, e.g.:

    not ok 1 - arg one
    #   Failed test 'arg one'
    #   in ###.t at line ###.
    #          got: 'foo'
    #     expected: 'first'

Another one of my favorites:

is_deeply(\@computed, \@expected, 'testname')
  or diag(Data::Dumper->Dump([\@computed], ['*computed']));