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

[sartak at bestpractical.com]

Author: sartak
Date: Wed Jul 30 16:39:14 2008
New Revision: 14672

Modified:
   Path-Dispatcher/trunk/   (props changed)
   Path-Dispatcher/trunk/lib/Path/Dispatcher.pm
   Path-Dispatcher/trunk/t/008-super-dispatcher.t

Log:
 r68110 at onn:  sartak | 2008-07-30 16:39:10 -0400
 Support (and more tests for) "super" dispatchers


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 16:39:14 2008
@@ -19,6 +19,12 @@
     },
 );
 
+has super_dispatcher => (
+    is        => 'rw',
+    isa       => 'Path::Dispatcher',
+    predicate => 'has_super_dispatcher',
+);
+
 sub add_rule {
     my $self = shift;
 
@@ -48,11 +54,14 @@
 
     for my $stage ($self->stages) {
         $self->begin_stage($stage, \@matches);
+        my $stage_matches = 0;
 
         for my $rule (@{ $rules_for_stage{$stage} || [] }) {
             my $vars = $rule->match($path)
                 or next;
 
+            ++$stage_matches;
+
             push @matches, {
                 rule   => $rule,
                 result => $vars,
@@ -61,6 +70,14 @@
             last if !$rule->fallthrough;
         }
 
+        my $defer = $stage_matches == 0
+                 && $self->has_super_dispatcher
+                 && $self->defer_to_super_dispatcher($stage);
+
+        if ($defer) {
+            push @matches, $self->super_dispatcher->dispatch($path);
+        }
+
         $self->end_stage($stage, \@matches);
     }
 
@@ -83,6 +100,11 @@
         eval {
             local $SIG{__DIE__} = 'DEFAULT';
             for my $match (@$matches) {
+                if (ref($match) eq 'CODE') {
+                    $match->();
+                    next;
+                }
+
                 # if we need to set $1, $2..
                 if (ref($match->{result}) eq 'ARRAY') {
                     $self->run_with_number_vars(
@@ -125,6 +147,14 @@
 sub begin_stage {}
 sub end_stage {}
 
+sub defer_to_super_dispatcher {
+    my $self = shift;
+    my $stage = shift;
+
+    return 1 if $stage eq 'on';
+    return 0;
+}
+
 __PACKAGE__->meta->make_immutable;
 no Moose;
 

Modified: Path-Dispatcher/trunk/t/008-super-dispatcher.t
==============================================================================
--- Path-Dispatcher/trunk/t/008-super-dispatcher.t	(original)
+++ Path-Dispatcher/trunk/t/008-super-dispatcher.t	Wed Jul 30 16:39:14 2008
@@ -1,7 +1,7 @@
 #!/usr/bin/env perl
 use strict;
 use warnings;
-use Test::More tests => 3;
+use Test::More tests => 6;
 use Path::Dispatcher;
 
 my @calls;
@@ -11,6 +11,10 @@
     super_dispatcher => $super_dispatcher,
 );
 
+ok(!$super_dispatcher->has_super_dispatcher, "no super dispatcher by default");
+ok($sub_dispatcher->has_super_dispatcher, "sub dispatcher has a super");
+is($sub_dispatcher->super_dispatcher, $super_dispatcher, "the super dispatcher is correct");
+
 for my $stage (qw/before on after/) {
     $super_dispatcher->add_rule(
         stage => $stage,