[Catalyst-commits] r8002 - in Catalyst-Runtime/5.70/trunk: . lib lib/Catalyst t t/lib t/lib/TestApp/Controller/Action

marcus at dev.catalyst.perl.org marcus at dev.catalyst.perl.org
Wed Jun 25 21:16:16 BST 2008


Author: marcus
Date: 2008-06-25 21:16:15 +0100 (Wed, 25 Jun 2008)
New Revision: 8002

Added:
   Catalyst-Runtime/5.70/trunk/t/lib/TestApp/Controller/Action/Go.pm
   Catalyst-Runtime/5.70/trunk/t/live_component_controller_action_go.t
Modified:
   Catalyst-Runtime/5.70/trunk/
   Catalyst-Runtime/5.70/trunk/lib/Catalyst.pm
   Catalyst-Runtime/5.70/trunk/lib/Catalyst/Dispatcher.pm
   Catalyst-Runtime/5.70/trunk/t/lib/TestApp.pm
   Catalyst-Runtime/5.70/trunk/t/lib/TestApp/Controller/Action/TestRelative.pm
Log:
merge go branch.


Property changes on: Catalyst-Runtime/5.70/trunk
___________________________________________________________________
Name: svk:merge
   - 1c72fc7c-9ce4-42af-bf25-3bfe470ff1e8:/local/Catalyst/trunk/Catalyst-Runtime:9763
4ad37cd2-5fec-0310-835f-b3785c72a374:/Catalyst-Runtime/5.70/branches/compres:7999
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/Catalyst-ChildOf:4443
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/Catalyst-Runtime-jrockway:5857
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/Catalyst-component-setup:4320
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/Catalyst-docs:4325
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/current/Catalyst-Runtime:5142
4ad37cd2-5fec-0310-835f-b3785c72a374:/trunk/Catalyst:4483
4ad37cd2-5fec-0310-835f-b3785c72a374:/trunk/Catalyst-Runtime:6165
d7608cd0-831c-0410-93c0-e5b306c3c028:/local/Catalyst/Catalyst-Runtime:8339
d7608cd0-831c-0410-93c0-e5b306c3c028:/local/Catalyst/Catalyst-Runtime-jrockway:8342
e56d974f-7718-0410-8b1c-b347a71765b2:/local/Catalyst-Runtime:6511
e56d974f-7718-0410-8b1c-b347a71765b2:/local/Catalyst-Runtime-current:10442
   + 1c72fc7c-9ce4-42af-bf25-3bfe470ff1e8:/local/Catalyst/trunk/Catalyst-Runtime:9763
4ad37cd2-5fec-0310-835f-b3785c72a374:/Catalyst-Runtime/5.70/branches/compres:7999
4ad37cd2-5fec-0310-835f-b3785c72a374:/Catalyst-Runtime/5.70/branches/context_go:8001
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/Catalyst-ChildOf:4443
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/Catalyst-Runtime-jrockway:5857
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/Catalyst-component-setup:4320
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/Catalyst-docs:4325
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/current/Catalyst-Runtime:5142
4ad37cd2-5fec-0310-835f-b3785c72a374:/trunk/Catalyst:4483
4ad37cd2-5fec-0310-835f-b3785c72a374:/trunk/Catalyst-Runtime:6165
d7608cd0-831c-0410-93c0-e5b306c3c028:/local/Catalyst/Catalyst-Runtime:8339
d7608cd0-831c-0410-93c0-e5b306c3c028:/local/Catalyst/Catalyst-Runtime-jrockway:8342
e56d974f-7718-0410-8b1c-b347a71765b2:/local/Catalyst-Runtime:6511
e56d974f-7718-0410-8b1c-b347a71765b2:/local/Catalyst-Runtime-current:10442

Modified: Catalyst-Runtime/5.70/trunk/lib/Catalyst/Dispatcher.pm
===================================================================
--- Catalyst-Runtime/5.70/trunk/lib/Catalyst/Dispatcher.pm	2008-06-25 20:15:23 UTC (rev 8001)
+++ Catalyst-Runtime/5.70/trunk/lib/Catalyst/Dispatcher.pm	2008-06-25 20:16:15 UTC (rev 8002)
@@ -127,17 +127,15 @@
     }
 }
 
