[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