Re: Using Number Ranges in a Dispatch Table

[tobyink]

use strict;

{
   package Dispatch::Table;
   use overload
      '&{}' => sub { my $x=shift; sub { $x->lookup($_[0]) } },
      '.'   => sub { (shift)->lookup(shift) },
      '~~'  => sub { (shift)->exists(shift) };
   sub new
   {
      my $class = shift;
      my @self;
      while (@_)
      {
         my ($test, $action) = (shift, shift);
         push @self, [$test => $action];
      }
      bless \@self, $class;
   }
   sub lookup
   {
      my ($self, $value) = @_;
      foreach my $entry (@$self)
      {
         if ($value ~~ $entry->[0])
         {
            return ref $entry->[1] eq 'CODE' ?
               $entry->[1]->($value) :
               $entry->[1];
         }
      }
      return;
   }
   sub exists
   {
      my ($self, $value) = @_;
      foreach my $entry (@$self)
      {
         if ($value ~~ $entry->[0])
         {
            return ref $entry->[1] eq 'CODE' ?
               $entry->[1] :
               sub { $entry->[1] };
         }
      }
      return;
   }
}

sub action_1_to_999 {
   print "1 to 999\n";
}

my $dispatch = Dispatch::Table->new(
   0           => sub { print "Zero\n" },
   [1..10]     => sub { print "Single digit\n"},
   1_000       => sub { print "1e3\n" },
   qr/^\d{4}/  => sub { print "Over a thousand\n"},
   sub { my $x = shift; $x>0 && $x<1000 } => \&action_1_to_999,
);

$dispatch.0;   # call dispatch table on value '0'
$dispatch.3;   # call dispatch table on value '3'
$dispatch.23;  # guess!

# call dispatch table on '999999' but only if the dispatch table
# has an entry that covers value '-1'.
$dispatch.999999 if $dispatch ~~ -1; 

# call dispatch table on '1000' but only if the dispatch table
# has an entry that covers value '4'.
$dispatch.1000 if $dispatch ~~ 4; 
__END__
Zero
Single digit
1 to 999
1e3

[tobyink]

OK, I can go better...

Read more... (4 kB)

use 5.010;
use strict;
use Smart::Dispatch;

sub action_1_to_999 {
   "1 to 999";
}

my $dispatch = dispatcher {
   match 0,
      dispatch { "Zero" };
   match [1..10],
      dispatch { "Single digit" };
   match 1_000,
      dispatch { "1e3" };
   match qr/^\d{4}/,
      dispatch { "Over a thousand\n"};
   match_using { $_ > 0 and $_ < 1000 }
      dispatch \&action_1_to_999;
};

say $dispatch.0;   # call dispatch table on value '0'
say $dispatch.3;   # call dispatch table on value '3'
say $dispatch.23;  # guess!

# call dispatch table on '999999' but only if the dispatch table
# has an entry that covers value '-1'.
say $dispatch.999999 if $dispatch ~~ -1; 

# call dispatch table on '1000' but only if the dispatch table
# has an entry that covers value '4'.
say $dispatch.1000 if $dispatch ~~ 4;