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

sartak at bestpractical.com sartak at bestpractical.com
Tue Oct 21 17:08:41 EDT 2008


Author: sartak
Date: Tue Oct 21 17:08:40 2008
New Revision: 16456

Modified:
   Path-Dispatcher/trunk/   (props changed)
   Path-Dispatcher/trunk/lib/Path/Dispatcher/Declarative.pm
   Path-Dispatcher/trunk/t/100-declarative.t

Log:
 r74328 at onn:  sartak | 2008-10-21 17:08:36 -0400
 Add "rewrite" sugar


Modified: Path-Dispatcher/trunk/lib/Path/Dispatcher/Declarative.pm
==============================================================================
--- Path-Dispatcher/trunk/lib/Path/Dispatcher/Declarative.pm	(original)
+++ Path-Dispatcher/trunk/lib/Path/Dispatcher/Declarative.pm	Tue Oct 21 17:08:40 2008
@@ -69,6 +69,16 @@
 
             $OUTERMOST_DISPATCHER->run(@_);
         },
+        rewrite => sub {
+            my ($from, $to) = @_;
+            my $rewrite = sub {
+                local $OUTERMOST_DISPATCHER = $dispatcher
+                    if !$OUTERMOST_DISPATCHER;
+                my $path = ref($to) eq 'CODE' ? $to->() : $to;
+                $OUTERMOST_DISPATCHER->run($path);
+            };
+            $into->_add_rule('on', $from, $rewrite);
+        },
         on => sub {
             $into->_add_rule('on', @_);
         },

Modified: Path-Dispatcher/trunk/t/100-declarative.t
==============================================================================
--- Path-Dispatcher/trunk/t/100-declarative.t	(original)
+++ Path-Dispatcher/trunk/t/100-declarative.t	Tue Oct 21 17:08:40 2008
@@ -1,7 +1,7 @@
 #!/usr/bin/env perl
 use strict;
 use warnings;
-use Test::More tests => 3;
+use Test::More tests => 5;
 
 my @calls;
 
@@ -13,6 +13,8 @@
         push @calls, [$1, $2, $3];
     };
 
+    rewrite quux => 'bar';
+    rewrite qr/^quux-(.*)/ => sub { "bar:$1" };
 };
 
 ok(MyApp::Dispatcher->isa('Path::Dispatcher::Declarative'), "use Path::Dispatcher::Declarative sets up ISA");
@@ -23,3 +25,13 @@
     [ 'b', 'ar', 'baz' ],
 ]);
 
+MyApp::Dispatcher->run('quux');
+is_deeply([splice @calls], [
+    [ 'b', 'ar', '' ],
+]);
+
+MyApp::Dispatcher->run('quux-hello');
+is_deeply([splice @calls], [
+    [ 'b', 'ar', ':hello' ],
+]);
+



More information about the Bps-public-commit mailing list