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

[sartak at bestpractical.com]

Author: sartak
Date: Wed Jul 30 12:19:52 2008
New Revision: 14639

Added:
   Path-Dispatcher/trunk/t/007-coderef-matcher.t
Modified:
   Path-Dispatcher/trunk/   (props changed)
   Path-Dispatcher/trunk/lib/Path/Dispatcher.pm
   Path-Dispatcher/trunk/lib/Path/Dispatcher/Rule.pm

Log:
 r68010 at onn:  sartak | 2008-07-30 12:19:40 -0400
 Support for arbitrary dispatch matching with coderefs (so we can support Jifty::Dispatcher's "when" rule type)


Modified: Path-Dispatcher/trunk/lib/Path/Dispatcher.pm
==============================================================================
--- Path-Dispatcher/trunk/lib/Path/Dispatcher.pm	(original)
+++ Path-Dispatcher/trunk/lib/Path/Dispatcher.pm	Wed Jul 30 12:19:52 2008
@@ -54,8 +54,8 @@
                 or next;
 
             push @matches, {
-                rule => $rule,
-                vars => $vars,
+                rule   => $rule,
+                result => $vars,
             };
 
             last if !$rule->fallthrough;
@@ -83,10 +83,16 @@
         eval {
             local $SIG{__DIE__} = 'DEFAULT';
             for my $match (@$matches) {
-                $self->run_with_number_vars(
-                    sub { $match->{rule}->run($path) },
-                    @{ $match->{vars} },
-                );
+                # if we need to set $1, $2..
+                if (ref($match->{result}) eq 'ARRAY') {
+                    $self->run_with_number_vars(
+                        sub { $match->{rule}->run($path) },
+                        @{ $match->{result} },
+                    );
+                }
+                else {
+                    $match->{rule}->run($path);
+                }
             }
         };
 

Modified: Path-Dispatcher/trunk/lib/Path/Dispatcher/Rule.pm
==============================================================================
--- Path-Dispatcher/trunk/lib/Path/Dispatcher/Rule.pm	(original)
+++ Path-Dispatcher/trunk/lib/Path/Dispatcher/Rule.pm	Wed Jul 30 12:19:52 2008
@@ -9,9 +9,9 @@
     required => 1,
 );
 
-has regex => (
+has matcher => (
     is       => 'ro',
-    isa      => 'Regexp',
+    isa      => 'CodeRef',
     required => 1,
 );
 
@@ -31,14 +31,53 @@
     },
 );
 
+around BUILDARGS => sub {
+    my $orig = shift;
+    my $self = shift;
+    my $args = $self->$orig(@_);
+
+    if (!$args->{matcher} && $args->{regex}) {
+        $args->{matcher} = $self->build_regex_matcher(delete $args->{regex});
+    }
+
+    return $args;
+};
+
+sub build_regex_matcher {
+    my $self = shift;
+    my $re   = shift;
+
+    # compile the regex immediately, instead of each match
+    $re = qr/$re/;
+
+    return sub {
+        return unless $_ =~ $re;
+
+        my $path = $_;
+        return [ map { substr($path, $-[$_], $+[$_] - $-[$_]) } 1 .. $#- ];
+    }
+}
+
 sub match {
     my $self = shift;
     my $path = shift;
 
-    return unless $path =~ $self->regex;
+    local $_ = $path;
+    my $result = $self->matcher->();
+    return unless $result;
+
+    # make sure that the returned values are PLAIN STRINGS
+    # later we will stick them into a regular expression to populate $1 etc
+    # which will blow up later!
+
+    if (ref($result) eq 'ARRAY') {
+        for (@$result) {
+            die "Invalid result '$_', results must be plain strings"
+                if ref($_);
+        }
+    }
 
-    # return [$1, $2, $3, ...]
-    return [ map { substr($path, $-[$_], $+[$_] - $-[$_]) } 1 .. $#- ]
+    return $result;
 }
 
 sub run {

Added: Path-Dispatcher/trunk/t/007-coderef-matcher.t
==============================================================================
--- (empty file)
+++ Path-Dispatcher/trunk/t/007-coderef-matcher.t	Wed Jul 30 12:19:52 2008
@@ -0,0 +1,19 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More tests => 2;
+use Path::Dispatcher;
+
+my (@matches, @calls);
+
+my $dispatcher = Path::Dispatcher->new;
+$dispatcher->add_rule(
+    matcher => sub { push @matches, $_; length > 5 },
+    block   => sub { push @calls, [@_] },
+);
+
+$dispatcher->run('foobar');
+
+is_deeply([splice @matches], ['foobar']);
+is_deeply([splice @calls], [ [] ]);
+