Dispatch table using Tie::RegexpHash

Hi all,

Given the threads on dispatch tables recently, I was writing a bit of a
whitepaper on how dts are useful for consolidating code.

I've run into an issue that I've been working on for some time (while
also performing my job function ;), and I'm hoping that extra eyeballs
will notice the problems.

Before I get elaborate in any which way with my documentation, I've just
been using a basic example (that you likely won't need to follow):

http://ipv6canada.com/code/dispatch_tables/dt1.pl.txt (and dt2.* and dt3.*)

Here is what I have that is breaking and I can't figure out why:

#!/usr/bin/perl

use warnings;
use strict;

use Tie::RegexpHash;

my $input = $ARGV[0];

my $number = qr/^\d+$/;
my $alpha = qr/^\w+$/;

tie my %dt, 'Tie::RegexpHash';

%dt = (

common => sub {
my $param = shift;
print "$param\n";
},

$number => sub {
return int( rand( 3 ) +1 );
},

$alpha => sub {
my @letters = ('a'..'z');
return $letters[ rand scalar @letters ];
},

run => \&run,
);

sub run {

my $param = shift;

$dt{ common }( $param ) ;
$dt{ run }( $dt{ $param } );
}

$dt{ run }( $input );

__END__

.... I've never used Tie::RegexpHash before, so if you can see what I was
trying to do with it, I'm open to criticism.

Cheers,

Steve

--
To unsubscribe, e-mail: beginners-unsubscribe@perl.org
For additional commands, e-mail: beginners-help@perl.org
http://learn.perl.org/

Re: Dispatch table using Tie::RegexpHash

>>>>> "SB" == Steve Bertrand writes:

SB> use Tie::RegexpHash;

SB> my $number = qr/^\d+$/;
SB> my $alpha = qr/^\w+$/;

SB> tie my %dt, 'Tie::RegexpHash';

that sounds like an insane idea for a module. but that is IMO. you can
do this with much less effort with a list of regexes paired with code
refs. and if that fails or you can control the order, you can then try a
regular dispatch table. there is no way this module can do anything else
but a linear search through all the regexes and then it won't allow
ordering which can be very important. this is too easy to roll your own
and you get better control from doing that. two strikes against it.

SB> %dt = (

SB> common => sub {
SB> my $param = shift;
SB> print "$param\n";
SB> },

SB> $number => sub {
SB> return int( rand( 3 ) +1 );
SB> },

SB> $alpha => sub {
SB> my @letters = ('a'..'z');
SB> return $letters[ rand scalar @letters ];
SB> },

SB> run => \&run,
SB> );

SB> sub run {

SB> my $param = shift;

SB> $dt{ common }( $param ) ;

that is the bug. all code refs need to be called either with & prefix or
by ->(). you have neither.

$dt{ common }->( $param ) ;


uri

--
Uri Guttman ------ uri@stemsystems.com -------- http://www.sysarch.com --
----- Perl Code Review , Architecture, Development, Training, Support ------
--------- Gourmet Hot Cocoa Mix ---- http://bestfriendscocoa.com ---------

--
To unsubscribe, e-mail: beginners-unsubscribe@perl.org
For additional commands, e-mail: beginners-help@perl.org
http://learn.perl.org/

Re: Dispatch table using Tie::RegexpHash

On 2010.04.29 23:23, Uri Guttman wrote:
>>>>>> "SB" == Steve Bertrand writes:
>
> SB> use Tie::RegexpHash;
>
> SB> my $number = qr/^\d+$/;
> SB> my $alpha = qr/^\w+$/;
>
> SB> tie my %dt, 'Tie::RegexpHash';
>
> that sounds like an insane idea for a module. but that is IMO. you can
> do this with much less effort with a list of regexes paired with code
> refs.

It's not my module. An example of what you just described would be most
appreciated ;)

> SB> $dt{ common }( $param ) ;
>
> that is the bug. all code refs need to be called either with & prefix or
> by ->(). you have neither.
>
> $dt{ common }->( $param ) ;

I swear I tried that. I'm obviously missing something. Why is the
following code working without the prefix, or the ->. Am I wrong in
thinking that what I'm doing below is a coderef?:

#!/usr/bin/perl

use warnings;
use strict;

my %dt = (
a => sub {
my $in = shift;
print "allo, $in\n"
},
);

$dt{ a }( 'uri' );

__END__

Thanks Uri, as always,

Steve

--
To unsubscribe, e-mail: beginners-unsubscribe@perl.org
For additional commands, e-mail: beginners-help@perl.org
http://learn.perl.org/

Re: Dispatch table using Tie::RegexpHash

>>>>> "SB" == Steve Bertrand writes:

SB> On 2010.04.29 23:23, Uri Guttman wrote:
>>>>>>> "SB" == Steve Bertrand writes:
>>
SB> use Tie::RegexpHash;
>>
SB> my $number = qr/^\d+$/;
SB> my $alpha = qr/^\w+$/;
>>
SB> tie my %dt, 'Tie::RegexpHash';
>>
>> that sounds like an insane idea for a module. but that is IMO. you can
>> do this with much less effort with a list of regexes paired with code
>> refs.

SB> It's not my module. An example of what you just described would be most
SB> appreciated ;)

