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

[sartak at bestpractical.com]

Author: sartak
Date: Wed Aug 27 23:11:39 2008
New Revision: 15581

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

Log:
 r70628 at onn:  sartak | 2008-08-27 23:11:33 -0400
 Allow regexes in the token matcher, and write tests


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:11:39 2008
@@ -1,11 +1,28 @@
 #!/usr/bin/env perl
 package Path::Dispatcher::Rule::Tokens;
 use Moose;
+use Moose::Util::TypeConstraints;
 extends 'Path::Dispatcher::Rule';
 
+# a token may be
+#   - a string
+#   - a regular expression
+
+# this will be extended to add
+#   - an array reference containing (alternations)
+#     - strings
+#     - regular expressions
+
+my $Str       = find_type_constraint('Str');
+my $RegexpRef = find_type_constraint('RegexpRef');
+
+subtype 'Path::Dispatcher::Token'
+     => as 'Defined'
+     => where { $Str->check($_) || $RegexpRef->check($_) };
+
 has tokens => (
     is         => 'ro',
-    isa        => 'ArrayRef[Str]',
+    isa        => 'ArrayRef[Path::Dispatcher::Token]',
     auto_deref => 1,
     required   => 1,
 );
@@ -20,20 +37,36 @@
     my $self = shift;
     my $path = shift;
 
-    my @tokens = split $self->splitter, $path;
+    my @orig_tokens = split $self->splitter, $path;
+    my @tokens = @orig_tokens;
 
     for my $expected ($self->tokens) {
         my $got = shift @tokens;
+        return unless $self->_match_token($got, $expected);
+    }
+
+    return if @tokens; # too many words
+    return [@orig_tokens];
+}
+
+sub _match_token {
+    my $self     = shift;
+    my $got      = shift;
+    my $expected = shift;
 
-        return if $got ne $expected;
+    if ($Str->check($expected)) {
+        return $got eq $expected;
+    }
+    elsif ($RegexpRef->check($expected)) {
+        return $got =~ $expected;
     }
 
-    return if @tokens;
-    return 1;
+    return 0;
 }
 
 __PACKAGE__->meta->make_immutable;
 no Moose;
+no Moose::Util::TypeConstraints;
 
 1;
 

Added: Path-Dispatcher/trunk/t/013-tokens.t
==============================================================================
--- (empty file)
+++ Path-Dispatcher/trunk/t/013-tokens.t	Wed Aug 27 23:11:39 2008
@@ -0,0 +1,35 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More tests => 4;
+use Path::Dispatcher;
+
+my @calls;
+
+my $dispatcher = Path::Dispatcher->new;
+$dispatcher->stage('on')->add_rule(
+    Path::Dispatcher::Rule::Tokens->new(
+        tokens => ['foo', 'bar'],
+        block  => sub { push @calls, [$1, $2, $3] },
+    ),
+);
+
+$dispatcher->run('foo bar');
+is_deeply([splice @calls], [ ['foo', 'bar', undef] ], "correctly populated number vars from [str, str] token rule");
+
+$dispatcher->stage('on')->add_rule(
+    Path::Dispatcher::Rule::Tokens->new(
+        tokens => ['foo', qr/bar/],
+        block  => sub { push @calls, [$1, $2, $3] },
+    ),
+);
+
+$dispatcher->run('foo bar');
+is_deeply([splice @calls], [ ['foo', 'bar', undef] ], "ran the first [str, str] rule");
+
+$dispatcher->run('foo barbaz');
+is_deeply([splice @calls], [ ['foo', 'barbaz', undef] ], "ran the second [str, regex] rule");
+
+$dispatcher->run('foo bar baz');
+is_deeply([splice @calls], [], "no matches");
+