>>>>> "SB" == Steve Bertrand <st...@ipv6canada.com> writes:
SB> On 2010.04.29 23:23, Uri Guttman wrote:
>>>>>>> "SB" == Steve Bertrand <st...@ipv6canada.com> 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 ------ u...@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-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/
