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

[sartak at bestpractical.com]

Author: sartak
Date: Wed Jul 30 15:55:14 2008
New Revision: 14649

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

Log:
 r68083 at onn:  sartak | 2008-07-30 15:55:10 -0400
 Add "on", more tests


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	Wed Jul 30 15:55:14 2008
@@ -33,8 +33,20 @@
 
     return {
         dispatcher => sub { $dispatcher },
-        dispatch   => sub { $dispatcher->dispatch(@_) },
-        run        => sub { $dispatcher->run(@_) },
+        dispatch   => sub {
+            shift; # don't need $self
+            $dispatcher->dispatch(@_);
+        },
+        run => sub {
+            shift; # don't need $self
+            $dispatcher->run(@_);
+        },
+        on => sub {
+            $dispatcher->add_rule(
+                regex => $_[0],
+                block => $_[1],
+            );
+        },
     };
 }
 

Modified: Path-Dispatcher/trunk/t/100-declarative.t
==============================================================================
--- Path-Dispatcher/trunk/t/100-declarative.t	(original)
+++ Path-Dispatcher/trunk/t/100-declarative.t	Wed Jul 30 15:55:14 2008
@@ -1,21 +1,41 @@
 #!/usr/bin/env perl
 use strict;
 use warnings;
-use Test::More tests => 4;
+use Test::More tests => 5;
 
-do {
-    package MyApp::Dispatcher;
-    use Path::Dispatcher::Declarative -base;
-};
-
-ok(MyApp::Dispatcher->isa('Path::Dispatcher::Declarative'), "use Path::Dispatcher::Declarative -base sets up ISA");
-can_ok('MyApp::Dispatcher', qw/dispatcher dispatch run/);
-
-do {
-    package MyApp::Dispatcher::NoBase;
-    use Path::Dispatcher::Declarative;
-};
+my @calls;
 
-ok(!MyApp::Dispatcher::NoBase->isa('Path::Dispatcher::Declarative'), "use Path::Dispatcher::Declarative without -base does not set up ISA");
-can_ok('MyApp::Dispatcher::NoBase', qw/dispatcher dispatch run/);
+for my $use_base (0, 1) {
+    my $dispatcher = $use_base ? 'MyApp::Dispatcher' : 'MyApp::DispatcherBase';
+
+    # duplicated code is worse than eval!
+    my $code = "
+        package $dispatcher;
+    ";
+
+    $code .= 'use Path::Dispatcher::Declarative';
+    $code .= ' -base' if $use_base;
+    $code .= ';';
+
+    $code .= '
+        on qr/(b)(ar)(.*)/ => sub {
+            push @calls, [$1, $2, $3];
+        };
+    ';
+
+    eval $code;
+
+    if ($use_base) {
+        ok($dispatcher->isa('Path::Dispatcher::Declarative'), "use Path::Dispatcher::Declarative -base sets up ISA");
+    }
+    else {
+        ok(!$dispatcher->isa('Path::Dispatcher::Declarative'), "use Path::Dispatcher::Declarative does NOT set up ISA");
+    }
+
+    can_ok($dispatcher => qw/dispatcher dispatch run/);
+    $dispatcher->run('foobarbaz');
+    is_deeply([splice @calls], [
+        [ 'b', 'ar', 'baz' ],
+    ]);
+}