[Catalyst-commits] r13117 - in Catalyst-Runtime/5.80/branches/refactoring_dispatcher: lib/Catalyst t/aggregate t/lib/TestApp/Controller/Action

jnapiorkowski at dev.catalyst.perl.org jnapiorkowski at dev.catalyst.perl.org
Thu Apr 1 13:33:36 GMT 2010


Author: jnapiorkowski
Date: 2010-04-01 14:33:35 +0100 (Thu, 01 Apr 2010)
New Revision: 13117

Modified:
   Catalyst-Runtime/5.80/branches/refactoring_dispatcher/lib/Catalyst/Dispatcher.pm
   Catalyst-Runtime/5.80/branches/refactoring_dispatcher/t/aggregate/live_component_controller_action_chain_matchargs.t
   Catalyst-Runtime/5.80/branches/refactoring_dispatcher/t/aggregate/live_component_controller_action_path_matchargs.t
   Catalyst-Runtime/5.80/branches/refactoring_dispatcher/t/lib/TestApp/Controller/Action/ChainedMatchArgs.pm
Log:
reverted dispatcher code, tweaked the chained test to improve the case a bit

Modified: Catalyst-Runtime/5.80/branches/refactoring_dispatcher/lib/Catalyst/Dispatcher.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/refactoring_dispatcher/lib/Catalyst/Dispatcher.pm	2010-03-31 20:09:17 UTC (rev 13116)
+++ Catalyst-Runtime/5.80/branches/refactoring_dispatcher/lib/Catalyst/Dispatcher.pm	2010-04-01 13:33:35 UTC (rev 13117)
@@ -359,87 +359,38 @@
 sub prepare_action {
     my ( $self, $c ) = @_;
     my $req = $c->req;
+    my $path = $req->path;
+    my @path = split /\//, $req->path;
     $req->args( \my @args );
-    my @path = $self->decompose_path_for_prepare_action($c, $req->path);
-    my $args = $self->dispatch_against_paths($c, \@path, \@args);
 
-    s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg
-      for grep { defined } @{$req->captures||[]};
+    unshift( @path, '' );    # Root action
 
-    $c->log->debug( 'Path is "' . $req->match . '"' )
-      if ( $c->debug && defined $req->match && length $req->match );
+  DESCEND: while (@path) {
+        $path = join '/', @path;
+        $path =~ s#^/+##;
 
-    $c->log->debug( 'Arguments are "' . join( '/', @$args ) . '"' )
-      if ( $c->debug && @$args );
-}
+        # Check out dispatch types to see if any will handle the path at
+        # this level
 
-=head2 $self->dispatch_against_paths($c, $path, $capture_args?)
+        foreach my $type ( @{ $self->dispatch_types } ) {
+            last DESCEND if $type->match( $c, $path );
+        }
 
-Recursive subroutine to see if we can dispatch to a given $path.
-
-=cut
-
-sub dispatch_against_paths {
-    my ($self, $c, $paths, $args) = (@_, []);
-    my $path = join '/', @$paths;
-    $path =~ s#^/+##;
-    if($self->match_dispatch_types_to_path($c, $path, @{ $self->dispatch_types })) {
-        return $args; ## all done
-    } else {
         # If not, move the last part path to args
-        my $arg = pop(@$paths);
+        my $arg = pop(@path);
         $arg =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
-        unshift @$args, $arg;
-        if(@$paths) {
-            return $self->dispatch_against_paths($c, $paths, $args);
-        } else {
-            return $args;
-        }
+        unshift @args, $arg;
     }
-}
 
-=head2 $self->match_dispatch_types_to_path($c, $path, @dispatch_types)
+    s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg for grep { defined } @{$req->captures||[]};
 
-Does a $path dispatch to any of the given dispatch types? (CHECKED)
+    $c->log->debug( 'Path is "' . $req->match . '"' )
+      if ( $c->debug && defined $req->match && length $req->match );
 
-=cut
-
-sub match_dispatch_types_to_path {
-    my ($self, $c, $path, $dispatch_type, @dispatch_types) = @_;
-    if(my $match = $self->match_dispatch_type_to_path($c, $path, $dispatch_type)) {
-        return $match;
-    } elsif(@dispatch_types) {
-        return $self->match_dispatch_types_to_path($c, $path, @dispatch_types);
-    } else {
-        return;
-    }
+    $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' )
+      if ( $c->debug && @args );
 }
 
-=head2 $self->match_dispatch_type_to_path($c, $path, $dispatch_type)
-
-Does a given $dispatch_type match a given $path? (CHECKED)
-
-=cut
-
-sub match_dispatch_type_to_path {
-    my ($self, $c, $path, $dispatch_type) = @_;
-    return $dispatch_type->match($c, $path);
-}
-
-=head2 $self->decompose_path_for_prepare_action($c, $path)
-
-Given a $path, as from the request object, break it up into an array of parts
-used to determine dispatching. (CHECKED)
-
-=cut
-
-sub decompose_path_for_prepare_action {
-    my ($self, $c, $path) = @_;
-    my @path = (split(/\//, $path));
-    unshift( @path, '' ); ## Root action
-    return @path;
-}
-
 =head2 $self->get_action( $action, $namespace )
 
 returns a named action from a given namespace.
@@ -813,3 +764,4 @@
 =cut
 
 1;
+

Modified: Catalyst-Runtime/5.80/branches/refactoring_dispatcher/t/aggregate/live_component_controller_action_chain_matchargs.t
===================================================================
--- Catalyst-Runtime/5.80/branches/refactoring_dispatcher/t/aggregate/live_component_controller_action_chain_matchargs.t	2010-03-31 20:09:17 UTC (rev 13116)
+++ Catalyst-Runtime/5.80/branches/refactoring_dispatcher/t/aggregate/live_component_controller_action_chain_matchargs.t	2010-04-01 13:33:35 UTC (rev 13117)
@@ -10,7 +10,7 @@
 
 BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; }
 
-use Test::More tests => 16*$iters;
+use Test::More tests => 24*$iters;
 use Catalyst::Test 'TestApp';
 
 if ( $ENV{CAT_BENCHMARK} ) {
@@ -27,6 +27,20 @@
     {
         ok(
             my $response =
+              request('http://localhost/action/chainedmatchargs/1/end/22/3'),
+            'Request'
+        );
+        ok( $response->is_success, 'Response Successful 2xx' );
+        is( $response->content_type, 'text/plain', 'Response Content-Type' );
+        is(
+            $response->header('X-Catalyst-Action-Private'),
+            'action/chainedmatchargs/endpoint4',
+            'Test Action'
+        );
+    }
+    {
+        ok(
+            my $response =
               request('http://localhost/action/chainedmatchargs/1/end/2'),
             'Request'
         );
@@ -67,8 +81,24 @@
         );
     }
     {
+        ## Repeat test to fail order sensitive action bugs
         ok(
             my $response =
+              request('http://localhost/action/chainedmatchargs/2/partway/5x5/end/9'),
+            'Request'
+        );
+        ok( $response->is_success, 'Response Successful 2xx' );
+        is( $response->content_type, 'text/plain', 'Response Content-Type' );
+        is(
+            $response->header('X-Catalyst-Action-Private'),
+            'action/chainedmatchargs/endpointx',
+            'Test Action'
+        );
+    }
+    {
+        ## Repeat test to fail order sensitive action bugs
+        ok(
+            my $response =
               request('http://localhost/action/chainedmatchargs/1/end/22/3'),
             'Request'
         );

Modified: Catalyst-Runtime/5.80/branches/refactoring_dispatcher/t/aggregate/live_component_controller_action_path_matchargs.t
===================================================================
--- Catalyst-Runtime/5.80/branches/refactoring_dispatcher/t/aggregate/live_component_controller_action_path_matchargs.t	2010-03-31 20:09:17 UTC (rev 13116)
+++ Catalyst-Runtime/5.80/branches/refactoring_dispatcher/t/aggregate/live_component_controller_action_path_matchargs.t	2010-04-01 13:33:35 UTC (rev 13117)
@@ -10,7 +10,7 @@
 
 BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; }
 
-use Test::More tests => 18*$iters;
+use Test::More tests => 24*$iters;
 use Catalyst::Test 'TestApp';
 
 if ( $ENV{CAT_BENCHMARK} ) {
@@ -25,8 +25,32 @@
 
 sub run_tests {
     {
+    {
         ok(
             my $response =
+              request('http://localhost/action/pathmatchargs/one/111'),
+            'Request'
+        );
+        ok( $response->is_success, 'Response Successful 2xx' );
+        is( $response->content_type, 'text/plain', 'Response Content-Type' );
+        is(
+            $response->header('X-Catalyst-Action-Private'),
+            'action/pathmatchargs/three',
+            'Test Action'
+        );
+        is(
+            $response->header('X-Test-Class'),
+            'TestApp::Controller::Action::PathMatchArgs',
+            'Test Class'
+        );
+        like(
+            $response->content,
+            qr/^bless\( .* 'Catalyst::Request' \)$/s,
+            'Content is a serialized Catalyst::Request'
+        );
+    }
+        ok(
+            my $response =
               request('http://localhost/action/pathmatchargs/one/1'),
             'Request'
         );
@@ -73,6 +97,8 @@
         );
     }
     {
+        ## Run this test twice to make sure the regexp dispatch is not just
+        ## following controller order or something like that
         ok(
             my $response =
               request('http://localhost/action/pathmatchargs/one/111'),

Modified: Catalyst-Runtime/5.80/branches/refactoring_dispatcher/t/lib/TestApp/Controller/Action/ChainedMatchArgs.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/refactoring_dispatcher/t/lib/TestApp/Controller/Action/ChainedMatchArgs.pm	2010-03-31 20:09:17 UTC (rev 13116)
+++ Catalyst-Runtime/5.80/branches/refactoring_dispatcher/t/lib/TestApp/Controller/Action/ChainedMatchArgs.pm	2010-04-01 13:33:35 UTC (rev 13117)
@@ -19,6 +19,26 @@
         die "more than 1 argument" if @args > 1;
 }
 
+sub partway1
+	:ActionClass('+TestApp::Action::MatchCapturesRegexp')
+    :PathPart('partway') 
+    :Chained('foo')
+    :MatchCapturesRegexp('\dx\d')
+    :CaptureArgs(1) {
+    	my ($self, $c, @args) = @_;
+        $c->forward('TestApp::View::Dump::Request');    
+    }
+
+sub endpointx
+	:ActionClass('+TestApp::Action::MatchCapturesRegexp')
+    :PathPart('end') 
+    :Chained('partway1')
+    :MatchCapturesRegexp('\d')
+    :Args(1) {
+    	my ($self, $c, @args) = @_;
+        $c->forward('TestApp::View::Dump::Request');    
+    }
+
 sub endpoint1
 	:ActionClass('+TestApp::Action::MatchCapturesRegexp')
     :PathPart('end') 




More information about the Catalyst-commits mailing list