+++ /dev/null
-package TestApp;
-
-use Catalyst qw[-Engine=Test];
-
-sub foo : Global {
- my ( $self, $c ) = @_;
- $c->res->output('bar');
-}
-
-__PACKAGE__->setup;
-
-package main;
-
-use Test::More tests => 1;
-use Catalyst::Test 'TestApp';
-
-ok( get('/foo') =~ /bar/ );
+++ /dev/null
-package TestApp;
-
-use Catalyst qw[-Engine=Test];
-
-sub testregex : Regex(foo/(.*)) {
- my ( $self, $c ) = @_;
- $c->res->output( $c->req->snippets->[0] );
-}
-
-__PACKAGE__->setup();
-
-package main;
-
-use Test::More tests => 1;
-use Catalyst::Test 'TestApp';
-
-ok( get('/foo/bar') =~ /bar/ );
+++ /dev/null
-package TestApp;
-
-use Catalyst qw[-Engine=Test];
-
-sub foo : Global {
- my ( $self, $c ) = @_;
- $c->res->output( $c->req->params->{foo} );
-}
-
-__PACKAGE__->setup;
-
-package main;
-
-use Test::More tests => 1;
-use Catalyst::Test 'TestApp';
-
-ok( get('/foo?foo=bar') =~ /bar/ );
+++ /dev/null
-package TestApp;
-
-use Catalyst qw[-Engine=Test];
-
-sub foo : Global {
- my ( $self, $c, $arg ) = @_;
- $c->res->output($arg);
-}
-
-__PACKAGE__->setup;
-
-package main;
-
-use Test::More tests => 1;
-use Catalyst::Test 'TestApp';
-
-ok( get('/foo/bar') =~ /bar/ );
+++ /dev/null
-package TestApp;
-
-use Catalyst qw[-Engine=Test];
-
-sub foo : Global {
- my ( $self, $c ) = @_;
- $c->res->headers->header( 'X-Foo' => 'Bar' );
-}
-
-__PACKAGE__->setup;
-
-package main;
-
-use Test::More tests => 1;
-use Catalyst::Test 'TestApp';
-
-ok( request('/foo')->header('X-Foo') );
+++ /dev/null
-package TestApp;
-
-use Catalyst qw[-Engine=Test];
-
-sub foo : Global {
- my ( $self, $c ) = @_;
- $c->res->cookies->{foo} = { value => 'bar' };
-}
-
-__PACKAGE__->setup;
-
-package main;
-
-use Test::More tests => 1;
-use Catalyst::Test 'TestApp';
-
-ok( request('/foo')->header('Set-Cookie') =~ /bar/ );
+++ /dev/null
-package TestApp;
-
-use Catalyst qw[-Engine=Test];
-
-sub foo : Global {
- my ( $self, $c ) = @_;
- $c->forward('bar');
-}
-sub bar : Global {
- my ( $self, $c, $arg ) = @_;
- $c->res->output($arg);
-}
-
-__PACKAGE__->setup;
-
-package main;
-
-use Test::More tests => 1;
-use Catalyst::Test 'TestApp';
-
-ok( get('/foo/bar') =~ /bar/ );
+++ /dev/null
-package TestApp;
-
-use Catalyst qw[-Engine=Test];
-
-sub foo : Global {
- my ( $self, $c ) = @_;
- $c->res->redirect('http://localhost/bar');
-}
-
-__PACKAGE__->setup;
-
-package main;
-
-use Test::More tests => 1;
-use Catalyst::Test 'TestApp';
-
-ok( request('/foo')->header('Location') =~ /localhost/ );
+++ /dev/null
-package TestApp;
-
-use Catalyst qw[-Engine=Test];
-
-sub foo : Global {
- my ( $self, $c ) = @_;
- $c->stash->{test} ||= 'foo';
- $c->forward('bar');
-}
-sub bar : Global {
- my ( $self, $c ) = @_;
- $c->stash->{test} ||= 'bar';
- $c->forward('yada');
-}
-sub yada : Global {
- my ( $self, $c ) = @_;
- $c->stash->{test} ||= 'yada';
- $c->res->output( $c->stash->{test} );
-}
-
-__PACKAGE__->setup;
-
-package main;
-
-use Test::More tests => 2;
-use Catalyst::Test 'TestApp';
-
-ok( get('/foo') =~ /foo/ );
-ok( get('/bar') =~ /bar/ );
+++ /dev/null
-package TestApp;
-
-use Catalyst qw[-Engine=Test];
-
-sub default : Private {
- my ( $self, $c ) = @_;
- $c->res->output('bar');
-}
-
-__PACKAGE__->setup;
-
-package TestApp::C::Foo::Bar;
-
-use base 'Catalyst::Base';
-
-sub default : Private {
- my ( $self, $c ) = @_;
- $c->res->output('yada');
-}
-
-package main;
-
-use Test::More tests => 2;
-use Catalyst::Test 'TestApp';
-
-ok( get('/foo') =~ /bar/ );
-ok( get('/foo/bar/foo') =~ /yada/ );
+++ /dev/null
-package TestApp;
-
-use Catalyst qw[-Engine=Test];
-
-
-sub begin : Private {
- my ( $self, $c ) = @_;
- $c->res->output('foo');
-}
-
-sub default : Private { }
-
-sub end : Private {
- my ( $self, $c ) = @_;
- $c->res->output( $c->res->output . 'bar' );
-}
-
-
-__PACKAGE__->setup;
-
-package TestApp::C::Foo::Bar;
-
-use base 'Catalyst::Base';
-
-sub begin : Private {
- my ( $self, $c ) = @_;
- $c->res->output('yada');
-}
-
-sub default : Private { }
-
-sub end : Private {
- my ( $self, $c ) = @_;
- $c->res->output( $c->res->output . 'yada' );
-}
-
-package main;
-
-use Test::More tests => 2;
-use Catalyst::Test 'TestApp';
-
-ok( get('/foo') =~ /foobar/ );
-ok( get('/foo/bar/foo') =~ /yadayada/ );
+++ /dev/null
-package TestApp;
-
-use Catalyst qw[-Engine=Test];
-
-sub hostname : Global {
- my ( $self, $c ) = @_;
- $c->res->output( $c->req->hostname );
-}
-sub address : Global {
- my ( $self, $c ) = @_;
- $c->res->output( $c->req->address );
-}
-
-__PACKAGE__->setup;
-
-package main;
-
-use Test::More tests => 2;
-use Catalyst::Test 'TestApp';
-
-ok( get('/hostname') eq 'localhost' );
-ok( get('/address') eq '127.0.0.1' );
+++ /dev/null
-package TestApp;
-
-use Catalyst qw[-Engine=Test];
-
-sub echo : Global {
- my ( $self, $c ) = @_;
-
- for my $field ( $c->req->headers->header_field_names ) {
- my $header = ( $field =~ /^X-/ ) ? $field : "X-$field";
- $c->res->headers->header(
- $header => $c->req->headers->header($field) );
- }
-
- $c->res->headers->content_type('text/plain');
- $c->res->output('ok');
-}
-
-__PACKAGE__->setup;
-
-package main;
-
-use Test::More tests => 5;
-use Catalyst::Test 'TestApp';
-use HTTP::Request::Common;
-
-my $request = POST(
- 'http://localhost/echo',
- 'X-Whats-Cool' => 'Catalyst',
- 'Content-Type' => 'form-data',
- 'Content' => [
- catalyst => 'Rocks!',
- file => [$0],
- ]
-);
-
-ok( my $response = request($request) );
-ok( $response->content_type eq 'text/plain' );
-ok( $response->headers->header('X-Content-Type') =~ /^multipart\/form-data/ );
-ok( $response->headers->header('X-Content-Length') ==
- $request->content_length );
-ok( $response->headers->header('X-Whats-Cool') eq 'Catalyst' );
+++ /dev/null
-package TestApp;
-
-use Catalyst qw[-Engine=Test];
-
-TestApp->action( '!default' => \&default );
-TestApp->action( 'index/a/b' => \&default );
-
-sub default {
- my ( $self, $c ) = @_;
- $c->res->headers->header( 'X-Arguments' => $c->req->arguments );
- $c->res->headers->header( 'X-Base' => $c->req->base );
- $c->res->headers->header( 'X-Path' => $c->req->path );
- $c->res->headers->content_type('text/plain');
- $c->res->output('ok');
-}
-
-package main;
-
-use Test::More tests => 6;
-use Catalyst::Test 'TestApp';
-
-{
- local %ENV;
-
- my $response = request('/index?a=a&b=b');
-
- ok( $response->headers->header('X-Base') eq 'http://localhost/' );
- ok( $response->headers->header('X-Arguments') eq 'index' );
- ok( $response->headers->header('X-Path') eq 'index' );
-}
-
-{
- local %ENV;
-
- my $response = request('http://localhost:8080/index/a/b/c');
-
- ok( $response->headers->header('X-Base') eq 'http://localhost:8080/' );
- ok( $response->headers->header('X-Arguments') eq 'c' );
- ok( $response->headers->header('X-Path') eq 'index/a/b/c' );
-}
+++ /dev/null
-package TestApp;
-
-use Catalyst qw[-Engine=Test];
-
-__PACKAGE__->action(
-
- '!begin' => sub {
- my ( $self, $c ) = @_;
- $c->res->headers->content_type('text/plain');
- }
-);
-
-package TestApp::C::Foo;
-
-TestApp->action(
-
- '!begin' => sub {
- my ( $self, $c ) = @_;
- $c->res->output('foo');
- },
-
- '!default' => sub {
- my ( $self, $c ) = @_;
- $c->res->output( $c->res->output . 'foo' );
- },
-
- '!end' => sub {
- my ( $self, $c ) = @_;
- $c->res->output( $c->res->output . 'foo' );
- },
-);
-
-package TestApp::C::Foo::Bar;
-
-TestApp->action(
-
- '!begin' => sub {
- my ( $self, $c ) = @_;
- $c->res->output( $c->res->output . 'bar' );
- },
-
- '!default' => sub {
- my ( $self, $c ) = @_;
- $c->res->output( $c->res->output . 'bar' );
- },
-
- '!end' => sub {
- my ( $self, $c ) = @_;
- $c->res->output( $c->res->output . 'bar' );
- },
-);
-
-package main;
-
-use Test::More tests => 5;
-use Catalyst::Test 'TestApp';
-
-{
- my $response = request('/foo');
- is( $response->content, 'foofoofoo' );
-}
-
-{
- my $response = request('/foo/rab');
- is( $response->content, 'foofoofoo' );
-}
-
-{
- my $response = request('/foo/bar');
- is( $response->content, 'foobarfoobarfoobar' );
-}
-
-{
- my $response = request('/foobar');
- isnt( $response->content, 'foofoofoo' );
-}
-
-{
- my $response = request('/foo_bar/yada');
- isnt( $response->content, 'foobarfoobarfoobar' );
-}
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/../../lib";
+
+use Test::More no_plan => 1;
+use Catalyst::Test 'TestApp';
+
+
+{
+ ok( my $response = request('http://localhost/action_absolute_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_absolute_one', 'Test Action' );
+ is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Absoulte', 'Test Class' );
+ like( $response->content, qr/^bless\( .* 'Catalyst::Request' \)$/s, 'Content is a serialized Catalyst::Request' );
+}
+
+{
+ ok( my $response = request('http://localhost/action_absolute_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_absolute_two', 'Test Action' );
+ is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Absoulte', 'Test Class' );
+ like( $response->content, qr/^bless\( .* 'Catalyst::Request' \)$/s, 'Content is a serialized Catalyst::Request' );
+}
+
+{
+ ok( my $response = request('http://localhost/action_absolute_three'), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is( $response->header('X-Catalyst-Action'), 'action_absolute_three', 'Test Action' );
+ is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Absoulte', 'Test Class' );
+ like( $response->content, qr/^bless\( .* 'Catalyst::Request' \)$/s, 'Content is a serialized Catalyst::Request' );
+}
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/../../lib";
+
+use Test::More no_plan => 1;
+use Catalyst::Test 'TestApp';
+
+
+{
+ my @expected = qw[
+ TestApp::Controller::Action->begin
+ TestApp::Controller::Action::Begin->begin
+ TestApp::Controller::Action::Begin->default
+ TestApp::View::Dump::Request->process
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/action/begin'), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is( $response->header('X-Catalyst-Action'), 'default', 'Test Action' );
+ is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Begin', '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' );
+}
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/../../lib";
+
+use Test::More no_plan => 1;
+use Catalyst::Test 'TestApp';
+
+
+{
+ my @expected = qw[
+ TestApp::Controller::Action->begin
+ TestApp::Controller::Action::Default->begin
+ TestApp::Controller::Action::Default->default
+ TestApp::View::Dump::Request->process
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/action/default'), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is( $response->header('X-Catalyst-Action'), 'default', 'Test Action' );
+ is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Default', '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' );
+}
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/../../lib";
+
+use Test::More no_plan => 1;
+use Catalyst::Test 'TestApp';
+
+
+{
+ my @expected = qw[
+ TestApp::Controller::Action->begin
+ TestApp::Controller::Action::End->begin
+ TestApp::Controller::Action::End->default
+ TestApp::View::Dump::Request->process
+ TestApp::Controller::Action::End->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/action/end'), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is( $response->header('X-Catalyst-Action'), 'default', 'Test Action' );
+ is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::End', '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' );
+}
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/../../lib";
+
+use Test::More no_plan => 1;
+use Catalyst::Test 'TestApp';
+
+
+{
+ my @expected = qw[
+ TestApp::Controller::Action->begin
+ TestApp::Controller::Action::Forward->begin
+ TestApp::Controller::Action::Forward->one
+ TestApp::Controller::Action::Forward->two
+ TestApp::Controller::Action::Forward->three
+ TestApp::Controller::Action::Forward->four
+ TestApp::Controller::Action::Forward->five
+ TestApp::View::Dump::Request->process
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/action/forward/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/forward/one', 'Test Action' );
+ is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Forward', '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->begin
+ TestApp::Controller::Action::Forward->begin
+ TestApp::Controller::Action::Forward->jojo
+ TestApp::Controller::Action::Forward->one
+ TestApp::Controller::Action::Forward->two
+ TestApp::Controller::Action::Forward->three
+ TestApp::Controller::Action::Forward->four
+ TestApp::Controller::Action::Forward->five
+ TestApp::View::Dump::Request->process
+ TestApp::Controller::Action::Forward->three
+ TestApp::Controller::Action::Forward->four
+ TestApp::Controller::Action::Forward->five
+ TestApp::View::Dump::Request->process
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/action/forward/jojo'), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is( $response->header('X-Catalyst-Action'), 'action/forward/jojo', 'Test Action' );
+ is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Forward', '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' );
+}
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/../../lib";
+
+use Test::More no_plan => 1;
+use Catalyst::Test 'TestApp';
+
+
+{
+ my @expected = qw[
+ TestApp::Controller::Action->begin
+ TestApp::Controller::Action::Inheritance->begin
+ TestApp::Controller::Action::Inheritance->default
+ TestApp::View::Dump::Request->process
+ TestApp::Controller::Action::Inheritance->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/action/inheritance'), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is( $response->header('X-Catalyst-Action'), 'default', 'Test Action' );
+ is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Inheritance', '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->begin
+ TestApp::Controller::Action::Inheritance->begin
+ TestApp::Controller::Action::Inheritance::A->begin
+ TestApp::Controller::Action::Inheritance::A->default
+ TestApp::View::Dump::Request->process
+ TestApp::Controller::Action::Inheritance::A->end
+ TestApp::Controller::Action::Inheritance->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/action/inheritance/a'), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is( $response->header('X-Catalyst-Action'), 'default', 'Test Action' );
+ is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Inheritance::A', '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->begin
+ TestApp::Controller::Action::Inheritance->begin
+ TestApp::Controller::Action::Inheritance::A->begin
+ TestApp::Controller::Action::Inheritance::A::B->begin
+ TestApp::Controller::Action::Inheritance::A::B->default
+ TestApp::View::Dump::Request->process
+ TestApp::Controller::Action::Inheritance::A::B->end
+ TestApp::Controller::Action::Inheritance::A->end
+ TestApp::Controller::Action::Inheritance->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/action/inheritance/a/b'), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is( $response->header('X-Catalyst-Action'), 'default', 'Test Action' );
+ is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Inheritance::A::B', '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' );
+}
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/../../lib";
+
+use Test::More no_plan => 1;
+use Catalyst::Test 'TestApp';
+
+
+{
+ ok( my $response = request('http://localhost/action/path/a path with spaces'), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is( $response->header('X-Catalyst-Action'), 'action/path/a path with spaces', 'Test Action' );
+ is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Path', 'Test Class' );
+ like( $response->content, qr/^bless\( .* 'Catalyst::Request' \)$/s, 'Content is a serialized Catalyst::Request' );
+}
+
+{
+ ok( my $response = request('http://localhost/action/path/åäö'), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is( $response->header('X-Catalyst-Action'), 'action/path/åäö', 'Test Action' );
+ is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Path', 'Test Class' );
+ like( $response->content, qr/^bless\( .* 'Catalyst::Request' \)$/s, 'Content is a serialized Catalyst::Request' );
+}
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/../../lib";
+
+use Test::More no_plan => 1;
+use Catalyst::Test 'TestApp';
+
+
+{
+ ok( my $response = request('http://localhost/action/private/one'), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Private', 'Test Class' );
+ is( $response->content, 'access denied', 'Access' );
+}
+
+{
+ ok( my $response = request('http://localhost/action/private/two'), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Private', 'Test Class' );
+ is( $response->content, 'access denied', 'Access' );
+}
+
+{
+ ok( my $response = request('http://localhost/three'), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Private', 'Test Class' );
+ is( $response->content, 'access denied', 'Access' );
+}
+
+{
+ ok( my $response = request('http://localhost/action/private/four'), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Private', 'Test Class' );
+ is( $response->content, 'access denied', 'Access' );
+}
+
+{
+ ok( my $response = request('http://localhost/action/private/five'), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Private', 'Test Class' );
+ is( $response->content, 'access denied', 'Access' );
+}
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/../../lib";
+
+use Test::More no_plan => 1;
+use Catalyst::Test 'TestApp';
+
+
+{
+ ok( my $response = request('http://localhost/action/regexp/10/hello'), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is( $response->header('X-Catalyst-Action'), '^action/regexp/(\d+)/(\w+)$', 'Test Action' );
+ is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Regexp', 'Test Class' );
+ like( $response->content, qr/^bless\( .* 'Catalyst::Request' \)$/s, 'Content is a serialized Catalyst::Request' );
+}
+
+{
+ ok( my $response = request('http://localhost/action/regexp/hello/10'), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is( $response->header('X-Catalyst-Action'), '^action/regexp/(\w+)/(\d+)$', 'Test Action' );
+ is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Regexp', 'Test Class' );
+ like( $response->content, qr/^bless\( .* 'Catalyst::Request' \)$/s, 'Content is a serialized Catalyst::Request' );
+}
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/../../lib";
+
+use Test::More no_plan => 1;
+use Catalyst::Test 'TestApp';
+
+
+{
+ ok( my $response = request('http://localhost/action/relative/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/relative/one', 'Test Action' );
+ is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Relative', 'Test Class' );
+ like( $response->content, qr/^bless\( .* 'Catalyst::Request' \)$/s, 'Content is a serialized Catalyst::Request' );
+}
+
+{
+ ok( my $response = request('http://localhost/action/relative/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/two', 'Test Action' );
+ is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Relative', 'Test Class' );
+ like( $response->content, qr/^bless\( .* 'Catalyst::Request' \)$/s, 'Content is a serialized Catalyst::Request' );
+}
+
+{
+ ok( my $response = request('http://localhost/action/relative/three'), '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/three', 'Test Action' );
+ is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Relative', 'Test Class' );
+ like( $response->content, qr/^bless\( .* 'Catalyst::Request' \)$/s, 'Content is a serialized Catalyst::Request' );
+}
+
+{
+ ok( my $response = request('http://localhost/action/relative/four/five/six'), '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/four/five/six', 'Test Action' );
+ is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Relative', 'Test Class' );
+ like( $response->content, qr/^bless\( .* 'Catalyst::Request' \)$/s, 'Content is a serialized Catalyst::Request' );
+}
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/../../lib";
+
+use Test::More no_plan => 1;
+use Catalyst::Test 'TestApp';
+
+use Catalyst::Request;
+use CGI::Cookie;
+use HTTP::Headers;
+use HTTP::Request::Common;
+use URI;
+
+{
+ my $creq;
+
+ my $request = GET( 'http://localhost/dump/request',
+ 'Cookie' => 'Catalyst=Cool; Cool=Catalyst',
+ );
+
+ ok( my $response = request($request), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ like( $response->content, qr/^bless\( .* 'Catalyst::Request' \)$/s, 'Content is a serialized Catalyst::Request' );
+ ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
+ isa_ok( $creq, 'Catalyst::Request' );
+ isa_ok( $creq->cookies->{Catalyst}, 'CGI::Cookie', 'Cookie Catalyst' );
+ is( $creq->cookies->{Catalyst}->name, 'Catalyst', 'Cookie Catalyst name' );
+ is( $creq->cookies->{Catalyst}->value, 'Cool', 'Cookie Catalyst value' );
+ isa_ok( $creq->cookies->{Cool}, 'CGI::Cookie', 'Cookie Cool' );
+ is( $creq->cookies->{Cool}->name, 'Cool', 'Cookie Cool name' );
+ is( $creq->cookies->{Cool}->value, 'Catalyst', 'Cookie Cool value' );
+
+
+ my $cookies = {
+ Catalyst => $creq->cookies->{Catalyst},
+ Cool => $creq->cookies->{Cool}
+ };
+
+ is_deeply( $creq->cookies, $cookies, 'Cookies' );
+}
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/../../lib";
+
+use Test::More no_plan => 1;
+use Catalyst::Test 'TestApp';
+
+use Catalyst::Request;
+use HTTP::Headers;
+use HTTP::Request::Common;
+use URI;
+
+{
+ my $creq;
+
+ my $request = GET( 'http://localhost/dump/request',
+ 'User-Agent' => 'MyAgen/1.0',
+ 'X-Whats-Cool' => 'Catalyst'
+ );
+
+ ok( my $response = request($request), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ like( $response->content, qr/^bless\( .* 'Catalyst::Request' \)$/s, 'Content is a serialized Catalyst::Request' );
+ ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
+ isa_ok( $creq, 'Catalyst::Request' );
+ isa_ok( $creq->headers, 'HTTP::Headers', 'Catalyst::Request->headers' );
+ is( $creq->header('X-Whats-Cool'), $request->header('X-Whats-Cool'), 'Catalyst::Request->header X-Whats-Cool' );
+ is( $creq->header('User-Agent'), $request->header('User-Agent'), 'Catalyst::Request->header User-Agent' );
+
+ my $host = sprintf( '%s:%d', $request->uri->host, $request->uri->port );
+ is( $creq->header('Host'), $host, 'Catalyst::Request->header Host' );
+}
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/../../lib";
+
+use Test::More no_plan => 1;
+use Catalyst::Test 'TestApp';
+
+use Catalyst::Request;
+use HTTP::Headers;
+use HTTP::Request::Common;
+use URI;
+
+{
+ my $creq;
+
+ my $parameters = {
+ 'a' => [qw(A b C d E f G)],
+ '%' => [ '%', '"', '& - &' ],
+ };
+
+ my $request = POST( 'http://localhost/dump/request/a/b?a=1&a=2&a=3',
+ 'Content' => $parameters,
+ 'Content-Type' => 'application/x-www-form-urlencoded'
+ );
+
+ # Query string. I'm not sure the order is consistent in all enviroments,
+ # we need to test this with:
+ # [x] C::E::Test and C::E::Daemon
+ # [ ] MP1
+ # [ ] MP2
+ # [x] CGI::Simple
+
+ unshift( @{ $parameters->{a} }, 1, 2, 3 );
+
+ ok( my $response = request($request), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ like( $response->content, qr/^bless\( .* 'Catalyst::Request' \)$/s, 'Content is a serialized Catalyst::Request' );
+ ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
+ isa_ok( $creq, 'Catalyst::Request' );
+ is( $creq->method, 'POST', 'Catalyst::Request method' );
+ is_deeply( $creq->parameters, $parameters, 'Catalyst::Request parameters' );
+ is_deeply( $creq->arguments, [qw(a b)], 'Catalyst::Request arguments' );
+ is_deeply( $creq->uploads, {}, 'Catalyst::Request uploads' );
+ is_deeply( $creq->cookies, {}, 'Catalyst::Request cookie' );
+}
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/../../lib";
+
+use Test::More no_plan => 1;
+use Catalyst::Test 'TestApp';
+
+use Catalyst::Request;
+use HTTP::Headers;
+use HTTP::Headers::Util 'split_header_words';
+use HTTP::Request::Common;
+
+{
+ my $creq;
+
+ my $request = POST( 'http://localhost/dump/request/',
+ 'Content-Type' => 'multipart/form-data',
+ 'Content' => [
+ 'cookies.t' => [ "$FindBin::Bin/cookies.t" ],
+ 'headers.t' => [ "$FindBin::Bin/headers.t" ],
+ 'uploads.t' => [ "$FindBin::Bin/uploads.t" ],
+ ]
+ );
+
+ ok( my $response = request($request), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ like( $response->content, qr/^bless\( .* 'Catalyst::Request' \)$/s, 'Content is a serialized Catalyst::Request' );
+
+ {
+ no strict 'refs';
+ ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
+ }
+
+ isa_ok( $creq, 'Catalyst::Request' );
+ is( $creq->method, 'POST', 'Catalyst::Request method' );
+ is( $creq->content_type, 'multipart/form-data', 'Catalyst::Request Content-Type' );
+ is( $creq->content_length, $request->content_length, 'Catalyst::Request Content-Length' );
+
+ for my $part ( $request->parts ) {
+
+ my $disposition = $part->header('Content-Disposition');
+ my %parameters = @{ ( split_header_words($disposition) )[0] };
+
+ my $upload = $creq->uploads->{ $parameters{filename} };
+
+ isnt( $upload, undef, 'Upload filename' );
+ is( $upload->{type}, $part->content_type, 'Upload Content-Type' );
+ is( $upload->{size}, length( $part->content ), 'Upload Content-Length' );
+ }
+
+ #warn $response->as_string;
+}
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/../../lib";
+
+use Test::More no_plan => 1;
+use Catalyst::Test 'TestApp';
+
+use HTTP::Headers::Util 'split_header_words';
+
+
+my $expected = {
+ Catalyst => [ qw( Catalyst Cool path / ) ],
+ Cool => [ qw( Cool Catalyst path / ) ]
+};
+
+{
+ ok( my $response = request('http://localhost/engine/response/cookies/one'), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is( $response->header('X-Catalyst-Action'), 'engine/response/cookies/one', 'Test Action' );
+
+ my $cookies = {};
+
+ for my $cookie ( split_header_words( $response->header('Set-Cookie') ) ) {
+ $cookies->{ $cookie->[0] } = $cookie;
+ }
+
+ is_deeply( $cookies, $expected, 'Response Cookies' );
+}
+
+{
+ ok( my $response = request('http://localhost/engine/response/cookies/two'), 'Request' );
+ ok( $response->is_redirect, 'Response Redirection 3xx' );
+ is( $response->code, 302, 'Response Code' );
+ is( $response->header('X-Catalyst-Action'), 'engine/response/cookies/two', 'Test Action' );
+
+ my $cookies = {};
+
+ for my $cookie ( split_header_words( $response->header('Set-Cookie') ) ) {
+ $cookies->{ $cookie->[0] } = $cookie;
+ }
+
+ is_deeply( $cookies, $expected, 'Response Cookies' );
+}
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/../../lib";
+
+use Test::More no_plan => 1;
+use Catalyst::Test 'TestApp';
+
+{
+ ok( my $response = request('http://localhost/engine/response/errors/one'), 'Request' );
+ ok( $response->is_error, 'Response Server Error 5xx' );
+ is( $response->code, 500, 'Response Code' );
+ is( $response->content_type, 'text/html', 'Response Content-Type' );
+ is( $response->header('X-Catalyst-Action'), 'engine/response/errors/one', 'Test Action' );
+ like( $response->header('X-Catalyst-Error'), qr/^Caught exception/, 'Catalyst Error' );
+}
+
+{
+ ok( my $response = request('http://localhost/engine/response/errors/two'), 'Request' );
+ ok( $response->is_error, 'Client Error 4xx' );
+ is( $response->code, 404, 'Response Code' );
+ is( $response->content_type, 'text/html', 'Response Content-Type' );
+ is( $response->header('X-Catalyst-Action'), 'engine/response/errors/two', 'Test Action' );
+ like( $response->header('X-Catalyst-Error'), qr/^Unknown resource/, 'Catalyst Error' );
+}
+
+{
+ ok( my $response = request('http://localhost/engine/response/errors/three'), 'Request' );
+ ok( $response->is_error, 'Response Server Error 5xx' );
+ is( $response->code, 500, 'Response Code' );
+ is( $response->content_type, 'text/html', 'Response Content-Type' );
+ is( $response->header('X-Catalyst-Action'), 'engine/response/errors/three', 'Test Action' );
+ like( $response->header('X-Catalyst-Error'), qr/^Caught exception "I'm going to die!"$/, 'Catalyst Error' );
+}
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/../../lib";
+
+use Test::More no_plan => 1;
+use Catalyst::Test 'TestApp';
+
+
+{
+ my $expected = join( ', ', 1 .. 10 );
+
+ ok( my $response = request('http://localhost/engine/response/headers/one'), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->code, 200, 'Response Code' );
+ is( $response->header('X-Catalyst-Action'), 'engine/response/headers/one', 'Test Action' );
+# is( $response->header('X-Test-Class'), 'TestApp::Controller::Engine::Response::Headers', 'Test Class' );
+ is( $response->header('X-Header-Catalyst'), 'Cool', 'Response Header X-Header-Catalyst' );
+ is( $response->header('X-Header-Cool'), 'Catalyst', 'Response Header X-Header-Cool' );
+ is( $response->header('X-Header-Numbers'), $expected, 'Response Header X-Header-Numbers' );
+}
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/../../lib";
+
+use Test::More no_plan => 1;
+use Catalyst::Test 'TestApp';
+
+{
+ ok( my $response = request('http://localhost/engine/response/redirect/one'), 'Request' );
+ ok( $response->is_redirect, 'Response Redirection 3xx' );
+ is( $response->code, 302, 'Response Code' );
+ is( $response->header('X-Catalyst-Action'), 'engine/response/redirect/one', 'Test Action' );
+ is( $response->header('Location'), '/test/writing/is/boring', 'Response Header Location' );
+}
+
+{
+ ok( my $response = request('http://localhost/engine/response/redirect/two'), 'Request' );
+ ok( $response->is_redirect, 'Response Redirection 3xx' );
+ is( $response->code, 302, 'Response Code' );
+ is( $response->header('X-Catalyst-Action'), 'engine/response/redirect/two', 'Test Action' );
+ is( $response->header('Location'), 'http://www.google.com/', 'Response Header Location' );
+}
+
+{
+ ok( my $response = request('http://localhost/engine/response/redirect/three'), 'Request' );
+ ok( $response->is_redirect, 'Response Redirection 3xx' );
+ is( $response->code, 301, 'Response Code' );
+ is( $response->header('X-Catalyst-Action'), 'engine/response/redirect/three', 'Test Action' );
+ is( $response->header('Location'), 'http://www.google.com/', 'Response Header Location' );
+}
+
+{
+ ok( my $response = request('http://localhost/engine/response/redirect/four'), 'Request' );
+ ok( $response->is_redirect, 'Response Redirection 3xx' );
+ is( $response->code, 307, 'Response Code' );
+ is( $response->header('X-Catalyst-Action'), 'engine/response/redirect/four', 'Test Action' );
+ is( $response->header('Location'), 'http://www.google.com/', 'Response Header Location' );
+}
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/../../lib";
+
+use Test::More no_plan => 1;
+use Catalyst::Test 'TestApp';
+
+{
+ ok( my $response = request('http://localhost/engine/response/status/s200'), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->code, 200, 'Response Code' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is( $response->header('X-Catalyst-Action'), 'engine/response/status/s200', 'Test Action' );
+ like( $response->content, qr/^200/, 'Response Content' );
+}
+
+{
+ ok( my $response = request('http://localhost/engine/response/status/s400'), 'Request' );
+ ok( $response->is_error, 'Response Client Error 4xx' );
+ is( $response->code, 400, 'Response Code' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is( $response->header('X-Catalyst-Action'), 'engine/response/status/s400', 'Test Action' );
+ like( $response->content, qr/^400/, 'Response Content' );
+}
+
+{
+ ok( my $response = request('http://localhost/engine/response/status/s403'), 'Request' );
+ ok( $response->is_error, 'Response Client Error 4xx' );
+ is( $response->code, 403, 'Response Code' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is( $response->header('X-Catalyst-Action'), 'engine/response/status/s403', 'Test Action' );
+ like( $response->content, qr/^403/, 'Response Content' );
+}
+
+{
+ ok( my $response = request('http://localhost/engine/response/status/s404'), 'Request' );
+ ok( $response->is_error, 'Response Client Error 4xx' );
+ is( $response->code, 404, 'Response Code' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is( $response->header('X-Catalyst-Action'), 'engine/response/status/s404', 'Test Action' );
+ like( $response->content, qr/^404/, 'Response Content' );
+}
+
+{
+ ok( my $response = request('http://localhost/engine/response/status/s500'), 'Request' );
+ ok( $response->is_error, 'Response Server Error 5xx' );
+ is( $response->code, 500, 'Response Code' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is( $response->header('X-Catalyst-Action'), 'engine/response/status/s500', 'Test Action' );
+ like( $response->content, qr/^500/, 'Response Content' );
+}
--- /dev/null
+package Catalyst::Plugin::Test::Errors;
+
+use strict;
+
+sub error {
+ my $c = shift;
+
+ unless ( $_[0] ) {
+ $c->NEXT::error(@_);
+ }
+
+ if ( $_[0] =~ /^(Unknown resource|No default action defined)/ ) {
+ $c->response->status(404);
+ }
+
+ if ( $_[0] =~ /^Couldn\'t forward/ ) {
+ $c->response->status(404);
+ }
+
+ if ( $_[0] =~ /^Caught exception/ ) {
+ $c->response->status(500);
+ }
+
+ $c->response->headers->push_header( 'X-Catalyst-Error' => $_[0] );
+
+ $c->NEXT::error(@_);
+}
+
+1;
--- /dev/null
+package Catalyst::Plugin::Test::Headers;
+
+use strict;
+
+sub prepare {
+ my $class = shift;
+
+ my $c = $class->NEXT::prepare(@_);
+
+ $c->response->header( 'X-Catalyst-Engine' => $c->engine );
+ $c->response->header( 'X-Catalyst-Debug' => $c->debug ? 1 : 0 );
+
+ {
+ my @components = sort keys %{ $c->components };
+ $c->response->headers->push_header( 'X-Catalyst-Components' => [ @components ] );
+ }
+
+ {
+ no strict 'refs';
+ my @plugins = sort grep { m/^Catalyst::Plugin/ } @{ $class . '::ISA' };
+ $c->response->headers->push_header( 'X-Catalyst-Plugins' => [ @plugins ] );
+ }
+
+ return $c;
+}
+
+sub prepare_action {
+ my $c = shift;
+ $c->NEXT::prepare_action(@_);
+ $c->res->header( 'X-Catalyst-Action' => $c->req->action );
+}
+
+1;
--- /dev/null
+package TestApp;
+
+use strict;
+use Catalyst qw[Test::Errors Test::Headers];
+
+our $VERSION = '0.01';
+
+TestApp->config(
+ name => 'TestApp',
+ root => '/Users/chansen/src/MyApp/root',
+);
+
+TestApp->setup;
+
+#sub execute { return shift->NEXT::execute(@_); } # does not work, bug?
+
+sub execute {
+ my $c = shift;
+ my $class = ref( $c->component($_[0]) ) || $_[0];
+ my $action = $c->actions->{reverse}->{"$_[1]"} || "$_[1]";
+
+ my $method;
+
+ if ( $action =~ /->(\w+)$/ ) {
+ $method = $1;
+ }
+ elsif ( $action =~ /\/(\w+)$/ ) {
+ $method = $1;
+ }
+
+ my $executed = sprintf( "%s->%s", $class, $method );
+
+ $c->response->headers->push_header( 'X-Catalyst-Executed' => $executed );
+ return $c->SUPER::execute(@_);
+}
+
+1;
--- /dev/null
+package TestApp::Controller::Action;
+
+use strict;
+use base 'Catalyst::Base';
+
+sub begin : Private {
+ my ( $self, $c ) = @_;
+ $c->res->header( 'X-Test-Class' => ref($self) );
+ $c->response->content_type('text/plain; charset=utf-8');
+}
+
+sub default : Private {
+ my ( $self, $c ) = @_;
+ $c->res->output("Error - TestApp::Controller::Action\n");
+}
+
+1;
--- /dev/null
+package TestApp::Controller::Action::Absoulte;
+
+use strict;
+use base 'TestApp::Controller::Action';
+
+sub action_absolute_one : Action Absolute {
+ my ( $self, $c ) = @_;
+ $c->forward('TestApp::View::Dump::Request');
+}
+
+sub action_absolute_two : Action Global {
+ my ( $self, $c ) = @_;
+ $c->forward('TestApp::View::Dump::Request');
+}
+
+sub action_absolute_three : Action Path('/action_absolute_three') {
+ my ( $self, $c ) = @_;
+ $c->forward('TestApp::View::Dump::Request');
+}
+
+1;
--- /dev/null
+package TestApp::Controller::Action::Begin;
+
+use strict;
+use base 'TestApp::Controller::Action';
+
+sub begin : Private {
+ my ( $self, $c ) = @_;
+ $self->SUPER::begin($c);
+}
+
+sub default : Private {
+ my ( $self, $c ) = @_;
+ $c->forward('TestApp::View::Dump::Request');
+}
+
+1;
--- /dev/null
+package TestApp::Controller::Action::Default;
+
+use strict;
+use base 'TestApp::Controller::Action';
+
+sub default : Private {
+ my ( $self, $c ) = @_;
+ $c->forward('TestApp::View::Dump::Request');
+}
+
+1;
--- /dev/null
+package TestApp::Controller::Action::End;
+
+use strict;
+use base 'TestApp::Controller::Action';
+
+sub end : Private {
+ my ( $self, $c ) = @_;
+}
+
+sub default : Private {
+ my ( $self, $c ) = @_;
+ $c->forward('TestApp::View::Dump::Request');
+}
+
+1;
--- /dev/null
+package TestApp::Controller::Action::Forward;
+
+use strict;
+use base 'TestApp::Controller::Action';
+
+sub one : Relative {
+ my ( $self, $c ) = @_;
+ $c->forward('two');
+}
+
+sub two : Private {
+ my ( $self, $c ) = @_;
+ $c->forward('three');
+}
+
+sub three : Relative {
+ my ( $self, $c ) = @_;
+ $c->forward('four');
+}
+
+sub four : Private {
+ my ( $self, $c ) = @_;
+ $c->forward('five');
+}
+
+sub five : Relative {
+ my ( $self, $c ) = @_;
+ $c->forward('TestApp::View::Dump::Request');
+}
+
+sub jojo : Relative {
+ my ( $self, $c ) = @_;
+ $c->forward('one');
+ $c->forward('three');
+}
+
+1;
--- /dev/null
+package TestApp::Controller::Action::Inheritance;
+
+use strict;
+use base 'TestApp::Controller::Action';
+
+sub begin : Private {
+ my ( $self, $c ) = @_;
+ $self->SUPER::begin($c);
+}
+
+sub default : Private {
+ my ( $self, $c ) = @_;
+ $c->forward('TestApp::View::Dump::Request');
+}
+
+sub end : Private {
+ my ( $self, $c ) = @_;
+}
+
+package TestApp::Controller::Action::Inheritance::A;
+
+use strict;
+use base 'TestApp::Controller::Action';
+
+sub begin : Private {
+ my ( $self, $c ) = @_;
+ $self->SUPER::begin($c);
+}
+
+sub default : Private {
+ my ( $self, $c ) = @_;
+ $c->forward('TestApp::View::Dump::Request');
+}
+
+sub end : Private {
+ my ( $self, $c ) = @_;
+}
+
+package TestApp::Controller::Action::Inheritance::A::B;
+
+use strict;
+use base 'TestApp::Controller::Action';
+
+sub begin : Private {
+ my ( $self, $c ) = @_;
+ $self->SUPER::begin($c);
+}
+
+sub default : Private {
+ my ( $self, $c ) = @_;
+ $c->forward('TestApp::View::Dump::Request');
+}
+
+sub end : Private {
+ my ( $self, $c ) = @_;
+}
+
+1;
+
--- /dev/null
+package TestApp::Controller::Action::Path;
+
+use strict;
+use base 'TestApp::Controller::Action';
+
+sub one : Action Path("a path with spaces") {
+ my ( $self, $c ) = @_;
+ $c->forward('TestApp::View::Dump::Request');
+}
+
+sub two : Action Path("åäö") {
+ my ( $self, $c ) = @_;
+ $c->forward('TestApp::View::Dump::Request');
+}
+
+1;
--- /dev/null
+package TestApp::Controller::Action::Private;
+
+use strict;
+use base 'TestApp::Controller::Action';
+
+sub default : Private {
+ my ( $self, $c ) = @_;
+ $c->res->output('access denied');
+}
+
+sub one : Private {
+ my ( $self, $c ) = @_;
+ $c->res->output('access allowed');
+}
+
+sub two : Private Relative {
+ my ( $self, $c ) = @_;
+ $c->res->output('access allowed');
+}
+
+sub three : Private Absolute {
+ my ( $self, $c ) = @_;
+ $c->res->output('access allowed');
+}
+
+sub four : Private Path('/action/private/four') {
+ my ( $self, $c ) = @_;
+ $c->res->output('access allowed');
+}
+
+sub five : Private Path('five') {
+ my ( $self, $c ) = @_;
+ $c->res->output('access allowed');
+}
+
+1;
--- /dev/null
+package TestApp::Controller::Action::Regexp;
+
+use strict;
+use base 'TestApp::Controller::Action';
+
+sub one : Action Regexp('^action/regexp/(\w+)/(\d+)$') {
+ my ( $self, $c ) = @_;
+ $c->forward('TestApp::View::Dump::Request');
+}
+
+sub two : Action Regex('^action/regexp/(\d+)/(\w+)$') {
+ my ( $self, $c ) = @_;
+ $c->forward('TestApp::View::Dump::Request');
+}
+
+1;
--- /dev/null
+package TestApp::Controller::Action::Relative;
+
+use strict;
+use base 'TestApp::Controller::Action';
+
+sub one : Action Relative {
+ my ( $self, $c ) = @_;
+ $c->forward('TestApp::View::Dump::Request');
+}
+
+sub two : Action Local {
+ my ( $self, $c ) = @_;
+ $c->forward('TestApp::View::Dump::Request');
+}
+
+sub three : Action Path('three') {
+ my ( $self, $c ) = @_;
+ $c->forward('TestApp::View::Dump::Request');
+}
+
+sub four : Action Path('four/five/six') {
+ my ( $self, $c ) = @_;
+ $c->forward('TestApp::View::Dump::Request');
+}
+
+1;
--- /dev/null
+package TestApp::Controller::Dump;
+
+use strict;
+use base 'Catalyst::Base';
+
+sub default : Action Private {
+ my ( $self, $c ) = @_;
+ $c->forward('TestApp::View::Dump');
+}
+
+sub parameters : Action Relative {
+ my ( $self, $c ) = @_;
+ $c->forward('TestApp::View::Dump::Parameters');
+}
+
+sub request : Action Relative {
+ my ( $self, $c ) = @_;
+ $c->forward('TestApp::View::Dump::Request');
+}
+
+sub response : Action Relative {
+ my ( $self, $c ) = @_;
+ $c->forward('TestApp::View::Dump::Response');
+}
+
+1;
--- /dev/null
+package TestApp::Controller::Engine::Response::Cookies;
+
+use strict;
+use base 'Catalyst::Base';
+
+sub one : Relative {
+ my ( $self, $c ) = @_;
+ $c->res->cookies->{Catalyst} = { value => 'Cool', path => '/' };
+ $c->res->cookies->{Cool} = { value => 'Catalyst', path => '/' };
+ $c->forward('TestApp::View::Dump::Request');
+}
+
+sub two : Relative {
+ my ( $self, $c ) = @_;
+ $c->res->cookies->{Catalyst} = { value => 'Cool', path => '/' };
+ $c->res->cookies->{Cool} = { value => 'Catalyst', path => '/' };
+ $c->res->redirect('http://www.google.com/');
+}
+
+1;
--- /dev/null
+package TestApp::Controller::Engine::Response::Errors;
+
+use strict;
+use base 'Catalyst::Base';
+
+sub one : Relative {
+ my ( $self, $c ) = @_;
+ my $a = 0;
+ my $b = 0;
+ my $c = $a / $b;
+}
+
+sub two : Relative {
+ my ( $self, $c ) = @_;
+ $c->forward('/non/existing/path');
+}
+
+sub three : Relative {
+ my ( $self, $c ) = @_;
+ die("I'm going to die!\n");
+}
+
+1;
--- /dev/null
+package TestApp::Controller::Engine::Response::Headers;
+
+use strict;
+use base 'Catalyst::Base';
+
+sub one : Relative {
+ my ( $self, $c ) = @_;
+ $c->res->header( 'X-Header-Catalyst' => 'Cool' );
+ $c->res->header( 'X-Header-Cool' => 'Catalyst' );
+ $c->res->header( 'X-Header-Numbers' => [ 1 .. 10 ] );
+ $c->forward('TestApp::View::Dump::Request');
+}
+
+1;
--- /dev/null
+package TestApp::Controller::Engine::Response::Redirect;
+
+use strict;
+use base 'Catalyst::Base';
+
+sub one : Relative {
+ my ( $self, $c ) = @_;
+ $c->response->redirect('/test/writing/is/boring');
+}
+
+sub two : Relative {
+ my ( $self, $c ) = @_;
+ $c->response->redirect('http://www.google.com/');
+}
+
+sub three : Relative {
+ my ( $self, $c ) = @_;
+ $c->response->redirect('http://www.google.com/');
+ $c->response->status(301); # Moved Permanently
+}
+
+sub four : Relative {
+ my ( $self, $c ) = @_;
+ $c->response->redirect('http://www.google.com/');
+ $c->response->status(307); # Temporary Redirect
+}
+
+1;
+
--- /dev/null
+package TestApp::Controller::Engine::Response::Status;
+
+use strict;
+use base 'Catalyst::Base';
+
+sub begin : Private {
+ my ( $self, $c ) = @_;
+ $c->response->content_type('text/plain');
+ return 1;
+}
+
+sub s200 : Relative {
+ my ( $self, $c ) = @_;
+ $c->res->status(200);
+ $c->res->output("200 OK\n");
+}
+
+sub s400 : Relative {
+ my ( $self, $c ) = @_;
+ $c->res->status(400);
+ $c->res->output("400 Bad Request\n");
+}
+
+sub s403 : Relative {
+ my ( $self, $c ) = @_;
+ $c->res->status(403);
+ $c->res->output("403 Forbidden\n");
+}
+
+sub s404 : Relative {
+ my ( $self, $c ) = @_;
+ $c->res->status(404);
+ $c->res->output("404 Not Found\n");
+}
+
+sub s500 : Relative {
+ my ( $self, $c ) = @_;
+ $c->res->status(500);
+ $c->res->output("500 Internal Server Error\n");
+}
+
+1;
--- /dev/null
+package TestApp::View::Dump;
+
+use strict;
+use base qw[Catalyst::Base];
+
+use Data::Dumper ();
+
+sub dump {
+ my ( $self, $reference ) = @_;
+
+ return unless $reference;
+
+ my $dumper = Data::Dumper->new( [ $reference ] );
+ $dumper->Indent(1);
+ $dumper->Purity(1);
+ $dumper->Useqq(0);
+ $dumper->Deepcopy(1);
+ $dumper->Quotekeys(0);
+ $dumper->Terse(1);
+
+ return $dumper->Dump;
+}
+
+sub process {
+ my ( $self, $c, $reference ) = @_;
+
+ if ( my $output = $self->dump( $reference || $c->stash->{dump} || $c->stash ) ) {
+
+ $c->res->headers->content_type('text/plain');
+ $c->res->output($output);
+ return 1;
+ }
+
+ return 0;
+}
+
+1;
--- /dev/null
+package TestApp::View::Dump::Parameters;
+
+use strict;
+use base qw[TestApp::View::Dump];
+
+sub process {
+ my ( $self, $c ) = @_;
+ return $self->SUPER::process( $c, $c->req->parameters );
+}
+
+1;
--- /dev/null
+package TestApp::View::Dump::Request;
+
+use strict;
+use base qw[TestApp::View::Dump];
+
+sub process {
+ my ( $self, $c ) = @_;
+ return $self->SUPER::process( $c, $c->request );
+}
+
+1;
--- /dev/null
+package TestApp::View::Dump::Response;
+
+use strict;
+use base qw[TestApp::View::Dump];
+
+sub process {
+ my ( $self, $c ) = @_;
+ return $self->SUPER::process( $c, $c->response );
+}
+
+1;
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/../../lib";
+
+use Test::More no_plan => 1;
+use Catalyst::Test 'TestApp';
+
+
+{
+ my @expected = qw[
+ Catalyst::Plugin::Test::Errors
+ Catalyst::Plugin::Test::Headers
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/dump/request'), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ like( $response->content, qr/^bless\( .* 'Catalyst::Request' \)$/s, 'Content is a serialized Catalyst::Request' );
+ is( $response->header('X-Catalyst-Plugins'), $expected, 'Loaded plugins' );
+}
projects / catagits/Catalyst-Runtime.git / commitdiff