[Catalyst-commits] r7571 - in
Catalyst-Runtime/5.80/branches/context_go: lib/Catalyst t
t/lib t/lib/TestApp/Controller/Action
batman at dev.catalyst.perl.org
batman at dev.catalyst.perl.org
Sat Apr 5 17:53:40 BST 2008
Author: batman
Date: 2008-04-05 17:53:39 +0100 (Sat, 05 Apr 2008)
New Revision: 7571
Added:
Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Action/Go.pm
Catalyst-Runtime/5.80/branches/context_go/t/live_component_controller_action_go.t
Modified:
Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Dispatcher.pm
Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp.pm
Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Action/TestRelative.pm
Log:
Started writing tests for go(): Fails due to dup end-call. Refactored go and forward methods in Dispatcher
Modified: Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Dispatcher.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Dispatcher.pm 2008-04-05 15:15:38 UTC (rev 7570)
+++ Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Dispatcher.pm 2008-04-05 16:53:39 UTC (rev 7571)
@@ -127,18 +127,19 @@
}
}
-=head2 $self->go( $c, $command [, \@arguments ] )
+=head2 $self->_command2action( $c, $command [, \@arguments ] )
-Documented in L<Catalyst>
+Search for an action, from the command and returns C<($c, $action)> on
+success. Returns C<($c, 0)> on error.
=cut
-sub go {
+sub _command2action {
my ( $self, $c, $command, @extra_params ) = @_;
unless ($command) {
$c->log->debug('Nothing to go to') if $c->debug;
- return 0;
+ return $c, 0;
}
my @args;
@@ -146,44 +147,59 @@
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;
- # go 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 );
- # go 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 );
}
-
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;
+ return $c, 0;
}
#push @$args, @_;
- local $c->request->{arguments} = \@args;
+ return $c, $action, \@args;
+}
+=head2 $self->go( $c, $command [, \@arguments ] )
+
+Documented in L<Catalyst>
+
+=cut
+
+sub go {
+ my $self = shift;
+ my ( $c, $action, $args ) = $self->_command2action(@_);
+
+ return 0 unless($action);
+
+ local $c->request->{arguments} = $args;
$c->namespace($action->namespace);
$c->action($action);
+ eval { $self->dispatch($c) };
- $self->dispatch($c);
-
+ die $@ if($@);
die $Catalyst::GO;
}
-
=head2 $self->forward( $c, $command [, \@arguments ] )
Documented in L<Catalyst>
@@ -191,46 +207,12 @@
=cut
sub forward {
- my ( $self, $c, $command, @extra_params ) = @_;
+ my $self = shift;
+ my ( $c, $action, $args ) = $self->_command2action(@_);
- unless ($command) {
- $c->log->debug('Nothing to forward to') if $c->debug;
- return 0;
- }
+ return 0 unless($action);
- my @args;
-
- 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
- @args = @{ $c->request->arguments };
- }
-
- my $action;
-
- # forward 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)
- unless ($action) {
- my $method = @extra_params ? $extra_params[0] : "process";
- $action = $self->_invoke_as_component( $c, $command, $method );
- }
-
-
- unless ($action) {
- my $error =
- qq/Couldn't forward to command "$command": /
- . qq/Invalid action or component./;
- $c->error($error);
- $c->log->debug($error) if $c->debug;
- return 0;
- }
-
- #push @$args, @_;
-
- local $c->request->{arguments} = \@args;
+ local $c->request->{arguments} = $args;
$action->dispatch( $c );
return $c->state;
Added: Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Action/Go.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Action/Go.pm (rev 0)
+++ Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Action/Go.pm 2008-04-05 16:53:39 UTC (rev 7571)
@@ -0,0 +1,84 @@
+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" );
+}
+
+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.80/branches/context_go/t/lib/TestApp/Controller/Action/TestRelative.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Action/TestRelative.pm 2008-04-05 15:15:38 UTC (rev 7570)
+++ Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Action/TestRelative.pm 2008-04-05 16:53:39 UTC (rev 7571)
@@ -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.80/branches/context_go/t/lib/TestApp.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp.pm 2008-04-05 15:15:38 UTC (rev 7570)
+++ Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp.pm 2008-04-05 16:53:39 UTC (rev 7571)
@@ -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.80/branches/context_go/t/live_component_controller_action_go.t
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/live_component_controller_action_go.t (rev 0)
+++ Catalyst-Runtime/5.80/branches/context_go/t/live_component_controller_action_go.t 2008-04-05 16:53:39 UTC (rev 7571)
@@ -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