-=head2 $self->forward( $c, $command [, \@arguments ] )
+# $self->_command2action( $c, $command [, \@arguments ] )
+# Search for an action, from the command and returns C<($action, $args)> on
+# success. Returns C<(0)> on error.
 
-Documented in L<Catalyst>
-
-=cut
-
-sub forward {
+sub _command2action {
     my ( $self, $c, $command, @extra_params ) = @_;
 
     unless ($command) {
-        $c->log->debug('Nothing to forward to') if $c->debug;
+        $c->log->debug('Nothing to go to') if $c->debug;
         return 0;
     }
 
@@ -146,24 +144,68 @@
     if ( ref( $extra_params[-1] ) eq 'ARRAY' ) {
         @args = @{ pop @extra_params }
     } else {
-        # this is a copy, it may take some abuse from ->_invoke_as_path if the path had trailing parts
+        # this is a copy, it may take some abuse from
+        # ->_invoke_as_path if the path had trailing parts
         @args = @{ $c->request->arguments };
     }
 
     my $action;
 
-    # forward to a string path ("/foo/bar/gorch") or action object which stringifies to that
+    # go to a string path ("/foo/bar/gorch")
+    # or action object which stringifies to that
     $action = $self->_invoke_as_path( $c, "$command", \@args );
 
-    # forward to a component ( "MyApp::*::Foo" or $c->component("...") - a path or an object)
+    # go to a component ( "MyApp::*::Foo" or $c->component("...")
+    # - a path or an object)
     unless ($action) {
         my $method = @extra_params ? $extra_params[0] : "process";
         $action = $self->_invoke_as_component( $c, $command, $method );
     }
 
+    return $action, \@args;
+}
 
+=head2 $self->go( $c, $command [, \@arguments ] )
+
+Documented in L<Catalyst>
+
+=cut
+
+sub go {
+    my $self = shift;
+    my ( $c, $command ) = @_;
+    my ( $action, $args ) = $self->_command2action(@_);
+
     unless ($action) {
         my $error =
+            qq/Couldn't go to command "$command": /
+          . qq/Invalid action or component./;
+        $c->error($error);
+        $c->log->debug($error) if $c->debug;
+        return 0;
+    }
+
+    local $c->request->{arguments} = $args;
+    $c->namespace($action->namespace);
+    $c->action($action);
+    $self->dispatch($c);
+
+    die $Catalyst::GO;
+}
+
+=head2 $self->forward( $c, $command [, \@arguments ] )
+
+Documented in L<Catalyst>
+
+=cut
+
+sub forward {
+    my $self = shift;
+    my ( $c, $command ) = @_;
+    my ( $action, $args ) = $self->_command2action(@_);
+
+    unless ($action) {
+        my $error =
             qq/Couldn't forward to command "$command": /
           . qq/Invalid action or component./;
         $c->error($error);
@@ -171,9 +213,7 @@
         return 0;
     }
 
-    #push @$args, @_;
-
-    local $c->request->{arguments} = \@args;
+    local $c->request->{arguments} = $args;
     $action->dispatch( $c );
 
     return $c->state;

Modified: Catalyst-Runtime/5.70/trunk/lib/Catalyst.pm
===================================================================
--- Catalyst-Runtime/5.70/trunk/lib/Catalyst.pm	2008-06-25 20:15:23 UTC (rev 8001)
+++ Catalyst-Runtime/5.70/trunk/lib/Catalyst.pm	2008-06-25 20:16:15 UTC (rev 8002)
@@ -49,6 +49,7 @@
 our $START     = time;
 our $RECURSION = 1000;
 our $DETACH    = "catalyst_detach\n";
+our $GO        = "catalyst_go\n";
 
 __PACKAGE__->mk_classdata($_)
   for qw/components arguments dispatcher engine log dispatcher_class
@@ -327,6 +328,20 @@
 
 sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
 
+=head2 $c->go( $action [, \@arguments ] )
+
+=head2 $c->go( $class, $method, [, \@arguments ] )
+
+Almost the same as C<detach>, but does a full dispatch, instead of just
+calling the new C<$action> / C<$class-E<gt>$method>. This means that C<begin>,
+C<auto> and the method you go to is called, just like a new request.
+
+C<$c-E<gt>stash> is kept unchanged.
+
+=cut
+
+sub go { my $c = shift; $c->dispatcher->go( $c, @_ ) }
+
 =head2 $c->response
 
 =head2 $c->res
@@ -1260,7 +1275,12 @@
     my $last = pop( @{ $c->stack } );
 
     if ( my $error = $@ ) {
-        if ( !ref($error) and $error eq $DETACH ) { die $DETACH if $c->depth > 1 }
+        if ( !ref($error) and $error eq $DETACH ) {
+            die $DETACH if($c->depth > 1);
+        }
+        elsif ( !ref($error) and $error eq $GO ) {
+            die $GO if($c->depth > 0);
+        }
         else {
             unless ( ref $error ) {
                 no warnings 'uninitialized';

Added: Catalyst-Runtime/5.70/trunk/t/lib/TestApp/Controller/Action/Go.pm
===================================================================
--- Catalyst-Runtime/5.70/trunk/t/lib/TestApp/Controller/Action/Go.pm	                        (rev 0)
+++ Catalyst-Runtime/5.70/trunk/t/lib/TestApp/Controller/Action/Go.pm	2008-06-25 20:16:15 UTC (rev 8002)
@@ -0,0 +1,85 @@
+package TestApp::Controller::Action::Go;
+
+use strict;
+use base 'TestApp::Controller::Action';
+
+sub one : Local {
+    my ( $self, $c ) = @_;
+    $c->go('two');
+}
+
+sub two : Private {
+    my ( $self, $c ) = @_;
+    $c->go('three');
+}
+
+sub three : Local {
+    my ( $self, $c ) = @_;
+    $c->go( $self, 'four' );
+}
+
+sub four : Private {
+    my ( $self, $c ) = @_;
+    $c->go('/action/go/five');
+}
+
+sub five : Local {
+    my ( $self, $c ) = @_;
+    $c->go('View::Dump::Request');
+}
+
+sub inheritance : Local {
+    my ( $self, $c ) = @_;
+    $c->go('/action/inheritance/a/b/default');
+}
+
+sub global : Local {
+    my ( $self, $c ) = @_;
+    $c->go('/global_action');
+}
+
+sub with_args : Local {
+    my ( $self, $c, $arg ) = @_;
+    $c->go( 'args', [$arg] );
+}
+
+sub with_method_and_args : Local {
+    my ( $self, $c, $arg ) = @_;
+    $c->go( qw/TestApp::Controller::Action::Go args/, [$arg] );
+}
+
+sub args : Local {
+    my ( $self, $c, $val ) = @_;
+    die "passed argument does not match args" unless $val eq $c->req->args->[0];
+    $c->res->body($val);
+}
+
+sub go_die : Local {
+    my ( $self, $c, $val ) = @_;
+    eval { $c->go( 'args', [qq/new/] ) };
+    $c->res->body( $@ ? $@ : "go() did not die" );
+    die $Catalyst::GO;
+}
+
+sub args_embed_relative : Local {
+    my ( $self, $c ) = @_;
+    $c->go('embed/ok');
+}
+
+sub args_embed_absolute : Local {
+    my ( $self, $c ) = @_;
+    $c->go('/action/go/embed/ok');
+}
+
+sub embed : Local {
+    my ( $self, $c, $ok ) = @_;
+    $ok ||= 'not ok';
+    $c->res->body($ok);
+}
+
+sub class_go_test_action : Local {
+    my ( $self, $c ) = @_;
+    $c->go(qw/TestApp class_go_test_method/);
+}
+
+1;

Modified: Catalyst-Runtime/5.70/trunk/t/lib/TestApp/Controller/Action/TestRelative.pm
===================================================================
--- Catalyst-Runtime/5.70/trunk/t/lib/TestApp/Controller/Action/TestRelative.pm	2008-06-25 20:15:23 UTC (rev 8001)
+++ Catalyst-Runtime/5.70/trunk/t/lib/TestApp/Controller/Action/TestRelative.pm	2008-06-25 20:16:15 UTC (rev 8002)
@@ -17,4 +17,13 @@
     $c->forward( 'TestApp::Controller::Action::Forward', 'one' );
 }
 
+sub relative_go : Local {
+    my ( $self, $c ) = @_;
+    $c->go('/action/go/one');
+}
+
+sub relative_go_two : Local {
+    my ( $self, $c ) = @_;
+    $c->go( 'TestApp::Controller::Action::Go', 'one' );
+}
 1;

Modified: Catalyst-Runtime/5.70/trunk/t/lib/TestApp.pm
===================================================================
--- Catalyst-Runtime/5.70/trunk/t/lib/TestApp.pm	2008-06-25 20:15:23 UTC (rev 8001)
+++ Catalyst-Runtime/5.70/trunk/t/lib/TestApp.pm	2008-06-25 20:16:15 UTC (rev 8002)
@@ -72,6 +72,11 @@
     $c->response->headers->header( 'X-Class-Forward-Test-Method' => 1 );
 }
 
+sub class_go_test_method :Private {
+    my ( $self, $c ) = @_;
+    $c->response->headers->header( 'X-Class-Go-Test-Method' => 1 );
+}
+
 sub loop_test : Local {
     my ( $self, $c ) = @_;
 
@@ -98,4 +103,4 @@
 
 use base qw/Catalyst::Base Class::Data::Inheritable/;
 
-1;
\ No newline at end of file
+1;

Added: Catalyst-Runtime/5.70/trunk/t/live_component_controller_action_go.t
===================================================================
--- Catalyst-Runtime/5.70/trunk/t/live_component_controller_action_go.t	                        (rev 0)
+++ Catalyst-Runtime/5.70/trunk/t/live_component_controller_action_go.t	2008-06-25 20:16:15 UTC (rev 8002)
@@ -0,0 +1,233 @@
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+our $iters;
+
+BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; }
+
+use Test::More tests => 47 * $iters;
+use Catalyst::Test 'TestApp';
+
+if ( $ENV{CAT_BENCHMARK} ) {
+    require Benchmark;
+    Benchmark::timethis( $iters, \&run_tests );
+}
+else {
+    for ( 1 .. $iters ) {
+        run_tests();
+    }
+}
+
+sub run_tests {
+    {
+        my @expected = qw[
+          TestApp::Controller::Action::Go->one
+          TestApp::Controller::Action::Go->two
+          TestApp::Controller::Action::Go->three
+          TestApp::Controller::Action::Go->four
+          TestApp::Controller::Action::Go->five
+          TestApp::View::Dump::Request->process
+          TestApp->end
+        ];
+
+        @expected = map { /Action/ ? (_begin($_), $_) : ($_) } @expected;
+        my $expected = join( ", ", @expected );
+
+        # Test go to global private action
+        ok( my $response = request('http://localhost/action/go/global'),
+            'Request' );
+        ok( $response->is_success, 'Response Successful 2xx' );
+        is( $response->content_type, 'text/plain', 'Response Content-Type' );
+        is( $response->header('X-Catalyst-Action'),
+            'action/go/global', 'Main Class Action' );
+
+        # Test go to chain of actions.
+        ok( $response = request('http://localhost/action/go/one'),
+            'Request' );
+        ok( $response->is_success, 'Response Successful 2xx' );
+        is( $response->content_type, 'text/plain', 'Response Content-Type' );
+        is( $response->header('X-Catalyst-Action'),
+            'action/go/one', 'Test Action' );
+        is(
+            $response->header('X-Test-Class'),
+            'TestApp::Controller::Action::Go',
+            'Test Class'
+        );
+        is( $response->header('X-Catalyst-Executed'),
+            $expected, 'Executed actions' );
+        like(
+            $response->content,
+            qr/^bless\( .* 'Catalyst::Request' \)$/s,
+            'Content is a serialized Catalyst::Request'
+        );
+    }
+
+    {
+        my @expected = qw[
+          TestApp::Controller::Action::Go->go_die
+          TestApp::Controller::Action::Go->args
+          TestApp->end
+        ];
+
+        @expected = map { /Action/ ? (_begin($_), $_) : ($_) } @expected;
+        my $expected = join( ", ", @expected );
+
+        ok( my $response = request('http://localhost/action/go/go_die'),
+            'Request' );
+        ok( $response->is_success, 'Response Successful 2xx' );
+        is( $response->content_type, 'text/plain', 'Response Content-Type' );
+        is( $response->header('X-Catalyst-Action'),
+            'action/go/go_die', 'Test Action'
+        );
+        is(
+            $response->header('X-Test-Class'),
+            'TestApp::Controller::Action::Go',
+            'Test Class'
+        );
+        is( $response->header('X-Catalyst-Executed'),
+            $expected, 'Executed actions' );
+        is( $response->content, $Catalyst::GO, "Go died as expected" );
+    }
+
+    {
+        ok(
+            my $response =
+              request('http://localhost/action/go/with_args/old'),
+            'Request with args'
+        );
+        ok( $response->is_success, 'Response Successful 2xx' );
+        is( $response->content, 'old' );
+    }
+
+    {
+        ok(
+            my $response = request(
+                'http://localhost/action/go/with_method_and_args/new'),
+            'Request with args and method'
+        );
+        ok( $response->is_success, 'Response Successful 2xx' );
+        is( $response->content, 'new' );
+    }
+
+    # test go with embedded args
+    {
+        ok(
+            my $response =
+              request('http://localhost/action/go/args_embed_relative'),
+            'Request'
+        );
+        ok( $response->is_success, 'Response Successful 2xx' );
+        is( $response->content, 'ok' );
+    }
+
+    {
+        ok(
+            my $response =
+              request('http://localhost/action/go/args_embed_absolute'),
+            'Request'
+        );
+        ok( $response->is_success, 'Response Successful 2xx' );
+        is( $response->content, 'ok' );
+    }
+    {
+        my @expected = qw[
+          TestApp::Controller::Action::TestRelative->relative_go
+          TestApp::Controller::Action::Go->one
+          TestApp::Controller::Action::Go->two
+          TestApp::Controller::Action::Go->three
+          TestApp::Controller::Action::Go->four
+          TestApp::Controller::Action::Go->five
+          TestApp::View::Dump::Request->process
+          TestApp->end
+        ];
+
+        @expected = map { /Action/ ? (_begin($_), $_) : ($_) } @expected;
+        my $expected = join( ", ", @expected );
+
+        # Test go to chain of actions.
+        ok( my $response = request('http://localhost/action/relative/relative_go'),
+            'Request' );
+        ok( $response->is_success, 'Response Successful 2xx' );
+        is( $response->content_type, 'text/plain', 'Response Content-Type' );
+        is( $response->header('X-Catalyst-Action'),
+            'action/relative/relative_go', 'Test Action' );
+        is(
+            $response->header('X-Test-Class'),
+            'TestApp::Controller::Action::Go',
+            'Test Class'
+        );
+        is( $response->header('X-Catalyst-Executed'),
+            $expected, 'Executed actions' );
+        like(
+            $response->content,
+            qr/^bless\( .* 'Catalyst::Request' \)$/s,
+            'Content is a serialized Catalyst::Request'
+        );
+    }
+    {
+        my @expected = qw[
+          TestApp::Controller::Action::TestRelative->relative_go_two
+          TestApp::Controller::Action::Go->one
+          TestApp::Controller::Action::Go->two
+          TestApp::Controller::Action::Go->three
+          TestApp::Controller::Action::Go->four
+          TestApp::Controller::Action::Go->five
+          TestApp::View::Dump::Request->process
+          TestApp->end
+        ];
+
+        @expected = map { /Action/ ? (_begin($_), $_) : ($_) } @expected;
+        my $expected = join( ", ", @expected );
+
+        # Test go to chain of actions.
+        ok(
+            my $response =
+              request('http://localhost/action/relative/relative_go_two'),
+            'Request'
+        );
+        ok( $response->is_success, 'Response Successful 2xx' );
+        is( $response->content_type, 'text/plain', 'Response Content-Type' );
+        is(
+            $response->header('X-Catalyst-Action'),
+            'action/relative/relative_go_two',
+            'Test Action'
+        );
+        is(
+            $response->header('X-Test-Class'),
+            'TestApp::Controller::Action::Go',
+            'Test Class'
+        );
+        is( $response->header('X-Catalyst-Executed'),
+            $expected, 'Executed actions' );
+        like(
+            $response->content,
+            qr/^bless\( .* 'Catalyst::Request' \)$/s,
+            'Content is a serialized Catalyst::Request'
+        );
+    }
+
+    # test class go 
+    {
+        ok(
+            my $response = request(
+                'http://localhost/action/go/class_go_test_action'),
+            'Request'
+        );
+        ok( $response->is_success, 'Response Successful 2xx' );
+        is( $response->header('X-Class-Go-Test-Method'), 1,
+            'Test Method' );
+    }
+
+}
+
+sub _begin {
+    local $_ = shift;
+    s/->(.*)$/->begin/;
+    return $_;
+}
+




More information about the Catalyst-commits mailing list