i didn't say or imply it was your module! it just sounds like a bad idea
to me.

since you asked, i will whip up something that will be better because
you control the ordering (which is IMPORTANT!).

just look at the two regexes you put in there. \w+ INCLUDES \d+ as all
digits are word chars. so how would the \d+ one ever get matched if the
\w+ matches first? given that this is supposed to be a 'hash', it means
order isn't preserved. i haven't looked at the module docs but even
order hashes like hashIX and such blow up when you delete/add things
randomly. you can't determine what order you want or will get as any
ordering will be arbitrary and break other possible orderings. that is
why hashes HAVE NO ordering. foisting one upon them breaks their
hashiness!

SB> I swear I tried that. I'm obviously missing something. Why is the
SB> following code working without the prefix, or the ->. Am I wrong in
SB> thinking that what I'm doing below is a coderef?:

SB> #!/usr/bin/perl

SB> use warnings;
SB> use strict;

SB> my %dt = (
SB> a => sub {
SB> my $in = shift;
SB> print "allo, $in\n"
SB> },
SB> );

SB> $dt{ a }( 'uri' );

there is a syntax rule in perl about ->. if it is found between a close
and then open of paired chars (parens, brackets, braces), it can be
removed. that code is the same as:

$dt{ a }->( 'uri' );

this same thing is used to simplify deep data accesses:

$foo{ xx }->{ yy }->{ zz }
becomes
$foo{ xx }{ yy }{ zz }


since i usually call code refs via a scalar that i have assigned, you
must use -> there since there is no paired close char.

$code = $dt{a} ;
$code->( 'uri' ) ;

with dispatch tables i usually assign to a scalar first so i can deal
with a default case which wasn't found in the table:

$code = $dt{ $key } || \&handle_default ;
$code->( 'uri' ) ;

or if the default is already in the table:

$code = $dt{ $key } || $dt{ default } ;

now for the regex dispatch table. first off you use a list of list
design since you need to group each regex with a code ref and you need
to be able to scan them linearly. this way you control the order of
checking. you can easily make it mix/match regexes with exact strings
with a little checking code. the table is like this (all untested code):


# note the ordering so numbers are found before all word chars and fixed
# words are also found before them.

my $fancy_dispatch_table = [

[ qr/^\d+$/ => sub { print "all digits" } ],
[ foo => sub { print "found foo" } ],
[ bar => sub { print "found bar" } ],
[ qr/^\w+$/ => sub { print "all word chars" } ],
] ;

# this returns the sub to call. you can make it call the sub directly to
# your taste or design.

sub fancy_dispatcher {
my( $in_key ) = @_ ;

# if the table didn't have the sublists, then some module which does
# pair at a time looping would work. perl 6 has this and some perl5
# module can do it. i stick with this so i don't need more modules.

foreach my $disp_pair ( @{$fancy_dispatch_table} ) {

my( $key, $code ) = @{$disp_pair} ;

# check for a regex first, then default to a fixed string test.
# note that if a regex but it fails, go to the next entry

if ( ref $key eq 'Regexp' ) {
return $code if $in_key =~ /$key/ ;
next ;
}

# this must be a fixed string test

return $code if $in_key eq $key ;
}

# we found no match. in this example we return nothing. you could return
# a default code ref like return( \&default_handler ).

return ;
}

# i don't handle defaults here. easy to check the code return or return
# a default code ref as i commented above

my $code = fancy_dispatcher( 'bar' ) ;
$code->() if $code ;
my $code = fancy_dispatcher( 'qwert' ) ;
$code->() if $code ;
my $code = fancy_dispatcher( 123 ) ;
$code->() if $code ;

now that wasn't too hard was it? :)

remember, the advantage of a pure hash dispatch table is that you only
ever do one lookup so it will be faster, especially for larger
tables. and the code is simpler. but this should work well if you need a
fancier dispatch.

uri

--
Uri Guttman ------ uri@stemsystems.com -------- http://www.sysarch.com --
----- Perl Code Review , Architecture, Development, Training, Support ------
--------- Gourmet Hot Cocoa Mix ---- http://bestfriendscocoa.com ---------

--
To unsubscribe, e-mail: beginners-unsubscribe@perl.org
For additional commands, e-mail: beginners-help@perl.org
http://learn.perl.org/