Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
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
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            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 musing on the Monastery: (17)
    As of 2015-07-07 18:01 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









      Results (93 votes), past polls