Beefy Boxes and Bandwidth Generously Provided by pair Networks vroom
Just another Perl shrine
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??

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;

In reply to Re^2: Using Number Ranges in a Dispatch Table by tobyink
in thread Using Number Ranges in a Dispatch Table by planetscape

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others rifling through the Monastery: (7)
    As of 2014-04-17 02:34 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      April first is:







      Results (437 votes), past polls