-package TestApp::Controller::Action::Detach;\r
-\r
-use strict;\r
-use base 'TestApp::Controller::Action';\r
-\r
-sub one : Local {\r
- my ( $self, $c ) = @_;\r
- $c->detach('two');\r
- $c->forward('error');\r
-}\r
-\r
-sub two : Private {\r
- my ( $self, $c ) = @_;\r
- $c->forward('TestApp::View::Dump::Request');\r
-}\r
-\r
-sub error : Local {\r
- my ( $self, $c ) = @_;\r
- $c->res->output('error');\r
-}\r
-\r
-sub path : Local {\r
- my ( $self, $c ) = @_;\r
- $c->detach('/action/detach/two');\r
- $c->forward('error');\r
-}\r
-\r
-sub with_args : Local {\r
- my ( $self, $c, $orig ) = @_;\r
- $c->detach( 'args', [qq/new/] );\r
-}\r
-\r
-sub with_method_and_args : Local {\r
- my ( $self, $c, $orig ) = @_;\r
- $c->detach( qw/TestApp::Controller::Action::Detach args/, [qq/new/] );\r
-}\r
-\r
-sub args : Local {\r
- my ( $self, $c, $val ) = @_;\r
- die "Expected argument 'new', got '$val'" unless $val eq 'new';\r
- die "passed argument does not match args" unless $val eq $c->req->args->[0];\r
- $c->res->body( $c->req->args->[0] );\r
-}\r
-\r
-1;\r
+package TestApp::Controller::Action::Detach;
+
+use strict;
+use base 'TestApp::Controller::Action';
+
+sub one : Local {
+ my ( $self, $c ) = @_;
+ $c->detach('two');
+ $c->forward('error');
+}
+
+sub two : Private {
+ my ( $self, $c ) = @_;
+ $c->forward('TestApp::View::Dump::Request');
+}
+
+sub error : Local {
+ my ( $self, $c ) = @_;
+ $c->res->output('error');
+}
+
+sub path : Local {
+ my ( $self, $c ) = @_;
+ $c->detach('/action/detach/two');
+ $c->forward('error');
+}
+
+sub with_args : Local {
+ my ( $self, $c, $orig ) = @_;
+ $c->detach( 'args', [qq/new/] );
+}
+
+sub with_method_and_args : Local {
+ my ( $self, $c, $orig ) = @_;
+ $c->detach( qw/TestApp::Controller::Action::Detach args/, [qq/new/] );
+}
+
+sub args : Local {
+ my ( $self, $c, $val ) = @_;
+ die "Expected argument 'new', got '$val'" unless $val eq 'new';
+ die "passed argument does not match args" unless $val eq $c->req->args->[0];
+ $c->res->body( $c->req->args->[0] );
+}
+
+1;
-package TestApp::Controller::Engine::Request::URI;\r
-\r
-use strict;\r
-use base 'Catalyst::Base';\r
-\r
-sub default : Private {\r
- my ( $self, $c ) = @_;\r
- \r
- $c->forward('TestApp::View::Dump::Request');\r
-}\r
-\r
-sub change_path : Local {\r
- my ( $self, $c ) = @_;\r
- \r
- # change the path\r
- $c->req->path( '/my/app/lives/here' );\r
- \r
- $c->forward('TestApp::View::Dump::Request');\r
-}\r
-\r
-sub change_base : Local {\r
- my ( $self, $c ) = @_;\r
- \r
- # change the base and uri paths\r
- $c->req->base->path( '/new/location' );\r
- $c->req->uri->path( '/new/location/engine/request/uri/change_base' );\r
- \r
- $c->forward('TestApp::View::Dump::Request');\r
-}\r
-\r
-sub uri_with : Local {\r
- my ( $self, $c ) = @_;\r
-\r
- # change the current uri\r
- my $uri = $c->req->uri_with( { b => 1 } );\r
- my %query = $uri->query_form;\r
- \r
- $c->res->header( 'X-Catalyst-Param-a' => $query{ a } );\r
- $c->res->header( 'X-Catalyst-Param-b' => $query{ b } );\r
- \r
- $c->forward('TestApp::View::Dump::Request');\r
-}\r
-\r
-sub uri_with_object : Local {\r
- my ( $self, $c ) = @_;\r
-\r
- my $uri = $c->req->uri_with( { a => $c->req->base } );\r
- my %query = $uri->query_form;\r
- \r
- $c->res->header( 'X-Catalyst-Param-a' => $query{ a } );\r
- \r
- $c->forward('TestApp::View::Dump::Request');\r
-}\r
-\r
-sub uri_with_utf8 : Local {\r
- my ( $self, $c ) = @_;\r
-\r
- # change the current uri\r
- my $uri = $c->req->uri_with( { unicode => "\x{2620}" } );\r
- \r
- $c->res->header( 'X-Catalyst-uri-with' => "$uri" );\r
- \r
- $c->forward('TestApp::View::Dump::Request');\r
-}\r
-\r
-sub uri_with_undef : Local {\r
- my ( $self, $c ) = @_;\r
+package TestApp::Controller::Engine::Request::URI;
+
+use strict;
+use base 'Catalyst::Base';
+
+sub default : Private {
+ my ( $self, $c ) = @_;
+
+ $c->forward('TestApp::View::Dump::Request');
+}
+
+sub change_path : Local {
+ my ( $self, $c ) = @_;
+
+ # change the path
+ $c->req->path( '/my/app/lives/here' );
+
+ $c->forward('TestApp::View::Dump::Request');
+}
+
+sub change_base : Local {
+ my ( $self, $c ) = @_;
+
+ # change the base and uri paths
+ $c->req->base->path( '/new/location' );
+ $c->req->uri->path( '/new/location/engine/request/uri/change_base' );
+
+ $c->forward('TestApp::View::Dump::Request');
+}
+
+sub uri_with : Local {
+ my ( $self, $c ) = @_;
+
+ # change the current uri
+ my $uri = $c->req->uri_with( { b => 1 } );
+ my %query = $uri->query_form;
+
+ $c->res->header( 'X-Catalyst-Param-a' => $query{ a } );
+ $c->res->header( 'X-Catalyst-Param-b' => $query{ b } );
+
+ $c->forward('TestApp::View::Dump::Request');
+}
+
+sub uri_with_object : Local {
+ my ( $self, $c ) = @_;
+
+ my $uri = $c->req->uri_with( { a => $c->req->base } );
+ my %query = $uri->query_form;
+
+ $c->res->header( 'X-Catalyst-Param-a' => $query{ a } );
+
+ $c->forward('TestApp::View::Dump::Request');
+}
+
+sub uri_with_utf8 : Local {
+ my ( $self, $c ) = @_;
+
+ # change the current uri
+ my $uri = $c->req->uri_with( { unicode => "\x{2620}" } );
+
+ $c->res->header( 'X-Catalyst-uri-with' => "$uri" );
+
+ $c->forward('TestApp::View::Dump::Request');
+}
+
+sub uri_with_undef : Local {
+ my ( $self, $c ) = @_;
my $warnings = 0;
- local $SIG{__WARN__} = sub { $warnings++ };\r
-\r
+ local $SIG{__WARN__} = sub { $warnings++ };
+
# change the current uri
- my $uri = $c->req->uri_with( { foo => undef } );\r
- \r
- $c->res->header( 'X-Catalyst-warnings' => $warnings );\r
- \r
- $c->forward('TestApp::View::Dump::Request');\r
-}\r
-\r
-1;\r
+ my $uri = $c->req->uri_with( { foo => undef } );
+
+ $c->res->header( 'X-Catalyst-warnings' => $warnings );
+
+ $c->forward('TestApp::View::Dump::Request');
+}
+
+1;
-package TestApp::Controller::Engine::Response::Large;\r
-\r
-use strict;\r
-use base 'Catalyst::Base';\r
-\r
-sub one : Relative {\r
- my ( $self, $c ) = @_;\r
- $c->res->output( 'x' x (100 * 1024) ); \r
-}\r
-\r
-sub two : Relative {\r
- my ( $self, $c ) = @_;\r
- $c->res->output( 'y' x (1024 * 1024) );\r
-}\r
-\r
-1;\r
+package TestApp::Controller::Engine::Response::Large;
+
+use strict;
+use base 'Catalyst::Base';
+
+sub one : Relative {
+ my ( $self, $c ) = @_;
+ $c->res->output( 'x' x (100 * 1024) );
+}
+
+sub two : Relative {
+ my ( $self, $c ) = @_;
+ $c->res->output( 'y' x (1024 * 1024) );
+}
+
+1;
my ($result, $code) = (undef, 1);
if(!-e $ls || !-x _){
- $result = 'skip';
+ $result = 'skip';
}
else {
- $result = system($ls, $ls, $ls);
- $result = $! if $result != 0;
+ $result = system($ls, $ls, $ls);
+ $result = $! if $result != 0;
}
$c->response->body(Dump({result => $result}));
my ($result, $code) = (undef, 1);
if(!-e $ls || !-x _){
- $result = 'skip';
- $code = 0;
+ $result = 'skip';
+ $code = 0;
}
else {
- $result = `$ls $ls $ls` || $!;
- $code = $?;
+ $result = `$ls $ls $ls` || $!;
+ $code = $?;
}
$c->response->body(Dump({result => $result, code => $code}));
my $x = 0;
if($pid = fork()){
- $x = "ok";
+ $x = "ok";
}
else {
- exit(0);
+ exit(0);
}
waitpid $pid,0 or die;
TestApp::Controller::Action::Auto->begin
TestApp::Controller::Action::Auto->auto
TestApp::Controller::Action::Auto->one
- TestApp->end
+ TestApp->end
];
my $expected = join( ", ", @expected );
TestApp::Controller::Action::Auto->begin
TestApp::Controller::Action::Auto->auto
TestApp::Controller::Action::Auto->default
- TestApp->end
+ TestApp->end
];
my $expected = join( ", ", @expected );
TestApp::Controller::Action::Auto->auto
TestApp::Controller::Action::Auto::Deep->auto
TestApp::Controller::Action::Auto::Deep->one
- TestApp->end
+ TestApp->end
];
my $expected = join( ", ", @expected );
TestApp::Controller::Action::Auto->auto
TestApp::Controller::Action::Auto::Deep->auto
TestApp::Controller::Action::Auto::Deep->default
- TestApp->end
+ TestApp->end
];
my $expected = join( ", ", @expected );
TestApp::Controller::Action::Begin->begin
TestApp::Controller::Action::Begin->default
TestApp::View::Dump::Request->process
- TestApp->end
+ TestApp->end
];
my $expected = join( ", ", @expected );
-#!perl\r
-\r
-use strict;\r
-use warnings;\r
-\r
-use FindBin;\r
-use lib "$FindBin::Bin/lib";\r
-\r
-our $iters;\r
-\r
-BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; }\r
-\r
-use Test::More tests => 18*$iters;\r
-use Catalyst::Test 'TestApp';\r
-\r
-if ( $ENV{CAT_BENCHMARK} ) {\r
- require Benchmark;\r
- Benchmark::timethis( $iters, \&run_tests );\r
-}\r
-else {\r
- for ( 1 .. $iters ) {\r
- run_tests();\r
- }\r
-}\r
-\r
-sub run_tests {\r
- {\r
- my @expected = qw[\r
- TestApp::Controller::Action::Detach->begin\r
- TestApp::Controller::Action::Detach->one\r
- TestApp::Controller::Action::Detach->two\r
- TestApp::View::Dump::Request->process\r
- TestApp->end\r
- ];\r
-\r
- my $expected = join( ", ", @expected );\r
-\r
- # Test detach to chain of actions.\r
- ok( my $response = request('http://localhost/action/detach/one'),\r
- 'Request' );\r
- ok( $response->is_success, 'Response Successful 2xx' );\r
- is( $response->content_type, 'text/plain', 'Response Content-Type' );\r
- is( $response->header('X-Catalyst-Action'),\r
- 'action/detach/one', 'Test Action' );\r
- is(\r
- $response->header('X-Test-Class'),\r
- 'TestApp::Controller::Action::Detach',\r
- 'Test Class'\r
- );\r
- is( $response->header('X-Catalyst-Executed'),\r
- $expected, 'Executed actions' );\r
- }\r
-\r
- {\r
- my @expected = qw[\r
- TestApp::Controller::Action::Detach->begin\r
- TestApp::Controller::Action::Detach->path\r
- TestApp::Controller::Action::Detach->two\r
- TestApp::View::Dump::Request->process\r
- TestApp->end\r
- ];\r
-\r
- my $expected = join( ", ", @expected );\r
-\r
- # Test detach to chain of actions.\r
- ok( my $response = request('http://localhost/action/detach/path'),\r
- 'Request' );\r
- ok( $response->is_success, 'Response Successful 2xx' );\r
- is( $response->content_type, 'text/plain', 'Response Content-Type' );\r
- is( $response->header('X-Catalyst-Action'),\r
- 'action/detach/path', 'Test Action' );\r
- is(\r
- $response->header('X-Test-Class'),\r
- 'TestApp::Controller::Action::Detach',\r
- 'Test Class'\r
- );\r
- is( $response->header('X-Catalyst-Executed'),\r
- $expected, 'Executed actions' );\r
- }\r
-\r
- {\r
- ok(\r
- my $response =\r
- request('http://localhost/action/detach/with_args/old'),\r
- 'Request with args'\r
- );\r
- ok( $response->is_success, 'Response Successful 2xx' );\r
- is( $response->content, 'new' );\r
- }\r
-\r
- {\r
- ok(\r
- my $response = request(\r
- 'http://localhost/action/detach/with_method_and_args/old'),\r
- 'Request with args and method'\r
- );\r
- ok( $response->is_success, 'Response Successful 2xx' );\r
- is( $response->content, 'new' );\r
- }\r
-}\r
+#!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 => 18*$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::Detach->begin
+ TestApp::Controller::Action::Detach->one
+ TestApp::Controller::Action::Detach->two
+ TestApp::View::Dump::Request->process
+ TestApp->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ # Test detach to chain of actions.
+ ok( my $response = request('http://localhost/action/detach/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/detach/one', 'Test Action' );
+ is(
+ $response->header('X-Test-Class'),
+ 'TestApp::Controller::Action::Detach',
+ 'Test Class'
+ );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ }
+
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Detach->begin
+ TestApp::Controller::Action::Detach->path
+ TestApp::Controller::Action::Detach->two
+ TestApp::View::Dump::Request->process
+ TestApp->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ # Test detach to chain of actions.
+ ok( my $response = request('http://localhost/action/detach/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/detach/path', 'Test Action' );
+ is(
+ $response->header('X-Test-Class'),
+ 'TestApp::Controller::Action::Detach',
+ 'Test Class'
+ );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ }
+
+ {
+ ok(
+ my $response =
+ request('http://localhost/action/detach/with_args/old'),
+ 'Request with args'
+ );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content, 'new' );
+ }
+
+ {
+ ok(
+ my $response = request(
+ 'http://localhost/action/detach/with_method_and_args/old'),
+ 'Request with args and method'
+ );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content, 'new' );
+ }
+}
my @expected = qw[
TestApp::Controller::Action::Index->begin
TestApp::Controller::Action::Index->default
- TestApp->end
+ TestApp->end
];
my $expected = join( ", ", @expected );
BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1;
- # add special paths to test here
- @paths = (
- # all reserved in uri's
- qw~ : / ? [ ] @ ! $ & ' ( ) * + ; = ~, ',' , '#',
+ # add special paths to test here
+ @paths = (
+ # all reserved in uri's
+ qw~ : / ? [ ] @ ! $ & ' ( ) * + ; = ~, ',' , '#',
- # unreserved
- 'a'..'z','A'..'Z',0..9,qw( - . _ ~ ),
- " ",
+ # unreserved
+ 'a'..'z','A'..'Z',0..9,qw( - . _ ~ ),
+ " ",
- # just to test %2F/%
- [ qw~ / / ~ ],
+ # just to test %2F/%
+ [ qw~ / / ~ ],
- # testing %25/%25
- [ qw~ % % ~ ],
- );
+ # testing %25/%25
+ [ qw~ % % ~ ],
+ );
}
use Test::More tests => 6*@paths * $iters;
-\feff#!perl\r
-\r
-use strict;\r
-use warnings;\r
-\r
-use FindBin;\r
-use lib "$FindBin::Bin/lib";\r
-\r
-use Test::More tests => 44;\r
-use Catalyst::Test 'TestApp';\r
-use Catalyst::Request;\r
-\r
-my $creq;\r
-\r
-# test that the path can be changed\r
-{\r
- ok( my $response = request('http://localhost/engine/request/uri/change_path'), 'Request' );\r
- ok( $response->is_success, 'Response Successful 2xx' );\r
- ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );\r
- like( $creq->uri, qr{/my/app/lives/here$}, 'URI contains new path' );\r
-}\r
-\r
-# test that path properly removes the base location\r
-{\r
- ok( my $response = request('http://localhost/engine/request/uri/change_base'), 'Request' );\r
- ok( $response->is_success, 'Response Successful 2xx' );\r
- ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );\r
- like( $creq->base, qr{/new/location}, 'Base URI contains new location' );\r
- is( $creq->path, 'engine/request/uri/change_base', 'URI contains correct path' );\r
-}\r
-\r
-# test that base + path is correct\r
-{\r
- ok( my $response = request('http://localhost/engine/request/uri'), 'Request' );\r
- ok( $response->is_success, 'Response Successful 2xx' );\r
- ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );\r
- is( $creq->base . $creq->path, $creq->uri, 'Base + Path ok' );\r
-}\r
-\r
-# test that we can use semi-colons as separators\r
-{\r
- my $parameters = {\r
- a => [ qw/1 2/ ],\r
- b => 3,\r
- };\r
- \r
- ok( my $response = request('http://localhost/engine/request/uri?a=1;a=2;b=3'), 'Request' );\r
- ok( $response->is_success, 'Response Successful 2xx' );\r
- ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );\r
- is( $creq->{uri}->query, 'a=1;a=2;b=3', 'Query string ok' );\r
- is_deeply( $creq->{parameters}, $parameters, 'Parameters ok' );\r
-}\r
-\r
-# test that query params are unescaped properly\r
-{\r
- ok( my $response = request('http://localhost/engine/request/uri?text=Catalyst%20Rocks'), 'Request' );\r
- ok( $response->is_success, 'Response Successful 2xx' );\r
- ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );\r
- is( $creq->{uri}->query, 'text=Catalyst%20Rocks', 'Query string ok' );\r
- is( $creq->{parameters}->{text}, 'Catalyst Rocks', 'Unescaped param ok' );\r
-}\r
-\r
-# test that uri_with adds params\r
-{\r
- ok( my $response = request('http://localhost/engine/request/uri/uri_with'), 'Request' );\r
- ok( $response->is_success, 'Response Successful 2xx' );\r
- ok( !defined $response->header( 'X-Catalyst-Param-a' ), 'param "a" ok' );\r
- is( $response->header( 'X-Catalyst-Param-b' ), '1', 'param "b" ok' );\r
-}\r
-\r
-# test that uri_with adds params (and preserves)\r
-{\r
- ok( my $response = request('http://localhost/engine/request/uri/uri_with?a=1'), 'Request' );\r
- ok( $response->is_success, 'Response Successful 2xx' );\r
- is( $response->header( 'X-Catalyst-Param-a' ), '1', 'param "a" ok' );\r
- is( $response->header( 'X-Catalyst-Param-b' ), '1', 'param "b" ok' );\r
-}\r
-\r
-# test that uri_with replaces params (and preserves)\r
-{\r
- ok( my $response = request('http://localhost/engine/request/uri/uri_with?a=1&b=2'), 'Request' );\r
- ok( $response->is_success, 'Response Successful 2xx' );\r
- is( $response->header( 'X-Catalyst-Param-a' ), '1', 'param "a" ok' );\r
- is( $response->header( 'X-Catalyst-Param-b' ), '1', 'param "b" ok' );\r
-}\r
-\r
-# test that uri_with replaces params (and preserves)\r
-{\r
- ok( my $response = request('http://localhost/engine/request/uri/uri_with_object'), 'Request' );\r
- ok( $response->is_success, 'Response Successful 2xx' );\r
- like( $response->header( 'X-Catalyst-Param-a' ), qr(http://localhost[^/]*/), 'param "a" ok' );\r
-}\r
-\r
-# test that uri_with is utf8 safe\r
-{\r
- ok( my $response = request("http://localhost/engine/request/uri/uri_with_utf8"), 'Request' );\r
- ok( $response->is_success, 'Response Successful 2xx' );\r
- like( $response->header( 'X-Catalyst-uri-with' ), qr/%E2%98%A0$/, 'uri_with ok' );\r
-}\r
+\feff#!perl
-# test with undef -- no warnings should be thrown\r
-{\r
- ok( my $response = request("http://localhost/engine/request/uri/uri_with_undef"), 'Request' );\r
- ok( $response->is_success, 'Response Successful 2xx' );\r
- is( $response->header( 'X-Catalyst-warnings' ), 0, 'no warnings emitted' );\r
-}\r
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+use Test::More tests => 44;
+use Catalyst::Test 'TestApp';
+use Catalyst::Request;
+
+my $creq;
+
+# test that the path can be changed
+{
+ ok( my $response = request('http://localhost/engine/request/uri/change_path'), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
+ like( $creq->uri, qr{/my/app/lives/here$}, 'URI contains new path' );
+}
+
+# test that path properly removes the base location
+{
+ ok( my $response = request('http://localhost/engine/request/uri/change_base'), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
+ like( $creq->base, qr{/new/location}, 'Base URI contains new location' );
+ is( $creq->path, 'engine/request/uri/change_base', 'URI contains correct path' );
+}
+
+# test that base + path is correct
+{
+ ok( my $response = request('http://localhost/engine/request/uri'), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
+ is( $creq->base . $creq->path, $creq->uri, 'Base + Path ok' );
+}
+
+# test that we can use semi-colons as separators
+{
+ my $parameters = {
+ a => [ qw/1 2/ ],
+ b => 3,
+ };
+
+ ok( my $response = request('http://localhost/engine/request/uri?a=1;a=2;b=3'), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
+ is( $creq->{uri}->query, 'a=1;a=2;b=3', 'Query string ok' );
+ is_deeply( $creq->{parameters}, $parameters, 'Parameters ok' );
+}
+
+# test that query params are unescaped properly
+{
+ ok( my $response = request('http://localhost/engine/request/uri?text=Catalyst%20Rocks'), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
+ is( $creq->{uri}->query, 'text=Catalyst%20Rocks', 'Query string ok' );
+ is( $creq->{parameters}->{text}, 'Catalyst Rocks', 'Unescaped param ok' );
+}
+
+# test that uri_with adds params
+{
+ ok( my $response = request('http://localhost/engine/request/uri/uri_with'), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ ok( !defined $response->header( 'X-Catalyst-Param-a' ), 'param "a" ok' );
+ is( $response->header( 'X-Catalyst-Param-b' ), '1', 'param "b" ok' );
+}
+
+# test that uri_with adds params (and preserves)
+{
+ ok( my $response = request('http://localhost/engine/request/uri/uri_with?a=1'), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->header( 'X-Catalyst-Param-a' ), '1', 'param "a" ok' );
+ is( $response->header( 'X-Catalyst-Param-b' ), '1', 'param "b" ok' );
+}
+
+# test that uri_with replaces params (and preserves)
+{
+ ok( my $response = request('http://localhost/engine/request/uri/uri_with?a=1&b=2'), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->header( 'X-Catalyst-Param-a' ), '1', 'param "a" ok' );
+ is( $response->header( 'X-Catalyst-Param-b' ), '1', 'param "b" ok' );
+}
+
+# test that uri_with replaces params (and preserves)
+{
+ ok( my $response = request('http://localhost/engine/request/uri/uri_with_object'), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ like( $response->header( 'X-Catalyst-Param-a' ), qr(http://localhost[^/]*/), 'param "a" ok' );
+}
+
+# test that uri_with is utf8 safe
+{
+ ok( my $response = request("http://localhost/engine/request/uri/uri_with_utf8"), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ like( $response->header( 'X-Catalyst-uri-with' ), qr/%E2%98%A0$/, 'uri_with ok' );
+}
+
+# test with undef -- no warnings should be thrown
+{
+ ok( my $response = request("http://localhost/engine/request/uri/uri_with_undef"), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->header( 'X-Catalyst-warnings' ), 0, 'no warnings emitted' );
+}
-#!perl\r
-\r
-use strict;\r
-use warnings;\r
-\r
-use FindBin;\r
-use lib "$FindBin::Bin/lib";\r
-\r
-use Test::More tests => 6;\r
-use Catalyst::Test 'TestApp';\r
-\r
-# phaylon noticed that refactored was truncating output on large images.\r
-# This test tests 100K and 1M output content.\r
-\r
-my $expected = {\r
- one => 'x' x (100 * 1024),\r
- two => 'y' x (1024 * 1024),\r
-};\r
-\r
-for my $action ( keys %{$expected} ) {\r
- ok( my $response = request('http://localhost/engine/response/large/' . $action ),\r
- 'Request' );\r
- ok( $response->is_success, 'Response Successful 2xx' );\r
- \r
- is( length( $response->content ), length( $expected->{$action} ), 'Length OK' );\r
-}\r
-\r
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+use Test::More tests => 6;
+use Catalyst::Test 'TestApp';
+
+# phaylon noticed that refactored was truncating output on large images.
+# This test tests 100K and 1M output content.
+
+my $expected = {
+ one => 'x' x (100 * 1024),
+ two => 'y' x (1024 * 1024),
+};
+
+for my $action ( keys %{$expected} ) {
+ ok( my $response = request('http://localhost/engine/response/large/' . $action ),
+ 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+
+ is( length( $response->content ), length( $expected->{$action} ), 'Length OK' );
+}
+
-#!perl\r
-\r
-# This test tests the standalone server's auto-restart feature.\r
-\r
-use strict;\r
-use warnings;\r
-\r
-use File::Path;\r
-use FindBin;\r
-use LWP::Simple;\r
-use IO::Socket;\r
-use Test::More;\r
-use Time::HiRes qw/sleep/;\r
-eval "use Catalyst::Devel 1.0;";\r
-\r
-plan skip_all => 'set TEST_HTTP to enable this test' unless $ENV{TEST_HTTP};\r
-plan skip_all => 'Catalyst::Devel required' if $@;\r
-eval "use File::Copy::Recursive";\r
-plan skip_all => 'File::Copy::Recursive required' if $@;\r
-\r
-plan tests => 40;\r
-\r
-# clean up\r
-rmtree "$FindBin::Bin/../t/tmp" if -d "$FindBin::Bin/../t/tmp";\r
-\r
-# create a TestApp and copy the test libs into it\r
-mkdir "$FindBin::Bin/../t/tmp";\r
-chdir "$FindBin::Bin/../t/tmp";\r
-system\r
- "perl -I$FindBin::Bin/../lib $FindBin::Bin/../script/catalyst.pl TestApp";\r
-chdir "$FindBin::Bin/..";\r
-File::Copy::Recursive::dircopy( 't/lib', 't/tmp/TestApp/lib' );\r
-\r
-# remove TestApp's tests\r
-rmtree 't/tmp/TestApp/t';\r
-\r
-# spawn the standalone HTTP server\r
-my $port = 30000 + int rand( 1 + 10000 );\r
-my $pid = open my $server,\r
-"perl -I$FindBin::Bin/../lib $FindBin::Bin/../t/tmp/TestApp/script/testapp_server.pl -port $port -restart 2>&1 |"\r
- or die "Unable to spawn standalone HTTP server: $!";\r
-\r
-# wait for it to start\r
-print "Waiting for server to start...\n";\r
-while ( check_port( 'localhost', $port ) != 1 ) {\r
- sleep 1;\r
-}\r
-\r
-# change various files\r
-my @files = (\r
- "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp.pm",\r
- "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Action/Begin.pm",\r
-"$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Engine/Request/URI.pm",\r
-);\r
-\r
-# change some files and make sure the server restarts itself\r
-for ( 1 .. 20 ) {\r
- my $index = rand @files;\r
- open my $pm, '>>', $files[$index]\r
- or die "Unable to open $files[$index] for writing: $!";\r
- print $pm "\n";\r
- close $pm;\r
-\r
- # give the server time to notice the change and restart\r
- my $count = 0;\r
- sleep 1;\r
- while ( check_port( 'localhost', $port ) != 1 ) {\r
-\r
- # wait for it to restart\r
- sleep 0.1;\r
- die "Server appears to have died" if $count++ > 50;\r
- }\r
- my $response = get("http://localhost:$port/action/default");\r
- like( $response, qr/Catalyst::Request/, 'Non-error restart, request OK' );\r
-\r
- #print $server->getline;\r
-}\r
-\r
-# add errors to the file and make sure server does not die or restart\r
-for ( 1 .. 20 ) {\r
- my $index = rand @files;\r
- open my $pm, '>>', $files[$index]\r
- or die "Unable to open $files[$index] for writing: $!";\r
- print $pm "bleh";\r
- close $pm;\r
-\r
- # give the server time to notice the change\r
- sleep 1;\r
- if ( check_port( 'localhost', $port ) != 1 ) {\r
- die "Server appears to have died";\r
- }\r
- my $response = get("http://localhost:$port/action/default");\r
- like( $response, qr/Catalyst::Request/,\r
- 'Syntax error, no restart, request OK' );\r
-\r
- #print $server->getline;\r
-}\r
-\r
-# shut it down\r
-kill 'INT', $pid;\r
-close $server;\r
-\r
-# clean up\r
-rmtree "$FindBin::Bin/../t/tmp" if -d "$FindBin::Bin/../t/tmp";\r
-\r
-sub check_port {\r
- my ( $host, $port ) = @_;\r
-\r
- my $remote = IO::Socket::INET->new(\r
- Proto => "tcp",\r
- PeerAddr => $host,\r
- PeerPort => $port\r
- );\r
- if ($remote) {\r
- close $remote;\r
- return 1;\r
- }\r
- else {\r
- return 0;\r
- }\r
-}\r
+#!perl
+
+# This test tests the standalone server's auto-restart feature.
+
+use strict;
+use warnings;
+
+use File::Path;
+use FindBin;
+use LWP::Simple;
+use IO::Socket;
+use Test::More;
+use Time::HiRes qw/sleep/;
+eval "use Catalyst::Devel 1.0;";
+
+plan skip_all => 'set TEST_HTTP to enable this test' unless $ENV{TEST_HTTP};
+plan skip_all => 'Catalyst::Devel required' if $@;
+eval "use File::Copy::Recursive";
+plan skip_all => 'File::Copy::Recursive required' if $@;
+
+plan tests => 40;
+
+# clean up
+rmtree "$FindBin::Bin/../t/tmp" if -d "$FindBin::Bin/../t/tmp";
+
+# create a TestApp and copy the test libs into it
+mkdir "$FindBin::Bin/../t/tmp";
+chdir "$FindBin::Bin/../t/tmp";
+system
+ "perl -I$FindBin::Bin/../lib $FindBin::Bin/../script/catalyst.pl TestApp";
+chdir "$FindBin::Bin/..";
+File::Copy::Recursive::dircopy( 't/lib', 't/tmp/TestApp/lib' );
+
+# remove TestApp's tests
+rmtree 't/tmp/TestApp/t';
+
+# spawn the standalone HTTP server
+my $port = 30000 + int rand( 1 + 10000 );
+my $pid = open my $server,
+"perl -I$FindBin::Bin/../lib $FindBin::Bin/../t/tmp/TestApp/script/testapp_server.pl -port $port -restart 2>&1 |"
+ or die "Unable to spawn standalone HTTP server: $!";
+
+# wait for it to start
+print "Waiting for server to start...\n";
+while ( check_port( 'localhost', $port ) != 1 ) {
+ sleep 1;
+}
+
+# change various files
+my @files = (
+ "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp.pm",
+ "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Action/Begin.pm",
+"$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Engine/Request/URI.pm",
+);
+
+# change some files and make sure the server restarts itself
+for ( 1 .. 20 ) {
+ my $index = rand @files;
+ open my $pm, '>>', $files[$index]
+ or die "Unable to open $files[$index] for writing: $!";
+ print $pm "\n";
+ close $pm;
+
+ # give the server time to notice the change and restart
+ my $count = 0;
+ sleep 1;
+ while ( check_port( 'localhost', $port ) != 1 ) {
+
+ # wait for it to restart
+ sleep 0.1;
+ die "Server appears to have died" if $count++ > 50;
+ }
+ my $response = get("http://localhost:$port/action/default");
+ like( $response, qr/Catalyst::Request/, 'Non-error restart, request OK' );
+
+ #print $server->getline;
+}
+
+# add errors to the file and make sure server does not die or restart
+for ( 1 .. 20 ) {
+ my $index = rand @files;
+ open my $pm, '>>', $files[$index]
+ or die "Unable to open $files[$index] for writing: $!";
+ print $pm "bleh";
+ close $pm;
+
+ # give the server time to notice the change
+ sleep 1;
+ if ( check_port( 'localhost', $port ) != 1 ) {
+ die "Server appears to have died";
+ }
+ my $response = get("http://localhost:$port/action/default");
+ like( $response, qr/Catalyst::Request/,
+ 'Syntax error, no restart, request OK' );
+
+ #print $server->getline;
+}
+
+# shut it down
+kill 'INT', $pid;
+close $server;
+
+# clean up
+rmtree "$FindBin::Bin/../t/tmp" if -d "$FindBin::Bin/../t/tmp";
+
+sub check_port {
+ my ( $host, $port ) = @_;
+
+ my $remote = IO::Socket::INET->new(
+ Proto => "tcp",
+ PeerAddr => $host,
+ PeerPort => $port
+ );
+ if ($remote) {
+ close $remote;
+ return 1;
+ }
+ else {
+ return 0;
+ }
+}
-#!perl\r
-\r
-use strict;\r
-use warnings;\r
-\r
-use FindBin;\r
-use lib "$FindBin::Bin/lib";\r
-\r
-use Test::More;\r
-use Catalyst::Test 'TestApp';\r
-use YAML;\r
-\r
-our ( $iters, $tests );\r
-\r
-BEGIN {\r
- plan skip_all => 'set TEST_STRESS to enable this test'\r
- unless $ENV{TEST_STRESS};\r
-\r
- $iters = $ENV{TEST_STRESS} || 10;\r
- $tests = YAML::LoadFile("$FindBin::Bin/optional_stress.yml");\r
-\r
- my $total_tests = 0;\r
- map { $total_tests += scalar @{ $tests->{$_} } } keys %{$tests};\r
- plan tests => $iters * $total_tests;\r
-}\r
-\r
-for ( 1 .. $iters ) {\r
- run_tests();\r
-}\r
-\r
-sub run_tests {\r
- foreach my $test_group ( keys %{$tests} ) {\r
- foreach my $test ( @{ $tests->{$test_group} } ) {\r
- ok( request($test), $test_group . ' - ' . $test );\r
- }\r
- }\r
-}\r
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+use Test::More;
+use Catalyst::Test 'TestApp';
+use YAML;
+
+our ( $iters, $tests );
+
+BEGIN {
+ plan skip_all => 'set TEST_STRESS to enable this test'
+ unless $ENV{TEST_STRESS};
+
+ $iters = $ENV{TEST_STRESS} || 10;
+ $tests = YAML::LoadFile("$FindBin::Bin/optional_stress.yml");
+
+ my $total_tests = 0;
+ map { $total_tests += scalar @{ $tests->{$_} } } keys %{$tests};
+ plan tests => $iters * $total_tests;
+}
+
+for ( 1 .. $iters ) {
+ run_tests();
+}
+
+sub run_tests {
+ foreach my $test_group ( keys %{$tests} ) {
+ foreach my $test ( @{ $tests->{$test_group} } ) {
+ ok( request($test), $test_group . ' - ' . $test );
+ }
+ }
+}
-#!perl\r
-\r
-use strict;\r
-use warnings;\r
-\r
-use FindBin;\r
-use lib "$FindBin::Bin/lib";\r
-\r
-use Test::More;\r
-use Catalyst::Test 'TestApp';\r
-use Catalyst::Request;\r
-use Config;\r
-use HTTP::Response;\r
-\r
-plan skip_all => 'set TEST_THREADS to enable this test'\r
- unless $ENV{TEST_THREADS};\r
-\r
-if ( $Config{useithreads} && !$ENV{CATALYST_SERVER} ) {\r
- require threads;\r
- plan tests => 3;\r
-}\r
-else {\r
- if ( $ENV{CATALYST_SERVER} ) {\r
- plan skip_all => 'Using remote server';\r
- }\r
- else {\r
- plan skip_all => 'Needs a Perl with ithreads enabled';\r
- }\r
-}\r
- \r
-no warnings 'redefine';\r
-sub request {\r
- my $thr = threads->new( \r
- sub { Catalyst::Test::local_request('TestApp',@_) },\r
- @_ \r
- );\r
- $thr->join;\r
-}\r
-\r
-# test that running inside a thread works ok\r
-{\r
- my @expected = qw[\r
- TestApp::Controller::Action::Default->begin\r
- TestApp::Controller::Action::Default->default\r
- TestApp::View::Dump::Request->process\r
- TestApp->end\r
- ];\r
-\r
- my $expected = join( ", ", @expected );\r
- \r
- ok( my $response = request('http://localhost/action/default'), 'Request' );\r
- ok( $response->is_success, 'Response Successful 2xx' );\r
- is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' );\r
-}\r
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+use Test::More;
+use Catalyst::Test 'TestApp';
+use Catalyst::Request;
+use Config;
+use HTTP::Response;
+
+plan skip_all => 'set TEST_THREADS to enable this test'
+ unless $ENV{TEST_THREADS};
+
+if ( $Config{useithreads} && !$ENV{CATALYST_SERVER} ) {
+ require threads;
+ plan tests => 3;
+}
+else {
+ if ( $ENV{CATALYST_SERVER} ) {
+ plan skip_all => 'Using remote server';
+ }
+ else {
+ plan skip_all => 'Needs a Perl with ithreads enabled';
+ }
+}
+
+no warnings 'redefine';
+sub request {
+ my $thr = threads->new(
+ sub { Catalyst::Test::local_request('TestApp',@_) },
+ @_
+ );
+ $thr->join;
+}
+
+# test that running inside a thread works ok
+{
+ my @expected = qw[
+ TestApp::Controller::Action::Default->begin
+ TestApp::Controller::Action::Default->default
+ TestApp::View::Dump::Request->process
+ TestApp->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/action/default'), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' );
+}
-## ============================================================================\r
-## Test to make sure that subclassed controllers (catalyst controllers\r
-## that inherit from a custom base catalyst controller) don't experienc\r
-## any namespace collision in the values under config.\r
-## ============================================================================\r
-\r
-use Test::More tests => 9;\r
-\r
-use strict;\r
-use warnings;\r
-\r
-use_ok('Catalyst');\r
-\r
-## ----------------------------------------------------------------------------\r
-## First We define a base controller that inherits from Catalyst::Controller\r
-## We add something to the config that we expect all children classes to\r
-## be able to find.\r
-## ----------------------------------------------------------------------------\r
-\r
-{\r
- package base_controller;\r
- \r
- use base 'Catalyst::Controller';\r
- \r
- __PACKAGE__->config( base_key => 'base_value' );\r
-}\r
-\r
-## ----------------------------------------------------------------------------\r
-## Next we instantiate two classes that inherit from the base controller. We\r
-## Add some local config information to these.\r
-## ----------------------------------------------------------------------------\r
-\r
-{\r
- package controller_a;\r
-\r
- use base 'base_controller';\r
- \r
- __PACKAGE__->config( key_a => 'value_a' );\r
-}\r
- \r
- \r
-{\r
- package controller_b;\r
-\r
- use base 'base_controller';\r
-\r
- __PACKAGE__->config( key_b => 'value_b' );\r
-}\r
-\r
-## Okay, we expect that the base controller has a config with one key\r
-## and that the two children controllers inherit that config key and then\r
-## add one more. So the base controller has one config value and the two\r
-## children each have two.\r
-\r
-## ----------------------------------------------------------------------------\r
-## THE TESTS. Basically we first check to make sure that all the children of\r
-## the base_controller properly inherit the {base_key => 'base_value'} info\r
-## and that each of the children also has it's local config data and that none\r
-## of the classes have data that is unexpected.\r
-## ----------------------------------------------------------------------------\r
-\r
-\r
-# First round, does everything have what we expect to find? If these tests fail there is something\r
-# wrong with the way config is storing it's information.\r
-\r
-ok( base_controller->config->{base_key} eq 'base_value', 'base_controller has expected config value for "base_key"') or\r
- diag('"base_key" defined as "'.base_controller->config->{base_key}.'" and not "base_value" in config');\r
-\r
-ok( controller_a->config->{base_key} eq 'base_value', 'controller_a has expected config value for "base_key"') or\r
- diag('"base_key" defined as "'.controller_a->config->{base_key}.'" and not "base_value" in config');\r
- \r
-ok( controller_a->config->{key_a} eq 'value_a', 'controller_a has expected config value for "key_a"') or\r
- diag('"key_a" defined as "'.controller_a->config->{key_a}.'" and not "value_a" in config');\r
-\r
-ok( controller_b->config->{base_key} eq 'base_value', 'controller_b has expected config value for "base_key"') or\r
- diag('"base_key" defined as "'.controller_b->config->{base_key}.'" and not "base_value" in config');\r
- \r
-ok( controller_b->config->{key_b} eq 'value_b', 'controller_b has expected config value for "key_b"') or\r
- diag('"key_b" defined as "'.controller_b->config->{key_b}.'" and not "value_b" in config');\r
-\r
-# second round, does each controller have the expected number of config values? If this test fails there is\r
-# probably some data collision between the controllers.\r
-\r
-ok( scalar(keys %{base_controller->config}) == 1, 'base_controller has the expected number of config values') or\r
- diag("base_controller should have 1 config value, but it has ".scalar(keys %{base_controller->config}));\r
- \r
-ok( scalar(keys %{controller_a->config}) == 2, 'controller_a has the expected number of config values') or\r
- diag("controller_a should have 2 config value, but it has ".scalar(keys %{base_controller->config}));\r
- \r
-ok( scalar(keys %{controller_b->config}) == 2, 'controller_b has the expected number of config values') or\r
- diag("controller_a should have 2 config value, but it has ".scalar(keys %{base_controller->config}));\r
+## ============================================================================
+## Test to make sure that subclassed controllers (catalyst controllers
+## that inherit from a custom base catalyst controller) don't experienc
+## any namespace collision in the values under config.
+## ============================================================================
+
+use Test::More tests => 9;
+
+use strict;
+use warnings;
+
+use_ok('Catalyst');
+
+## ----------------------------------------------------------------------------
+## First We define a base controller that inherits from Catalyst::Controller
+## We add something to the config that we expect all children classes to
+## be able to find.
+## ----------------------------------------------------------------------------
+
+{
+ package base_controller;
+
+ use base 'Catalyst::Controller';
+
+ __PACKAGE__->config( base_key => 'base_value' );
+}
+
+## ----------------------------------------------------------------------------
+## Next we instantiate two classes that inherit from the base controller. We
+## Add some local config information to these.
+## ----------------------------------------------------------------------------
+
+{
+ package controller_a;
+
+ use base 'base_controller';
+
+ __PACKAGE__->config( key_a => 'value_a' );
+}
+
+
+{
+ package controller_b;
+
+ use base 'base_controller';
+
+ __PACKAGE__->config( key_b => 'value_b' );
+}
+
+## Okay, we expect that the base controller has a config with one key
+## and that the two children controllers inherit that config key and then
+## add one more. So the base controller has one config value and the two
+## children each have two.
+
+## ----------------------------------------------------------------------------
+## THE TESTS. Basically we first check to make sure that all the children of
+## the base_controller properly inherit the {base_key => 'base_value'} info
+## and that each of the children also has it's local config data and that none
+## of the classes have data that is unexpected.
+## ----------------------------------------------------------------------------
+
+
+# First round, does everything have what we expect to find? If these tests fail there is something
+# wrong with the way config is storing it's information.
+
+ok( base_controller->config->{base_key} eq 'base_value', 'base_controller has expected config value for "base_key"') or
+ diag('"base_key" defined as "'.base_controller->config->{base_key}.'" and not "base_value" in config');
+
+ok( controller_a->config->{base_key} eq 'base_value', 'controller_a has expected config value for "base_key"') or
+ diag('"base_key" defined as "'.controller_a->config->{base_key}.'" and not "base_value" in config');
+
+ok( controller_a->config->{key_a} eq 'value_a', 'controller_a has expected config value for "key_a"') or
+ diag('"key_a" defined as "'.controller_a->config->{key_a}.'" and not "value_a" in config');
+
+ok( controller_b->config->{base_key} eq 'base_value', 'controller_b has expected config value for "base_key"') or
+ diag('"base_key" defined as "'.controller_b->config->{base_key}.'" and not "base_value" in config');
+
+ok( controller_b->config->{key_b} eq 'value_b', 'controller_b has expected config value for "key_b"') or
+ diag('"key_b" defined as "'.controller_b->config->{key_b}.'" and not "value_b" in config');
+
+# second round, does each controller have the expected number of config values? If this test fails there is
+# probably some data collision between the controllers.
+
+ok( scalar(keys %{base_controller->config}) == 1, 'base_controller has the expected number of config values') or
+ diag("base_controller should have 1 config value, but it has ".scalar(keys %{base_controller->config}));
+
+ok( scalar(keys %{controller_a->config}) == 2, 'controller_a has the expected number of config values') or
+ diag("controller_a should have 2 config value, but it has ".scalar(keys %{base_controller->config}));
+
+ok( scalar(keys %{controller_b->config}) == 2, 'controller_b has the expected number of config values') or
+ diag("controller_a should have 2 config value, but it has ".scalar(keys %{base_controller->config}));
use warnings;
use Test::More;
-\r
-my @tests = (\r
- {\r
- given => [ { a => 1 }, { b => 1 } ],\r
- expects => { a => 1, b => 1 }\r
- },\r
- {\r
- given => [ { a => 1 }, { a => { b => 1 } } ],\r
- expects => { a => { b => 1 } }\r
- },\r
- {\r
- given => [ { a => { b => 1 } }, { a => 1 } ],\r
- expects => { a => 1 }\r
- },\r
- {\r
- given => [ { a => 1 }, { a => [ 1 ] } ],\r
- expects => { a => [ 1 ] }\r
- },\r
- {\r
- given => [ { a => [ 1 ] }, { a => 1 } ],\r
- expects => { a => 1 }\r
- },\r
- {\r
- given => [ { a => { b => 1 } }, { a => { b => 2 } } ],\r
- expects => { a => { b => 2 } }\r
- },\r
- {\r
- given => [ { a => { b => 1 } }, { a => { c => 1 } } ],\r
- expects => { a => { b => 1, c => 1 } }\r
- },\r
-);\r
+
+my @tests = (
+ {
+ given => [ { a => 1 }, { b => 1 } ],
+ expects => { a => 1, b => 1 }
+ },
+ {
+ given => [ { a => 1 }, { a => { b => 1 } } ],
+ expects => { a => { b => 1 } }
+ },
+ {
+ given => [ { a => { b => 1 } }, { a => 1 } ],
+ expects => { a => 1 }
+ },
+ {
+ given => [ { a => 1 }, { a => [ 1 ] } ],
+ expects => { a => [ 1 ] }
+ },
+ {
+ given => [ { a => [ 1 ] }, { a => 1 } ],
+ expects => { a => 1 }
+ },
+ {
+ given => [ { a => { b => 1 } }, { a => { b => 2 } } ],
+ expects => { a => { b => 2 } }
+ },
+ {
+ given => [ { a => { b => 1 } }, { a => { c => 1 } } ],
+ expects => { a => { b => 1, c => 1 } }
+ },
+);
plan tests => scalar @tests + 1;
use_ok('Catalyst');
-for my $test ( @ tests ) {\r
- is_deeply( Catalyst->merge_config_hashes( @{ $test->{ given } } ), $test->{ expects } );\r
-}\r
+for my $test ( @ tests ) {
+ is_deeply( Catalyst->merge_config_hashes( @{ $test->{ given } } ), $test->{ expects } );
+}
#checking @args passed to ACCEPT_CONTEXT
my $args;
{
- no warnings;
- *MyApp::Model::M::ACCEPT_CONTEXT = sub { my ($self, $c, @args) = @_; $args= \@args};
- *MyApp::View::V::ACCEPT_CONTEXT = sub { my ($self, $c, @args) = @_; $args= \@args};
+ no warnings;
+ *MyApp::Model::M::ACCEPT_CONTEXT = sub { my ($self, $c, @args) = @_; $args= \@args};
+ *MyApp::View::V::ACCEPT_CONTEXT = sub { my ($self, $c, @args) = @_; $args= \@args};
}
MyApp->model('M', qw/foo bar/);
is_deeply($args, [qw/foo bar/], '$c->model args passed to ACCEPT_CONTEXT ok');
my $os = $non_unix{$^O} ? $^O : 'Unix';
if( $os ne 'Unix' ) {
- plan skip_all => 'tests require Unix';
+ plan skip_all => 'tests require Unix';
}
else {
- plan tests => 3;
+ plan tests => 3;
}
use_ok('Catalyst');
-#!perl\r
-\r
-use strict;\r
-use warnings;\r
-\r
-use Test::More;\r
-\r
-plan tests => 3;\r
-\r
-use_ok('Catalyst::Test');\r
-\r
-eval "get('http://localhost')";\r
-isnt( $@, "", "get returns an error message with no app specified");\r
-\r
-eval "request('http://localhost')";\r
-isnt( $@, "", "request returns an error message with no app specified");\r
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+plan tests => 3;
+
+use_ok('Catalyst::Test');
+
+eval "get('http://localhost')";
+isnt( $@, "", "get returns an error message with no app specified");
+
+eval "request('http://localhost')";
+isnt( $@, "", "request returns an error message with no app specified");
projects / catagits/Catalyst-Runtime.git / commitdiff