{
   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';
   }
}
[download]