[Bps-public-commit] r15582 - in Path-Dispatcher/trunk: lib/Path/Dispatcher/Rule t

[sartak at bestpractical.com]

Author: sartak
Date: Wed Aug 27 23:23:37 2008
New Revision: 15582

Modified:
   Path-Dispatcher/trunk/   (props changed)
   Path-Dispatcher/trunk/lib/Path/Dispatcher/Rule/Tokens.pm
   Path-Dispatcher/trunk/t/013-tokens.t

Log:
 r70630 at onn:  sartak | 2008-08-27 23:23:31 -0400
 Support for alternation in the tokens rules


Modified: Path-Dispatcher/trunk/lib/Path/Dispatcher/Rule/Tokens.pm
==============================================================================
--- Path-Dispatcher/trunk/lib/Path/Dispatcher/Rule/Tokens.pm	(original)
+++ Path-Dispatcher/trunk/lib/Path/Dispatcher/Rule/Tokens.pm	Wed Aug 27 23:23:37 2008
@@ -15,14 +15,22 @@
 
 my $Str       = find_type_constraint('Str');
 my $RegexpRef = find_type_constraint('RegexpRef');
+my $ArrayRef  = find_type_constraint('ArrayRef');
 
 subtype 'Path::Dispatcher::Token'
      => as 'Defined'
      => where { $Str->check($_) || $RegexpRef->check($_) };
 
+subtype 'Path::Dispatcher::TokenAlternation'
+     => as 'ArrayRef[Path::Dispatcher::Token]';
+
+subtype 'Path::Dispatcher::Tokens'
+     => as 'ArrayRef[Path::Dispatcher::Token|Path::Dispatcher::TokenAlternation]';
+
 has tokens => (
     is         => 'ro',
-    isa        => 'ArrayRef[Path::Dispatcher::Token]',
+    isa        => 'Path::Dispatcher::Tokens',
+    isa        => 'ArrayRef',
     auto_deref => 1,
     required   => 1,
 );
@@ -54,7 +62,12 @@
     my $got      = shift;
     my $expected = shift;
 
-    if ($Str->check($expected)) {
+    if ($ArrayRef->check($expected)) {
+        for my $alternative (@$expected) {
+            return 1 if $self->_match_token($got, $alternative);
+        }
+    }
+    elsif ($Str->check($expected)) {
         return $got eq $expected;
     }
     elsif ($RegexpRef->check($expected)) {

Modified: Path-Dispatcher/trunk/t/013-tokens.t
==============================================================================
--- Path-Dispatcher/trunk/t/013-tokens.t	(original)
+++ Path-Dispatcher/trunk/t/013-tokens.t	Wed Aug 27 23:23:37 2008
@@ -1,7 +1,7 @@
 #!/usr/bin/env perl
 use strict;
 use warnings;
-use Test::More tests => 4;
+use Test::More tests => 9;
 use Path::Dispatcher;
 
 my @calls;
@@ -33,3 +33,32 @@
 $dispatcher->run('foo bar baz');
 is_deeply([splice @calls], [], "no matches");
 
+$dispatcher->stage('on')->add_rule(
+    Path::Dispatcher::Rule::Tokens->new(
+        tokens => [["Bat", "Super"], "Man"],
+        block  => sub { push @calls, [$1, $2, $3] },
+    ),
+);
+
+$dispatcher->run('Super Man');
+is_deeply([splice @calls], [ ['Super', 'Man', undef] ], "ran the [ [Str,Str], Str ] rule");
+
+$dispatcher->run('Bat Man');
+is_deeply([splice @calls], [ ['Bat', 'Man', undef] ], "ran the [ [Str,Str], Str ] rule");
+
+$dispatcher->run('Aqua Man');
+is_deeply([splice @calls], [ ], "no match");
+
+$dispatcher->stage('on')->add_rule(
+    Path::Dispatcher::Rule::Tokens->new(
+        tokens => [[[[qr/Deep/]]], "Man"],
+        block  => sub { push @calls, [$1, $2, $3] },
+    ),
+);
+
+$dispatcher->run('Deep Man');
+is_deeply([splice @calls], [ ['Deep', 'Man', undef] ], "alternations can be arbitrarily deep");
+
+$dispatcher->run('Not Appearing in this Dispatcher Man');
+is_deeply([splice @calls], [ ], "no match");
+