Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
 
PerlMonks  

Re^2: Using Number Ranges in a Dispatch Table

by tobyink (Abbot)
on Feb 19, 2012 at 22:50 UTC ( #954934=note: print w/ replies, xml ) Need Help??


in reply to Re: Using Number Ranges in a Dispatch Table
in thread Using Number Ranges in a Dispatch Table

OK, I can go better...

{ package Smart::Dispatch::ConditionList; use Any::Moose; use overload '&{}' => sub { my $x=shift; sub { $x->run($_[0]) } }, '.' => sub { (shift)->run(shift) }, '~~' => sub { (shift)->exists(shift) }; has conditions => ( is => 'ro', isa => 'ArrayRef[Smart::Dispatch::Condition]', required => 1, ); sub exists { my ($self, $value) = @_; foreach my $cond (@{ $self->conditions }) { if ($cond->value_matches($value)) { return $cond; } } return; } sub run { my ($self, $value, @args) = @_; my $cond = $self->exists($value); return $cond->conduct_dispatch($value, @args) if $cond; return; } } { package Smart::Dispatch::Condition; use Any::Moose; has test => ( is => 'ro', required => 1, ); has dispatch => ( is => 'ro', required => 0, ); has value => ( is => 'ro', required => 0, predicate => 'has_value', ); has note => ( is => 'ro', isa => 'Str', required => 0, ); sub value_matches { my ($self, $value) = @_; local $_ = $value; return ($value ~~ $self->test); } sub conduct_dispatch { my ($self, $value, @args) = @_; local $_ = $value; if (ref $self->dispatch eq 'CODE') { return $self->dispatch->($value, @args); } elsif ($self->has_value) { return $self->value; } else { warn "dispatch is not a code ref!"; return $self->dispatch; } } } { package Smart::Dispatch; use Carp; use parent qw/Exporter/; our ($IN_FLIGHT, @LIST, @EXPORT); BEGIN { $IN_FLIGHT = 0; @LIST; @EXPORT = qw/dispatcher match match_using dispatch otherwise/; } sub dispatcher (&) { my $builder = shift; local @LIST = (); local $IN_FLIGHT = 1; $builder->(); return Smart::Dispatch::ConditionList->new(conditions => [@LIST] +); }; sub match { croak "match cannot be used outside dispatcher" unless $IN_FLIGHT; my ($condition, %args) = (@_ == 2) ? (shift, _k($_[-1]), shift) +: (@_); push @LIST, Smart::Dispatch::Condition->new(test => $condition, %args); return; } sub match_using (&@) { croak "match_using cannot be used outside dispatcher" unless $IN_FLIGHT; goto \&match; } sub dispatch (&) { croak "dispatch cannot be used outside dispatcher" unless $IN_FLIGHT; return('dispatch', shift); } sub otherwise { croak "otherwise cannot be used outside dispatcher" unless $IN_FLIGHT; my (%args) = (@_ == 1) ? (_k($_[-1]), shift) : (@_); push @LIST, Smart::Dispatch::Condition->new(test => sub {1}, %args); return; } sub _k { ref $_[0] eq 'CODE' ? 'dispatch' : 'value'; } }
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;


Comment on Re^2: Using Number Ranges in a Dispatch Table
Select or Download Code

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://954934]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others contemplating the Monastery: (5)
As of 2014-09-21 06:23 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (166 votes), past polls