Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling
 
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!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • 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?
    [choroba]: I'm definitely not obsessed with whitespace, I rate myself among Perl people, and I haven't noticed any hounding
    [marto]: "no it's not that"...."weirdos "...
    [marto]: List EXE_FILES installed by CPAN so a couple of people suggest that your code looks obfuscated. I'd have to ageree, from the perspective of those who can't follow all of that one liner, it doesn't read well
    Veltro is a weirdo, obsessed with whitespace
    [marto]: to use the word "obsession" when so few people have said so little about it is grasping at staws
    marto wishes tye was around, he's so much better at this sort of thing
    usemodperl likes tye!
    usemodperl tye  too
    [choroba]: Re^3: LiBXML: New markup while preserving earlier tags? would benefit from a couple of test cases
    usemodperl meant tye&nbsp;

    How do I use this? | Other CB clients
    Other Users?
    Others making s'mores by the fire in the courtyard of the Monastery: (8)
    As of 2018-06-24 16:01 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      Should cpanminus be part of the standard Perl release?



      Results (126 votes). Check out past polls.

      Notices?