[Catalyst-commits] r7456 - in trunk: . Catalyst-Engine-HTTP-Prefork
Catalyst-Engine-HTTP-Prefork/lib
Catalyst-Engine-HTTP-Prefork/lib/Catalyst
Catalyst-Engine-HTTP-Prefork/lib/Catalyst/Engine
Catalyst-Engine-HTTP-Prefork/lib/Catalyst/Engine/HTTP
Catalyst-Engine-HTTP-Prefork/lib/Catalyst/Engine/HTTP/Prefork
Catalyst-Engine-HTTP-Prefork/t
andyg at dev.catalyst.perl.org
andyg at dev.catalyst.perl.org
Sat Feb 23 16:37:49 GMT 2008
Author: andyg
Date: 2008-02-23 16:37:48 +0000 (Sat, 23 Feb 2008)
New Revision: 7456
Added:
trunk/Catalyst-Engine-HTTP-Prefork/
trunk/Catalyst-Engine-HTTP-Prefork/Changes
trunk/Catalyst-Engine-HTTP-Prefork/MANIFEST.SKIP
trunk/Catalyst-Engine-HTTP-Prefork/Makefile.PL
trunk/Catalyst-Engine-HTTP-Prefork/lib/
trunk/Catalyst-Engine-HTTP-Prefork/lib/Catalyst/
trunk/Catalyst-Engine-HTTP-Prefork/lib/Catalyst/Engine/
trunk/Catalyst-Engine-HTTP-Prefork/lib/Catalyst/Engine/HTTP/
trunk/Catalyst-Engine-HTTP-Prefork/lib/Catalyst/Engine/HTTP/Prefork.pm
trunk/Catalyst-Engine-HTTP-Prefork/lib/Catalyst/Engine/HTTP/Prefork/
trunk/Catalyst-Engine-HTTP-Prefork/lib/Catalyst/Engine/HTTP/Prefork/Handler.pm
trunk/Catalyst-Engine-HTTP-Prefork/t/
trunk/Catalyst-Engine-HTTP-Prefork/t/01use.t
trunk/Catalyst-Engine-HTTP-Prefork/t/02pod.t
trunk/Catalyst-Engine-HTTP-Prefork/t/03podcoverage.t
trunk/Catalyst-Engine-HTTP-Prefork/t/04critic.rc
trunk/Catalyst-Engine-HTTP-Prefork/t/04critic.t
trunk/Catalyst-Engine-HTTP-Prefork/t/catalyst_130pix.gif
trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_action.t
trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_auto.t
trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_begin.t
trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_chained.t
trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_default.t
trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_detach.t
trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_end.t
trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_forward.t
trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_global.t
trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_index.t
trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_inheritance.t
trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_local.t
trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_multipath.t
trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_path.t
trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_private.t
trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_regexp.t
trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_streaming.t
trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_args.t
trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_request_body.t
trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_request_body_demand.t
trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_request_cookies.t
trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_request_headers.t
trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_request_parameters.t
trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_request_uploads.t
trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_request_uri.t
trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_response_cookies.t
trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_response_errors.t
trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_response_headers.t
trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_response_large.t
trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_response_redirect.t
trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_response_status.t
trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_setup_basics.t
trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_setup_plugins.t
trunk/Catalyst-Engine-HTTP-Prefork/t/live_fork.t
trunk/Catalyst-Engine-HTTP-Prefork/t/live_loop.t
trunk/Catalyst-Engine-HTTP-Prefork/t/live_plugin_loaded.t
trunk/Catalyst-Engine-HTTP-Prefork/t/live_priorities.t
trunk/Catalyst-Engine-HTTP-Prefork/t/live_recursion.t
trunk/Catalyst-Engine-HTTP-Prefork/t/live_stats.t
trunk/Catalyst-Engine-HTTP-Prefork/t/optional_prefork-server.t
trunk/Catalyst-Engine-HTTP-Prefork/t/testapp_prefork.pl
Log:
HTTP::Prefork engine, high performance engine using Net::Server::PreFork, XS header parsing, HTTP/1.1 support (keep-alive, pipelined requests, chunked requests/responses)
Added: trunk/Catalyst-Engine-HTTP-Prefork/Changes
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/Changes (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/Changes 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,4 @@
+This file documents the revision history for Catalyst::Engine::HTTP::Prefork.
+
+0.01
+ - Initial release.
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/Changes
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/MANIFEST.SKIP
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/MANIFEST.SKIP (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/MANIFEST.SKIP 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,28 @@
+# Avoid version control files.
+\bRCS\b
+\bCVS\b
+,v$
+\B\.svn\b
+
+# Avoid Makemaker generated and utility files.
+\bMakefile$
+\bblib
+\bMakeMaker-\d
+\bpm_to_blib$
+\bblibdirs$
+^MANIFEST\.SKIP$
+
+# Avoid Module::Build generated and utility files.
+\bBuild$
+\b_build
+
+# Avoid temp and backup files.
+~$
+\.tmp$
+\.old$
+\.bak$
+\#$
+\b\.#
+
+# Mac files
+\.DS_Store
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/MANIFEST.SKIP
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/Makefile.PL
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/Makefile.PL (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/Makefile.PL 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,15 @@
+use inc::Module::Install 0.65;
+
+name 'Catalyst-Engine-HTTP-Prefork';
+all_from 'lib/Catalyst/Engine/HTTP/Prefork.pm';
+
+requires 'Catalyst::Runtime' => '5.7012';
+requires 'HTTP::Body' => '1.01';
+requires 'Net::Server' => '0.97';
+# XXX: not released and may change namespaces
+requires 'Perlbal::XS::HTTPHeaders' => '0.20';
+
+tests 't/0*.t';
+
+auto_install;
+WriteAll;
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/Makefile.PL
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/lib/Catalyst/Engine/HTTP/Prefork/Handler.pm
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/lib/Catalyst/Engine/HTTP/Prefork/Handler.pm (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/lib/Catalyst/Engine/HTTP/Prefork/Handler.pm 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,197 @@
+package Catalyst::Engine::HTTP::Prefork::Handler;
+
+use strict;
+use base 'Catalyst::Engine::CGI';
+
+use Data::Dump qw(dump);
+use HTTP::Body;
+use HTTP::Date qw(time2str);
+use HTTP::Headers;
+use HTTP::Status qw(status_message);
+
+use constant DEBUG => $ENV{CATALYST_PREFORK_DEBUG} || 0;
+use constant CHUNKSIZE => 64 * 1024;
+
+sub new {
+ my ( $class, $server ) = @_;
+
+ bless {
+ client => {},
+ server => $server,
+ }, $class;
+}
+
+sub prepare_request {
+ my ( $self, $c, $client ) = @_;
+
+ $self->{client} = $client;
+}
+
+sub prepare_headers {
+ my ( $self, $c ) = @_;
+
+ # Save time by not bothering to stuff headers in %ENV
+ $c->req->headers(
+ HTTP::Headers->new( %{ $self->{client}->{headers} } )
+ );
+}
+
+# We need to override prepare_body for chunked request support.
+# This should probably move to Catalyst at some point.
+sub prepare_body {
+ my ( $self, $c ) = @_;
+
+ my $te = $c->request->header('Transfer-Encoding');
+
+ if ( $te && $te =~ /^chunked$/i ) {
+ DEBUG && warn "[$$] Body data is chunked\n";
+ $self->{_chunked_req} = 1;
+ }
+ else {
+ # We can use the normal prepare_body method for a non-chunked body
+ return $self->SUPER::prepare_body( $c );
+ }
+
+ unless ( $c->request->{_body} ) {
+ my $type = $c->request->header('Content-Type');
+ # with no length, HTTP::Body 1.00+ will treat the content
+ # as chunked
+ $c->request->{_body} = HTTP::Body->new( $type );
+ $c->request->{_body}->{tmpdir} = $c->config->{uploadtmp}
+ if exists $c->config->{uploadtmp};
+ }
+
+ while ( my $buffer = $self->read($c) ) {
+ $c->prepare_body_chunk($buffer);
+ }
+
+ $self->finalize_read($c);
+}
+
+sub read {
+ my ( $self, $c, $maxlength ) = @_;
+
+ # If the request is not chunked, we can use the normal read method
+ if ( !$self->{_chunked_req} ) {
+ return $self->SUPER::read( $c, $maxlength );
+ }
+
+ # If HTTP::Body says we're done, don't read
+ if ( $c->request->{_body}->state eq 'done' ) {
+ return;
+ }
+
+ my $rc = $self->read_chunk( $c, my $buffer, CHUNKSIZE );
+ if ( defined $rc ) {
+ return $buffer;
+ }
+ else {
+ Catalyst::Exception->throw(
+ message => "Unknown error reading input: $!" );
+ }
+}
+
+sub read_chunk {
+ my $self = shift;
+ my $c = shift;
+
+ my $read;
+
+ # If we have any remaining data in the input buffer, send it back first
+ if ( $_[0] = $self->{client}->{inputbuf} ) {
+ $read = length( $_[0] );
+ $self->{client}->{inputbuf} = '';
+ DEBUG && warn "[$$] read_chunk: Read $read bytes from previous input buffer: " . dump($_[0]) . "\n";
+ }
+ else {
+ $read = $self->SUPER::read_chunk( $c, @_ );
+ DEBUG && warn "[$$] read_chunk: Read $read bytes from STDIN: " . dump($_[0]) . "\n";
+ }
+
+ return $read;
+}
+
+sub finalize_read {
+ my ( $self, $c ) = @_;
+
+ delete $self->{_chunked_req};
+
+ return $self->SUPER::finalize_read( $c );
+}
+
+sub finalize_headers {
+ my ( $self, $c ) = @_;
+
+ my $protocol = $c->request->protocol;
+ my $status = $c->response->status;
+ my $message = status_message($status);
+
+ my @headers;
+ push @headers, "$protocol $status $message";
+
+ # Switch on Transfer-Encoding: chunked if we don't know Content-Length.
+ if ( $protocol eq 'HTTP/1.1' && !$c->response->content_length ) {
+ if ( $c->response->status !~ /^1\d\d|[23]04$/ ) {
+ DEBUG && warn "[$$] Using chunked transfer-encoding to send unknown length body\n";
+ $c->response->header( 'Transfer-Encoding' => 'chunked' );
+ $self->{_chunked_res} = 1;
+ }
+ }
+
+ if ( !$c->response->header('Date') ) {
+ $c->response->header( Date => time2str( time() ) );
+ }
+
+ $c->response->header( Status => $c->response->status );
+
+ # Should we keep the connection open?
+ if ( $self->{client}->{keepalive} ) {
+ $c->response->headers->header( Connection => 'keep-alive' );
+ }
+ else {
+ $c->response->headers->header( Connection => 'close' );
+ }
+
+ push @headers, $c->response->headers->as_string("\x0D\x0A");
+
+ # Buffer the headers so they are sent with the first write() call
+ # This reduces the number of TCP packets we are sending
+ $self->{_header_buf} = join("\x0D\x0A", @headers, '');
+}
+
+sub finalize_body {
+ my ( $self, $c ) = @_;
+
+ $self->SUPER::finalize_body( $c );
+
+ if ( $self->{_chunked_res} ) {
+ if ( !$self->{_chunked_done} ) {
+ # Write the final '0' chunk
+ syswrite STDOUT, "0\x0D\x0A";
+ }
+
+ delete $self->{_chunked_res};
+ delete $self->{_chunked_done};
+ }
+}
+
+sub write {
+ my ( $self, $c, $buffer ) = @_;
+
+ if ( $self->{_chunked_res} ) {
+ my $len = length($buffer);
+
+ $buffer = sprintf( "%x", $len ) . "\x0D\x0A" . $buffer . "\x0D\x0A";
+
+ # Flag if we wrote an empty chunk
+ if ( !$len ) {
+ $self->{_chunked_done} = 1;
+ }
+ }
+
+ DEBUG && warn "[$$] Wrote " . length($buffer) . " bytes\n";
+
+ $self->SUPER::write( $c, $buffer );
+}
+
+1;
\ No newline at end of file
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/lib/Catalyst/Engine/HTTP/Prefork/Handler.pm
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/lib/Catalyst/Engine/HTTP/Prefork.pm
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/lib/Catalyst/Engine/HTTP/Prefork.pm (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/lib/Catalyst/Engine/HTTP/Prefork.pm 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,255 @@
+package Catalyst::Engine::HTTP::Prefork;
+
+use strict;
+use base 'Net::Server::PreFork';
+
+use Catalyst::Engine::HTTP::Prefork::Handler;
+
+use Data::Dump qw(dump);
+use HTTP::Response;
+use HTTP::Status qw(status_message);
+use IO::Select;
+use Perlbal::XS::HTTPHeaders;
+use Perlbal::HTTPHeaders;
+use Socket;
+
+use constant DEBUG => $ENV{CATALYST_PREFORK_DEBUG} || 0;
+use constant CHUNKSIZE => 64 * 1024;
+use constant READ_TIMEOUT => 5;
+
+sub run {
+ my ( $self, $class, $port, $host, $options ) = @_;
+
+ $self->{appclass} = $class;
+ $self->{options} = $options || {};
+ $self->{env} = \%ENV;
+
+ # Change the Catalyst Engine class to our engine handler
+ my $engine = Catalyst::Engine::HTTP::Prefork::Handler->new( $self->{server} );
+ $self->{appclass}->engine( $engine );
+
+ $self->SUPER::run(
+ port => $port || 3000,
+ host => $host || '*',
+ serialize => 'flock',
+ log_level => DEBUG ? 4 : 1,
+ # XXX: allow customizing of prefork settings
+ );
+}
+
+sub pre_loop_hook {
+ my $self = shift;
+
+ my $host = $self->{server}->{host}->[0];
+ my $port = $self->{server}->{port}->[0];
+
+ my $addr = $host ne '*' ? inet_aton($host) : INADDR_ANY;
+ if ( $addr eq INADDR_ANY ) {
+ require Sys::Hostname;
+ $host = lc Sys::Hostname::hostname();
+ }
+ else {
+ $host = gethostbyaddr( $addr, AF_INET ) || inet_ntoa($addr);
+ }
+
+ my $url = "http://$host";
+ $url .= ":$port" unless $port == 80;
+
+ print "You can connect to your server at $url\n";
+}
+
+# The below methods run in the child process
+
+sub post_accept_hook {
+ my $self = shift;
+
+ $self->{client} = {
+ headerbuf => '',
+ inputbuf => '',
+ keepalive => 1,
+ };
+}
+
+sub process_request {
+ my $self = shift;
+ my $conn = $self->{server}->{client};
+
+ while ( $self->{client}->{keepalive} ) {
+ last if !$conn->connected;
+
+ # Read until we see all headers
+ last if !$self->_read_headers;
+
+ # Parse headers
+ my $h = Perlbal::XS::HTTPHeaders->new( \delete $self->{client}->{headerbuf} );
+
+ if ( !$h ) {
+ # Bad request
+ DEBUG && warn "[$$] Bad request\n";
+ $self->_http_error(400);
+ last;
+ }
+
+ # Initialize CGI environment
+ my $uri = $h->request_uri();
+ my ( $path, $query_string ) = split /\?/, $uri, 2;
+
+ my $version = $h->version_number();
+ my $proto = sprintf( "HTTP/%d.%d", int( $version / 1000 ), $version % 1000 );
+
+ local %ENV = (
+ PATH_INFO => $path || '',
+ QUERY_STRING => $query_string || '',
+ REMOTE_ADDR => $self->{server}->{peeraddr},
+ REMOTE_HOST => $self->{server}->{peerhost} || $self->{server}->{peeraddr},
+ REQUEST_METHOD => $h->request_method() || '',
+ SERVER_NAME => $self->{server}->{sockaddr}, # XXX: needs to be resolved?
+ SERVER_PORT => $self->{server}->{port}->[0],
+ SERVER_PROTOCOL => $proto,
+ %{ $self->{env} },
+ );
+
+ # Add headers
+ my $headers = $h->getHeaders();
+ $self->{client}->{headers} = $headers;
+
+ # prepare_connection and prepare_path need a few headers in %ENV
+ $ENV{HTTP_X_FORWARDED_FOR} = $headers->{'X-Forwarded-For'}
+ if $headers->{'X-Forwarded-For'};
+ $ENV{HTTP_X_FORWARDED_HOST} = $headers->{'X-Forwarded-Host'}
+ if $headers->{'X-Forwarded-Host'};
+ $ENV{HTTP_HOST} = $headers->{Host}
+ if $headers->{Host};
+
+ # Determine whether we will keep the connection open after the request
+ my $connection = $headers->{Connection};
+ if ( $proto && $proto eq 'HTTP/1.0' ) {
+ if ( $connection && $connection =~ /^keep-alive$/i ) {
+ # Keep-alive only with explicit header in HTTP/1.0
+ $self->{client}->{keepalive} = 1;
+ }
+ else {
+ $self->{client}->{keepalive} = 0;
+ }
+ }
+ elsif ( $proto && $proto eq 'HTTP/1.1' ) {
+ if ( $connection && $connection =~ /^close$/i ) {
+ $self->{client}->{keepalive} = 0;
+ }
+ else {
+ # Keep-alive assumed in HTTP/1.1
+ $self->{client}->{keepalive} = 1;
+ }
+ }
+
+ # Pass flow control to Catalyst
+ $self->{appclass}->handle_request( $self->{client} );
+
+ DEBUG && warn "[$$] Request done\n";
+
+ if ( $self->{client}->{keepalive} ) {
+ # If we still have data in the input buffer it may be a pipelined request
+ if ( $self->{client}->{inputbuf} ) {
+ if ( $self->{client}->{inputbuf} =~ /^(?:GET|HEAD)/ ) {
+ if ( DEBUG ) {
+ warn "Pipelined GET/HEAD request in input buffer: "
+ . dump( $self->{client}->{inputbuf} ) . "\n";
+ }
+
+ # Continue processing the input buffer
+ next;
+ }
+ else {
+ # Input buffer just has junk, clear it
+ if ( DEBUG ) {
+ warn "Clearing junk from input buffer: "
+ . dump( $self->{client}->{inputbuf} ) . "\n";
+ }
+
+ $self->{client}->{inputbuf} = '';
+ }
+ }
+
+ DEBUG && warn "[$$] Waiting on previous connection for keep-alive request...\n";
+
+ my $sel = IO::Select->new($conn);
+ last unless $sel->can_read(1);
+ }
+ }
+
+ DEBUG && warn "[$$] Closing connection\n";
+}
+
+sub _read_headers {
+ my $self = shift;
+
+ eval {
+ local $SIG{ALRM} = sub { die "Timed out\n"; };
+
+ my $previous_alarm = alarm( READ_TIMEOUT );
+
+ while (1) {
+ # Do we have a full header in the buffer?
+ # This is before sysread so we don't read if we have a pipelined request
+ # waiting in the buffer
+ last if $self->{client}->{inputbuf} =~ /(\x0D\x0A?\x0D\x0A?|\x0A\x0D?\x0A\x0D?)/s;
+
+ # If not, read some data
+ my $read = sysread STDIN, my $buf, CHUNKSIZE;
+
+ if ( !defined $read || $read == 0 ) {
+ die "Read error\n";
+ }
+
+ if ( DEBUG ) {
+ warn "[$$] Read $read bytes: " . dump($buf) . "\n";
+ }
+
+ $self->{client}->{inputbuf} .= $buf;
+ }
+
+ alarm( $previous_alarm );
+ };
+
+ if ( $@ =~ /Timed out/ ) {
+ DEBUG && warn "[$$] Client connection timed out\n";
+ return;
+ }
+
+ if ( $@ =~ /Read error/ ) {
+ DEBUG && warn "[$$] Read error: $!\n";
+ return;
+ }
+
+ # Pull out the complete header into a new buffer
+ $self->{client}->{headerbuf} = $self->{client}->{inputbuf};
+
+ # Save any left-over data, possibly body data or pipelined requests
+ $self->{client}->{inputbuf} =~ s/.*?(\x0D\x0A?\x0D\x0A?|\x0A\x0D?\x0A\x0D?)//s;
+
+ return 1;
+}
+
+sub _http_error {
+ my ( $self, $code, $reason ) = @_;
+
+ my $status = $code || 500;
+ my $message = status_message($status);
+ my $response = HTTP::Response->new( $status => $message );
+ $response->protocol( 'HTTP/1.0' );
+ $response->content_type( 'text/plain' );
+ $response->header( Connection => 'close' );
+ $response->date( time() );
+
+ if ( !$reason ) {
+ $reason = $message;
+ }
+
+ $response->content( "$status $reason" );
+
+ syswrite STDOUT, $response->as_string("\x0D\x0A");
+}
+
+1;
+__END__
+
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/lib/Catalyst/Engine/HTTP/Prefork.pm
___________________________________________________________________
Name: svn:keywords
+ Id
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t
___________________________________________________________________
Name: svn:externals
+ lib http://dev.catalyst.perl.org/repos/Catalyst/Catalyst-Runtime/5.70/trunk/t/lib
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/01use.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/01use.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/01use.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,3 @@
+use Test::More tests => 1;
+
+use_ok('Catalyst::Engine::HTTP::Prefork');
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/01use.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/02pod.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/02pod.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/02pod.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,7 @@
+use Test::More;
+
+eval "use Test::Pod 1.14";
+plan skip_all => 'Test::Pod 1.14 required' if $@;
+plan skip_all => 'set TEST_POD to enable this test' unless $ENV{TEST_POD};
+
+all_pod_files_ok();
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/02pod.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/03podcoverage.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/03podcoverage.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/03podcoverage.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,7 @@
+use Test::More;
+
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all => 'Test::Pod::Coverage 1.04 required' if $@;
+plan skip_all => 'set TEST_POD to enable this test' unless $ENV{TEST_POD};
+
+all_pod_coverage_ok();
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/03podcoverage.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/04critic.rc
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/04critic.rc (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/04critic.rc 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,5 @@
+include = CodeLayout::ProhibitHardTabs
+only = 1
+
+[CodeLayout::ProhibitHardTabs]
+allow_leading_tabs = 0
\ No newline at end of file
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/04critic.rc
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/04critic.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/04critic.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/04critic.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,22 @@
+use strict;
+use warnings;
+
+use File::Spec;
+use FindBin ();
+use Test::More;
+
+if ( !-e "$FindBin::Bin/../MANIFEST.SKIP" ) {
+ plan skip_all => 'Critic test only for developers.';
+}
+else {
+ eval { require Test::Perl::Critic };
+ if ( $@ ) {
+ plan tests => 1;
+ fail( 'You must install Test::Perl::Critic to run 04critic.t' );
+ exit;
+ }
+}
+
+my $rcfile = File::Spec->catfile( 't', '04critic.rc' );
+Test::Perl::Critic->import( -profile => $rcfile );
+all_critic_ok();
\ No newline at end of file
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/04critic.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/catalyst_130pix.gif
===================================================================
(Binary files differ)
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/catalyst_130pix.gif
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_action.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_action.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_action.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,110 @@
+#!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 => 28 * $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 {
+ {
+ ok( my $response = request('http://localhost/action_action_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_action_one', 'Test Action' );
+ is(
+ $response->header('X-Test-Class'),
+ 'TestApp::Controller::Action::Action',
+ 'Test Class'
+ );
+ is( $response->header('X-Action'), 'works' );
+ like(
+ $response->content,
+ qr/^bless\( .* 'Catalyst::Request' \)$/s,
+ 'Content is a serialized Catalyst::Request'
+ );
+ }
+
+ {
+ ok( my $response = request('http://localhost/action_action_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_action_two', 'Test Action' );
+ is(
+ $response->header('X-Test-Class'),
+ 'TestApp::Controller::Action::Action',
+ 'Test Class'
+ );
+ is( $response->header('X-Action-After'), 'awesome' );
+ like(
+ $response->content,
+ qr/^bless\( .* 'Catalyst::Request' \)$/s,
+ 'Content is a serialized Catalyst::Request'
+ );
+ }
+
+ {
+ ok(
+ my $response =
+ request('http://localhost/action_action_three/one/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_action_three', 'Test Action' );
+ is(
+ $response->header('X-Test-Class'),
+ 'TestApp::Controller::Action::Action',
+ 'Test Class'
+ );
+ is( $response->header('X-TestAppActionTestBefore'), 'one' );
+ like(
+ $response->content,
+ qr/^bless\( .* 'Catalyst::Request' \)$/s,
+ 'Content is a serialized Catalyst::Request'
+ );
+ }
+
+ {
+ ok( my $response = request('http://localhost/action_action_four'),
+ 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is( $response->header('X-Catalyst-Action'),
+ 'action_action_four', 'Test Action' );
+ is(
+ $response->header('X-Test-Class'),
+ 'TestApp::Controller::Action::Action',
+ 'Test Class'
+ );
+ is( $response->header('X-TestAppActionTestMyAction'), 'MyAction works' );
+ like(
+ $response->content,
+ qr/^bless\( .* 'Catalyst::Request' \)$/s,
+ 'Content is a serialized Catalyst::Request'
+ );
+ }
+
+}
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_action.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_auto.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_auto.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_auto.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,136 @@
+#!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 );
+
+ # new dispatcher:
+ # 11 wallclock secs (10.14 usr + 0.20 sys = 10.34 CPU) @ 15.18/s (n=157)
+ # old dispatcher (r1486):
+ # 11 wallclock secs (10.34 usr + 0.20 sys = 10.54 CPU) @ 13.76/s (n=145)
+}
+else {
+ for ( 1 .. $iters ) {
+ run_tests();
+ }
+}
+
+sub run_tests {
+ # test auto + local method
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Auto->begin
+ TestApp::Controller::Action::Auto->auto
+ TestApp::Controller::Action::Auto->one
+ TestApp->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/action/auto/one'), 'auto + local' );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, 'one', 'Content OK' );
+ }
+
+ # test auto + default
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Auto->begin
+ TestApp::Controller::Action::Auto->auto
+ TestApp::Controller::Action::Auto->default
+ TestApp->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/action/auto/anything'), 'auto + default' );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, 'default', 'Content OK' );
+ }
+
+ # test auto + auto + local
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Auto::Deep->begin
+ TestApp::Controller::Action::Auto->auto
+ TestApp::Controller::Action::Auto::Deep->auto
+ TestApp::Controller::Action::Auto::Deep->one
+ TestApp->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/action/auto/deep/one'), 'auto + auto + local' );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, 'deep one', 'Content OK' );
+ }
+
+ # test auto + auto + default
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Auto::Deep->begin
+ TestApp::Controller::Action::Auto->auto
+ TestApp::Controller::Action::Auto::Deep->auto
+ TestApp::Controller::Action::Auto::Deep->default
+ TestApp->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/action/auto/deep/anything'), 'auto + auto + default' );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, 'deep default', 'Content OK' );
+ }
+
+ # test auto + failing auto + local + end
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Auto::Abort->begin
+ TestApp::Controller::Action::Auto->auto
+ TestApp::Controller::Action::Auto::Abort->auto
+ TestApp::Controller::Action::Auto::Abort->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/action/auto/abort/one'), 'auto + failing auto + local' );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, 'abort end', 'Content OK' );
+ }
+
+ # test auto + default (bug on invocation of default twice)
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Auto::Default->begin
+ TestApp::Controller::Action::Auto->auto
+ TestApp::Controller::Action::Auto::Default->auto
+ TestApp::Controller::Action::Auto::Default->default
+ TestApp::Controller::Action::Auto::Default->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/action/auto/default/moose'), 'auto + default' );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, 'default (auto: 1)', 'Content OK' );
+ }
+}
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_auto.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_begin.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_begin.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_begin.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,53 @@
+#!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 => 7*$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::Begin->begin
+ TestApp::Controller::Action::Begin->default
+ TestApp::View::Dump::Request->process
+ TestApp->end
+ ];
+
+ 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/'Catalyst::Request'/,
+ 'Content is a serialized Catalyst::Request' );
+ }
+}
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_begin.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_chained.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_chained.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_chained.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,866 @@
+#!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 => 124*$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 ($run_number) = @_;
+
+ #
+ # This is a simple test where the parent and child actions are
+ # within the same controller.
+ #
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Chained->begin
+ TestApp::Controller::Action::Chained->foo
+ TestApp::Controller::Action::Chained->endpoint
+ TestApp::Controller::Action::Chained->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/chained/foo/1/end/2'), 'chained + local endpoint' );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, '1; 2', 'Content OK' );
+ }
+
+ #
+ # This makes sure the above isn't found if the argument for the
+ # end action isn't supplied.
+ #
+ {
+ my $expected = undef;
+
+ ok( my $response = request('http://localhost/chained/foo/1/end'),
+ 'chained + local endpoint; missing last argument' );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->code, 500, 'Status OK' );
+ }
+
+ #
+ # Tests the case when the child action is placed in a subcontroller.
+ #
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Chained->begin
+ TestApp::Controller::Action::Chained->foo
+ TestApp::Controller::Action::Chained::Foo->spoon
+ TestApp::Controller::Action::Chained->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/chained/foo/1/spoon'), 'chained + subcontroller endpoint' );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, '1; ', 'Content OK' );
+ }
+
+ #
+ # Tests if the relative specification (e.g.: Chained('bar') ) works
+ # as expected.
+ #
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Chained->begin
+ TestApp::Controller::Action::Chained->bar
+ TestApp::Controller::Action::Chained->finale
+ TestApp::Controller::Action::Chained->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/chained/bar/1/spoon'), 'chained + relative endpoint' );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, '; 1, spoon', 'Content OK' );
+ }
+
+ #
+ # Just a test for multiple arguments.
+ #
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Chained->begin
+ TestApp::Controller::Action::Chained->foo2
+ TestApp::Controller::Action::Chained->endpoint2
+ TestApp::Controller::Action::Chained->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/chained/foo2/10/20/end2/15/25'),
+ 'chained + local (2 args each)' );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, '10, 20; 15, 25', 'Content OK' );
+ }
+
+ #
+ # The first three-chain test tries to call the action with :Args(1)
+ # specification. There's also a one action with a :CaptureArgs(1)
+ # attribute, that should not be dispatched to.
+ #
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Chained->begin
+ TestApp::Controller::Action::Chained->one_end
+ TestApp::Controller::Action::Chained->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/chained/one/23'),
+ 'three-chain (only first)' );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, '; 23', 'Content OK' );
+ }
+
+ #
+ # This is the second three-chain test, it goes for the action that
+ # handles "/one/$cap/two/$arg1/$arg2" paths. Should be the two action
+ # having :Args(2), not the one having :CaptureArgs(2).
+ #
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Chained->begin
+ TestApp::Controller::Action::Chained->one
+ TestApp::Controller::Action::Chained->two_end
+ TestApp::Controller::Action::Chained->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/chained/one/23/two/23/46'),
+ 'three-chain (up to second)' );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, '23; 23, 46', 'Content OK' );
+ }
+
+ #
+ # Last of the three-chain tests. Has no concurrent action with :CaptureArgs
+ # and is more thought to simply test the chain as a whole and the 'two'
+ # action specifying :CaptureArgs.
+ #
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Chained->begin
+ TestApp::Controller::Action::Chained->one
+ TestApp::Controller::Action::Chained->two
+ TestApp::Controller::Action::Chained->three_end
+ TestApp::Controller::Action::Chained->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/chained/one/23/two/23/46/three/1/2/3'),
+ 'three-chain (all three)' );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, '23, 23, 46; 1, 2, 3', 'Content OK' );
+ }
+
+ #
+ # Tests dispatching on number of arguments for :Args. This should be
+ # dispatched to the action expecting one argument.
+ #
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Chained->begin
+ TestApp::Controller::Action::Chained->multi1
+ TestApp::Controller::Action::Chained->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/chained/multi/23'),
+ 'multi-action (one arg)' );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, '; 23', 'Content OK' );
+ }
+
+ #
+ # Belongs to the former test and goes for the action expecting two arguments.
+ #
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Chained->begin
+ TestApp::Controller::Action::Chained->multi2
+ TestApp::Controller::Action::Chained->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/chained/multi/23/46'),
+ 'multi-action (two args)' );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, '; 23, 46', 'Content OK' );
+ }
+
+ #
+ # Dispatching on argument count again, this time we provide too many
+ # arguments, so dispatching should fail.
+ #
+ {
+ my $expected = undef;
+
+ ok( my $response = request('http://localhost/chained/multi/23/46/67'),
+ 'multi-action (three args, should lead to error)' );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->code, 500, 'Status OK' );
+ }
+
+ #
+ # This tests the case when an action says it's the child of an action in
+ # a subcontroller.
+ #
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Chained->begin
+ TestApp::Controller::Action::Chained::Foo->higher_root
+ TestApp::Controller::Action::Chained->higher_root
+ TestApp::Controller::Action::Chained->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/chained/higher_root/23/bar/11'),
+ 'root higher than child' );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, '23; 11', 'Content OK' );
+ }
+
+ #
+ # Just a more complex version of the former test. It tests if a controller ->
+ # subcontroller -> controller dispatch works.
+ #
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Chained->begin
+ TestApp::Controller::Action::Chained->pcp1
+ TestApp::Controller::Action::Chained::Foo->pcp2
+ TestApp::Controller::Action::Chained->pcp3
+ TestApp::Controller::Action::Chained->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/chained/pcp1/1/pcp2/2/pcp3/3'),
+ 'parent -> child -> parent' );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, '1, 2; 3', 'Content OK' );
+ }
+
+ #
+ # Tests dispatch on capture number. This test is for a one capture action.
+ #
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Chained->begin
+ TestApp::Controller::Action::Chained->multi_cap1
+ TestApp::Controller::Action::Chained->multi_cap_end1
+ TestApp::Controller::Action::Chained->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/chained/multi_cap/1/baz'),
+ 'dispatch on capture num 1' );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, '1; ', 'Content OK' );
+ }
+
+ #
+ # Belongs to the former test. This one goes for the action expecting two
+ # captures.
+ #
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Chained->begin
+ TestApp::Controller::Action::Chained->multi_cap2
+ TestApp::Controller::Action::Chained->multi_cap_end2
+ TestApp::Controller::Action::Chained->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/chained/multi_cap/1/2/baz'),
+ 'dispatch on capture num 2' );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, '1, 2; ', 'Content OK' );
+ }
+
+ #
+ # Tests the priority of a slurpy arguments action (with :Args) against
+ # two actions chained together. The two actions should win.
+ #
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Chained->begin
+ TestApp::Controller::Action::Chained->priority_a2
+ TestApp::Controller::Action::Chained->priority_a2_end
+ TestApp::Controller::Action::Chained->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/chained/priority_a/1/end/2'),
+ 'priority - slurpy args vs. parent/child' );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, '1; 2', 'Content OK' );
+ }
+
+ #
+ # This belongs to the former test but tests if two chained actions have
+ # priority over an action with the exact arguments.
+ #
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Chained->begin
+ TestApp::Controller::Action::Chained->priority_b2
+ TestApp::Controller::Action::Chained->priority_b2_end
+ TestApp::Controller::Action::Chained->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/chained/priority_b/1/end/2'),
+ 'priority - fixed args vs. parent/child' );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, '1; 2', 'Content OK' );
+ }
+
+ #
+ # This belongs to the former test but tests if two chained actions have
+ # priority over an action with one child action not having the Args() attr set.
+ #
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Chained->begin
+ TestApp::Controller::Action::Chained->priority_c1
+ TestApp::Controller::Action::Chained->priority_c2_xyz
+ TestApp::Controller::Action::Chained->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/chained/priority_c/1/xyz/'),
+ 'priority - no Args() order mismatch' );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, '1; ', 'Content OK' );
+ }
+
+ #
+ # Test dispatching between two controllers that are on the same level and
+ # therefor have no parent/child relationship.
+ #
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Chained->begin
+ TestApp::Controller::Action::Chained::Bar->cross1
+ TestApp::Controller::Action::Chained::Foo->cross2
+ TestApp::Controller::Action::Chained->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/chained/cross/1/end/2'),
+ 'cross controller w/o par/child relation' );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, '1; 2', 'Content OK' );
+ }
+
+ #
+ # This is for testing if the arguments got passed to the actions
+ # correctly.
+ #
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Chained->begin
+ TestApp::Controller::Action::Chained::PassedArgs->first
+ TestApp::Controller::Action::Chained::PassedArgs->second
+ TestApp::Controller::Action::Chained::PassedArgs->third
+ TestApp::Controller::Action::Chained::PassedArgs->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/chained/passedargs/a/1/b/2/c/3'),
+ 'Correct arguments passed to actions' );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, '1; 2; 3', 'Content OK' );
+ }
+
+ #
+ # The :Args attribute is optional, we check the action not specifying
+ # it with these tests.
+ #
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Chained->begin
+ TestApp::Controller::Action::Chained->opt_args
+ TestApp::Controller::Action::Chained->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/chained/opt_args/1/2/3'),
+ 'Optional :Args attribute working' );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, '; 1, 2, 3', 'Content OK' );
+ }
+
+ #
+ # Tests for optional PathPart attribute.
+ #
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Chained->begin
+ TestApp::Controller::Action::Chained->opt_pp_start
+ TestApp::Controller::Action::Chained->opt_pathpart
+ TestApp::Controller::Action::Chained->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/chained/optpp/1/opt_pathpart/2'),
+ 'Optional :PathName attribute working' );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, '1; 2', 'Content OK' );
+ }
+
+ #
+ # Tests for optional PathPart *and* Args attributes.
+ #
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Chained->begin
+ TestApp::Controller::Action::Chained->opt_all_start
+ TestApp::Controller::Action::Chained->oa
+ TestApp::Controller::Action::Chained->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/chained/optall/1/oa/2/3'),
+ 'Optional :PathName *and* :Args attributes working' );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, '1; 2, 3', 'Content OK' );
+ }
+
+ #
+ # Test if :Chained is the same as :Chained('/')
+ #
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Chained->begin
+ TestApp::Controller::Action::Chained->rootdef
+ TestApp::Controller::Action::Chained->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/chained/rootdef/23'),
+ ":Chained is the same as :Chained('/')" );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, '; 23', 'Content OK' );
+ }
+
+ #
+ # Test if :Chained('.') is working
+ #
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Chained->begin
+ TestApp::Controller::Action::Chained->parentchain
+ TestApp::Controller::Action::Chained::ParentChain->child
+ TestApp::Controller::Action::Chained->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/chained/parentchain/1/child/2'),
+ ":Chained('.') chains to parent controller action" );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, '1; 2', 'Content OK' );
+ }
+
+ #
+ # Test behaviour of auto actions returning '1' for the chain.
+ #
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Chained->begin
+ TestApp::Controller::Action::Chained::Auto->auto
+ TestApp::Controller::Action::Chained::Auto::Foo->auto
+ TestApp::Controller::Action::Chained::Auto->foo
+ TestApp::Controller::Action::Chained::Auto::Foo->fooend
+ TestApp::Controller::Action::Chained->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/chained/autochain1/1/fooend/2'),
+ "Behaviour when auto returns 1 correct" );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, '1; 2', 'Content OK' );
+ }
+
+ #
+ # Test behaviour of auto actions returning '0' for the chain.
+ #
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Chained->begin
+ TestApp::Controller::Action::Chained::Auto->auto
+ TestApp::Controller::Action::Chained::Auto::Bar->auto
+ TestApp::Controller::Action::Chained->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/chained/autochain2/1/barend/2'),
+ "Behaviour when auto returns 0 correct" );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, '1; 2', 'Content OK' );
+ }
+
+ #
+ # Test what auto actions are run when namespaces are changed
+ # horizontally.
+ #
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Chained->begin
+ TestApp::Controller::Action::Chained::Auto->auto
+ TestApp::Controller::Action::Chained::Auto::Foo->auto
+ TestApp::Controller::Action::Chained::Auto::Bar->crossloose
+ TestApp::Controller::Action::Chained::Auto::Foo->crossend
+ TestApp::Controller::Action::Chained->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/chained/auto_cross/1/crossend/2'),
+ "Correct auto actions are run on cross controller dispatch" );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, '1; 2', 'Content OK' );
+ }
+
+ #
+ # Test forwarding from auto action in chain dispatch.
+ #
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Chained->begin
+ TestApp::Controller::Action::Chained::Auto->auto
+ TestApp::Controller::Action::Chained::Auto::Forward->auto
+ TestApp::Controller::Action::Chained::Auto->fw3
+ TestApp::Controller::Action::Chained::Auto->fw1
+ TestApp::Controller::Action::Chained::Auto::Forward->forwardend
+ TestApp::Controller::Action::Chained->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/chained/auto_forward/1/forwardend/2'),
+ "Forwarding out of auto in chain" );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, '1; 2', 'Content OK' );
+ }
+
+ #
+ # Detaching out of the auto action of a chain.
+ #
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Chained->begin
+ TestApp::Controller::Action::Chained::Auto->auto
+ TestApp::Controller::Action::Chained::Auto::Detach->auto
+ TestApp::Controller::Action::Chained::Auto->fw3
+ TestApp::Controller::Action::Chained->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/chained/auto_detach/1/detachend/2'),
+ "Detaching out of auto in chain" );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, '1; 2', 'Content OK' );
+ }
+
+ #
+ # Test forwarding from auto action in chain dispatch.
+ #
+ {
+ my $expected = undef;
+
+ ok( my $response = request('http://localhost/chained/loose/23'),
+ "Loose end is not callable" );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->code, 500, 'Status OK' );
+ }
+
+ #
+ # Test forwarding out of a chain.
+ #
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Chained->begin
+ TestApp::Controller::Action::Chained->chain_fw_a
+ TestApp::Controller::Action::Chained->fw_dt_target
+ TestApp::Controller::Action::Chained->chain_fw_b
+ TestApp::Controller::Action::Chained->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/chained/chain_fw/1/end/2'),
+ "Forwarding out a chain" );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, '1; 2', 'Content OK' );
+ }
+
+ #
+ # Test detaching out of a chain.
+ #
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Chained->begin
+ TestApp::Controller::Action::Chained->chain_dt_a
+ TestApp::Controller::Action::Chained->fw_dt_target
+ TestApp::Controller::Action::Chained->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/chained/chain_dt/1/end/2'),
+ "Forwarding out a chain" );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, '1; 2', 'Content OK' );
+ }
+
+ #
+ # Tests that an uri_for to a chained root index action
+ # returns the right value.
+ #
+ {
+ ok( my $response = request(
+ 'http://localhost/action/chained/to_root' ),
+ 'uri_for with chained root action as arg' );
+ like( $response->content,
+ qr(URI:https?://[^/]+/),
+ 'Correct URI generated' );
+ }
+
+ #
+ # Test interception of recursive chains. This test was added because at
+ # one point during the :Chained development, Catalyst used to hang on
+ # recursive chains.
+ #
+ {
+ eval { require 'TestAppChainedRecursive.pm' };
+ if ($run_number == 1) {
+ ok( ! $@, "Interception of recursive chains" );
+ }
+ else { pass( "Interception of recursive chains already tested" ) }
+ }
+
+ #
+ # Test failure of absolute path part arguments.
+ #
+ {
+ eval { require 'TestAppChainedAbsolutePathPart.pm' };
+ if ($run_number == 1) {
+ like( $@, qr(foo/foo),
+ "Usage of absolute path part argument emits error" );
+ }
+ else { pass( "Error on absolute path part arguments already tested" ) }
+ }
+
+ #
+ # Test chained actions in the root controller
+ #
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Chained::Root->rootsub
+ TestApp::Controller::Action::Chained::Root->endpointsub
+ TestApp->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/rootsub/1/endpointsub/2'), 'chained in root namespace' );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, '', 'Content OK' );
+ }
+
+ #
+ # Complex path with multiple empty pathparts
+ #
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Chained->begin
+ TestApp::Controller::Action::Chained->mult_nopp_base
+ TestApp::Controller::Action::Chained->mult_nopp_all
+ TestApp::Controller::Action::Chained->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/chained/mult_nopp'),
+ "Complex path with multiple empty pathparts" );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, '; ', 'Content OK' );
+ }
+
+ #
+ # Higher Args() hiding more specific CaptureArgs chains sections
+ #
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Chained->begin
+ TestApp::Controller::Action::Chained->cc_base
+ TestApp::Controller::Action::Chained->cc_link
+ TestApp::Controller::Action::Chained->cc_anchor
+ TestApp::Controller::Action::Chained->end
+ ];
+
+ my $expected = join ', ', @expected;
+
+ ok( my $response = request('http://localhost/chained/choose_capture/anchor.html'),
+ 'Choose between an early Args() and a later more ideal chain' );
+ is( $response->header('X-Catalyst-Executed') => $expected, 'Executed actions');
+ is( $response->content => '; ', 'Content OK' );
+ }
+
+ #
+ # Less specific chain not being seen correctly due to earlier looser capture
+ #
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Chained->begin
+ TestApp::Controller::Action::Chained->cc_base
+ TestApp::Controller::Action::Chained->cc_b
+ TestApp::Controller::Action::Chained->cc_b_link
+ TestApp::Controller::Action::Chained->cc_b_anchor
+ TestApp::Controller::Action::Chained->end
+ ];
+
+ my $expected = join ', ', @expected;
+
+ ok( my $response = request('http://localhost/chained/choose_capture/b/a/anchor.html'),
+ 'Choose between a more specific chain and an earlier looser one' );
+ is( $response->header('X-Catalyst-Executed') => $expected, 'Executed actions');
+ is( $response->content => 'a; ', 'Content OK' );
+ }
+
+ #
+ # Check we get the looser one when it's the correct match
+ #
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Chained->begin
+ TestApp::Controller::Action::Chained->cc_base
+ TestApp::Controller::Action::Chained->cc_a
+ TestApp::Controller::Action::Chained->cc_a_link
+ TestApp::Controller::Action::Chained->cc_a_anchor
+ TestApp::Controller::Action::Chained->end
+ ];
+
+ my $expected = join ', ', @expected;
+
+ ok( my $response = request('http://localhost/chained/choose_capture/a/a/anchor.html'),
+ 'Choose between a more specific chain and an earlier looser one' );
+ is( $response->header('X-Catalyst-Executed') => $expected, 'Executed actions');
+ is( $response->content => 'a; anchor.html', 'Content OK' );
+ }
+
+ #
+ # Args(0) should win over Args() if we actually have no arguments.
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Chained->begin
+ TestApp::Controller::Action::Chained::ArgsOrder->base
+ TestApp::Controller::Action::Chained::ArgsOrder->index
+ TestApp::Controller::Action::Chained::ArgsOrder->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ # With no args, we should run "index"
+ ok( my $response = request('http://localhost/argsorder/'),
+ 'Correct arg order ran' );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, 'base; ; index; ', 'Content OK' );
+
+ # With args given, run "all"
+ ok( $response = request('http://localhost/argsorder/X'),
+ 'Correct arg order ran' );
+ is( $response->header('X-Catalyst-Executed'),
+ join(", ",
+ qw[
+ TestApp::Controller::Action::Chained->begin
+ TestApp::Controller::Action::Chained::ArgsOrder->base
+ TestApp::Controller::Action::Chained::ArgsOrder->all
+ TestApp::Controller::Action::Chained::ArgsOrder->end
+ ])
+ );
+ is( $response->content, 'base; ; all; X', 'Content OK' );
+
+ }
+
+}
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_chained.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_default.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_default.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_default.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,96 @@
+#!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 => 16 * $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::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->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'
+ );
+
+ ok( $response = request('http://localhost/foo/bar/action'), 'Request' );
+ is( $response->code, 500, 'Invalid URI returned 500' );
+ }
+
+ # test that args are passed properly to default
+ {
+ my $creq;
+ my $expected = [qw/action default arg1 arg2/];
+
+ ok( my $response = request('http://localhost/action/default/arg1/arg2'),
+ 'Request' );
+ ok(
+ eval '$creq = ' . $response->content,
+ 'Unserialize Catalyst::Request'
+ );
+ is_deeply( $creq->{arguments}, $expected, 'Arguments ok' );
+ }
+
+
+ # Test that /foo and /foo/ both do the same thing
+ {
+ my @expected = qw[
+ TestApp::Controller::Action->begin
+ TestApp::Controller::Action->default
+ TestApp->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/action'), 'Request' );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected,
+ 'Executed actions for /action'
+ );
+
+ ok( $response = request('http://localhost/action/'), 'Request' );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected,
+ 'Executed actions for /action/'
+ );
+ }
+}
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_default.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_detach.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_detach.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_detach.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,100 @@
+#!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' );
+ }
+}
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_detach.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_end.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_end.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_end.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,54 @@
+#!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 => 7*$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::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'
+ );
+ }
+}
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_end.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_forward.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_forward.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_forward.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,238 @@
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+our $iters;
+
+BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; }
+
+use Test::More tests => 47 * $iters;
+use Catalyst::Test 'TestApp';
+
+if ( $ENV{CAT_BENCHMARK} ) {
+ require Benchmark;
+ Benchmark::timethis( $iters, \&run_tests );
+}
+else {
+ for ( 1 .. $iters ) {
+ run_tests();
+ }
+}
+
+sub run_tests {
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::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
+ TestApp->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ # Test forward to global private action
+ ok( my $response = request('http://localhost/action/forward/global'),
+ 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is( $response->header('X-Catalyst-Action'),
+ 'action/forward/global', 'Main Class Action' );
+
+ # Test forward to chain of actions.
+ ok( $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::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
+ TestApp->end
+ ];
+
+ 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'
+ );
+ }
+
+ {
+ ok(
+ my $response =
+ request('http://localhost/action/forward/with_args/old'),
+ 'Request with args'
+ );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content, 'old' );
+ }
+
+ {
+ ok(
+ my $response = request(
+ 'http://localhost/action/forward/with_method_and_args/old'),
+ 'Request with args and method'
+ );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content, 'old' );
+ }
+
+ # test forward with embedded args
+ {
+ ok(
+ my $response =
+ request('http://localhost/action/forward/args_embed_relative'),
+ 'Request'
+ );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content, 'ok' );
+ }
+
+ {
+ ok(
+ my $response =
+ request('http://localhost/action/forward/args_embed_absolute'),
+ 'Request'
+ );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content, 'ok' );
+ }
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::TestRelative->begin
+ TestApp::Controller::Action::TestRelative->relative
+ 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->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ # Test forward to chain of actions.
+ ok( my $response = request('http://localhost/action/relative/relative'),
+ 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is( $response->header('X-Catalyst-Action'),
+ 'action/relative/relative', 'Test Action' );
+ is(
+ $response->header('X-Test-Class'),
+ 'TestApp::Controller::Action::TestRelative',
+ 'Test Class'
+ );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ like(
+ $response->content,
+ qr/^bless\( .* 'Catalyst::Request' \)$/s,
+ 'Content is a serialized Catalyst::Request'
+ );
+ }
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::TestRelative->begin
+ TestApp::Controller::Action::TestRelative->relative_two
+ 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->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ # Test forward to chain of actions.
+ ok(
+ my $response =
+ request('http://localhost/action/relative/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/relative_two',
+ 'Test Action'
+ );
+ is(
+ $response->header('X-Test-Class'),
+ 'TestApp::Controller::Action::TestRelative',
+ 'Test Class'
+ );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ like(
+ $response->content,
+ qr/^bless\( .* 'Catalyst::Request' \)$/s,
+ 'Content is a serialized Catalyst::Request'
+ );
+ }
+
+ # test class forwards
+ {
+ ok(
+ my $response = request(
+ 'http://localhost/action/forward/class_forward_test_action'),
+ 'Request'
+ );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->header('X-Class-Forward-Test-Method'), 1,
+ 'Test Method' );
+ }
+
+}
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_forward.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_global.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_global.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_global.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,83 @@
+#!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 {
+ {
+ ok( my $response = request('http://localhost/action_global_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_global_one', 'Test Action' );
+ is(
+ $response->header('X-Test-Class'),
+ 'TestApp::Controller::Action::Global',
+ 'Test Class'
+ );
+ like(
+ $response->content,
+ qr/^bless\( .* 'Catalyst::Request' \)$/s,
+ 'Content is a serialized Catalyst::Request'
+ );
+ }
+
+ {
+ ok( my $response = request('http://localhost/action_global_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_global_two', 'Test Action' );
+ is(
+ $response->header('X-Test-Class'),
+ 'TestApp::Controller::Action::Global',
+ 'Test Class'
+ );
+ like(
+ $response->content,
+ qr/^bless\( .* 'Catalyst::Request' \)$/s,
+ 'Content is a serialized Catalyst::Request'
+ );
+ }
+
+ {
+ ok( my $response = request('http://localhost/action_global_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_global_three', 'Test Action' );
+ is(
+ $response->header('X-Test-Class'),
+ 'TestApp::Controller::Action::Global',
+ 'Test Class'
+ );
+ like(
+ $response->content,
+ qr/^bless\( .* 'Catalyst::Request' \)$/s,
+ 'Content is a serialized Catalyst::Request'
+ );
+ }
+}
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_global.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_index.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_index.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_index.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,100 @@
+#!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 => 20*$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 {
+ # test root index
+ {
+ my @expected = qw[
+ TestApp->index
+ TestApp->end
+ ];
+
+ my $expected = join( ", ", @expected );
+ ok( my $response = request('http://localhost/'), 'root index' );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, 'root index', 'root index ok' );
+
+ ok( $response = request('http://localhost'), 'root index no slash' );
+ is( $response->content, 'root index', 'root index no slash ok' );
+ }
+
+ # test first-level controller index
+ {
+ my @expected = qw[
+ TestApp::Controller::Index->index
+ TestApp->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/index/'), 'first-level controller index' );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, 'Index index', 'first-level controller index ok' );
+
+ ok( $response = request('http://localhost/index'), 'first-level controller index no slash' );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, 'Index index', 'first-level controller index no slash ok' );
+ }
+
+ # test second-level controller index
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Index->begin
+ TestApp::Controller::Action::Index->index
+ TestApp->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/action/index/'), 'second-level controller index' );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, 'Action-Index index', 'second-level controller index ok' );
+
+ ok( $response = request('http://localhost/action/index'), 'second-level controller index no slash' );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, 'Action-Index index', 'second-level controller index no slash ok' );
+ }
+
+ # test controller default when index is present
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Index->begin
+ TestApp::Controller::Action::Index->default
+ TestApp->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/action/index/foo'), 'default with index' );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, "Error - TestApp::Controller::Action\n", 'default with index ok' );
+ }
+}
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_index.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_inheritance.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_inheritance.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_inheritance.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,119 @@
+#!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 => 21*$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::Inheritance->begin
+ TestApp::Controller::Action::Inheritance->auto
+ 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::Inheritance::A->begin
+ TestApp::Controller::Action::Inheritance->auto
+ TestApp::Controller::Action::Inheritance::A->auto
+ TestApp::Controller::Action::Inheritance::A->default
+ TestApp::View::Dump::Request->process
+ TestApp::Controller::Action::Inheritance::A->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::Inheritance::A::B->begin
+ TestApp::Controller::Action::Inheritance->auto
+ TestApp::Controller::Action::Inheritance::A->auto
+ TestApp::Controller::Action::Inheritance::A::B->auto
+ TestApp::Controller::Action::Inheritance::A::B->default
+ TestApp::View::Dump::Request->process
+ TestApp::Controller::Action::Inheritance::A::B->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'
+ );
+ }
+}
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_inheritance.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_local.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_local.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_local.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,138 @@
+#!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 => 32*$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 {
+ {
+ ok( my $response = request('http://localhost/action/local/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/local/one', 'Test Action' );
+ is(
+ $response->header('X-Test-Class'),
+ 'TestApp::Controller::Action::Local',
+ 'Test Class'
+ );
+ like(
+ $response->content,
+ qr/^bless\( .* 'Catalyst::Request' \)$/s,
+ 'Content is a serialized Catalyst::Request'
+ );
+ }
+
+ {
+ ok( my $response = request('http://localhost/action/local/two/1/2'),
+ 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is( $response->header('X-Catalyst-Action'),
+ 'action/local/two', 'Test Action' );
+ is(
+ $response->header('X-Test-Class'),
+ 'TestApp::Controller::Action::Local',
+ 'Test Class'
+ );
+ like(
+ $response->content,
+ qr/^bless\( .* 'Catalyst::Request' \)$/s,
+ 'Content is a serialized Catalyst::Request'
+ );
+ }
+
+ {
+ ok( my $response = request('http://localhost/action/local/two'),
+ 'Request' );
+ ok( !$response->is_success, 'Request with wrong number of args failed' );
+ }
+
+ {
+ ok( my $response = request('http://localhost/action/local/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/local/three', 'Test Action' );
+ is(
+ $response->header('X-Test-Class'),
+ 'TestApp::Controller::Action::Local',
+ 'Test Class'
+ );
+ like(
+ $response->content,
+ qr/^bless\( .* 'Catalyst::Request' \)$/s,
+ 'Content is a serialized Catalyst::Request'
+ );
+ }
+
+ {
+ ok(
+ my $response =
+ request('http://localhost/action/local/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/local/four/five/six', 'Test Action' );
+ is(
+ $response->header('X-Test-Class'),
+ 'TestApp::Controller::Action::Local',
+ 'Test Class'
+ );
+ like(
+ $response->content,
+ qr/^bless\( .* 'Catalyst::Request' \)$/s,
+ 'Content is a serialized Catalyst::Request'
+ );
+ }
+
+ SKIP:
+ {
+ if ( $ENV{CATALYST_SERVER} ) {
+ skip "tests for %2F on remote server", 6;
+ }
+
+ ok(
+ my $response =
+ request('http://localhost/action/local/one/foo%2Fbar'),
+ 'Request'
+ );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is( $response->header('X-Catalyst-Action'),
+ 'action/local/one', 'Test Action' );
+ is(
+ $response->header('X-Test-Class'),
+ 'TestApp::Controller::Action::Local',
+ 'Test Class'
+ );
+ like(
+ $response->content,
+ qr~arguments => \[\s*'foo/bar'\s*\]~,
+ "Parameters don't split on %2F"
+ );
+ }
+}
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_local.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_multipath.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_multipath.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_multipath.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,71 @@
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+my $content = q/foo
+bar
+baz
+/;
+
+our $iters;
+
+BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; }
+
+use Test::More tests => 16*$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 {
+ # Local
+ {
+ ok(
+ my $response =
+ request('http://localhost/action/multipath/multipath'),
+ 'Request'
+ );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is( $response->content, $content, 'Content is a stream' );
+ }
+
+ # Global
+ {
+ ok( my $response = request('http://localhost/multipath'), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is( $response->content, $content, 'Content is a stream' );
+ }
+
+ # Path('/multipath1')
+ {
+ ok( my $response = request('http://localhost/multipath1'), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is( $response->content, $content, 'Content is a stream' );
+ }
+
+ # Path('multipath2')
+ {
+ ok(
+ my $response =
+ request('http://localhost/action/multipath/multipath2'),
+ 'Request'
+ );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is( $response->content, $content, 'Content is a stream' );
+ }
+}
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_multipath.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_path.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_path.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_path.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,127 @@
+#!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 => 30*$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 {
+ {
+ ok(
+ my $response =
+ request('http://localhost/action/path/a%20path%20with%20spaces'),
+ '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%20path%20with%20spaces',
+ '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/%C3%A5%C3%A4%C3%B6', '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'
+ );
+ }
+
+ {
+ ok( my $response = request('http://localhost/action/path/spaces_near_parens_singleq'),
+ '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/spaces_near_parens_singleq', '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/spaces_near_parens_doubleq'),
+ '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/spaces_near_parens_doubleq', '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'
+ );
+ }
+}
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_path.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_private.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_private.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_private.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,89 @@
+#!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 => 24*$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 {
+ {
+ 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_error, 'Response Server Error 5xx' );
+ is( $response->content_type, 'text/html', 'Response Content-Type' );
+ like(
+ $response->header('X-Catalyst-Error'),
+ qr/^Unknown resource "three"/,
+ 'Catalyst Error'
+ );
+ }
+
+ {
+ 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' );
+ }
+}
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_private.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_regexp.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_regexp.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_regexp.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,106 @@
+#!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 => 28*$iters;
+use Catalyst::Test 'TestApp';
+
+use Catalyst::Request;
+
+if ( $ENV{CAT_BENCHMARK} ) {
+ require Benchmark;
+ Benchmark::timethis( $iters, \&run_tests );
+}
+else {
+ for ( 1 .. $iters ) {
+ run_tests();
+ }
+}
+
+sub run_tests {
+ {
+ 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'
+ );
+ }
+
+ {
+ ok( my $response = request('http://localhost/action/regexp/mandatory'),
+ '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/(mandatory)(/optional)?$', 'Test Action' );
+ is(
+ $response->header('X-Test-Class'),
+ 'TestApp::Controller::Action::Regexp',
+ 'Test Class'
+ );
+ my $content = $response->content;
+ my $req = eval $content;
+
+ is( scalar @{ $req->captures }, 2, 'number of captures' );
+ is( $req->captures->[ 0 ], 'mandatory', 'mandatory capture' );
+ ok( !defined $req->captures->[ 1 ], 'optional capture' );
+ }
+
+ {
+ ok( my $response = request('http://localhost/action/regexp/mandatory/optional'),
+ '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/(mandatory)(/optional)?$', 'Test Action' );
+ is(
+ $response->header('X-Test-Class'),
+ 'TestApp::Controller::Action::Regexp',
+ 'Test Class'
+ );
+ my $content = $response->content;
+ my $req = eval $content;
+
+ is( scalar @{ $req->captures }, 2, 'number of captures' );
+ is( $req->captures->[ 0 ], 'mandatory', 'mandatory capture' );
+ is( $req->captures->[ 1 ], '/optional', 'optional capture' );
+ }
+}
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_regexp.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_streaming.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_streaming.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_streaming.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,72 @@
+#!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 => 10*$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 {
+ # test direct streaming
+ {
+ ok( my $response = request('http://localhost/streaming'), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+
+ SKIP:
+ {
+ if ( $ENV{CATALYST_SERVER} ) {
+ skip "Using remote server", 1;
+ }
+
+ # XXX: Length should be undef here, but HTTP::Request::AsCGI sets it
+ is( $response->content_length, 12, 'Response Content-Length' );
+ }
+
+ is( $response->content,, <<'EOF', 'Content is a stream' );
+foo
+bar
+baz
+EOF
+ }
+
+ # test streaming by passing a handle to $c->res->body
+ SKIP:
+ {
+ if ( $ENV{CATALYST_SERVER} ) {
+ skip "Using remote server", 5;
+ }
+
+ my $file = "$FindBin::Bin/01use.t";
+ my $fh = IO::File->new( $file, 'r' );
+ my $buffer;
+ if ( defined $fh ) {
+ $fh->read( $buffer, 1024 );
+ $fh->close;
+ }
+
+ ok( my $response = request('http://localhost/action/streaming/body'),
+ 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is( $response->content_length, -s $file, 'Response Content-Length' );
+ is( $response->content, $buffer, 'Content is read from filehandle' );
+ }
+}
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_action_streaming.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_args.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_args.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_args.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,98 @@
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+use URI::Escape;
+
+our @paths;
+our $iters;
+
+BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1;
+
+ # add special paths to test here
+ @paths = (
+ # all reserved in uri's
+ qw~ : / ? [ ] @ ! $ & ' ( ) * + ; = ~, ',' , '#',
+
+ # unreserved
+ 'a'..'z','A'..'Z',0..9,qw( - . _ ~ ),
+ " ",
+
+ # just to test %2F/%
+ [ qw~ / / ~ ],
+
+ # testing %25/%25
+ [ qw~ % % ~ ],
+ );
+}
+
+use Test::More tests => 6*@paths * $iters;
+use Catalyst::Test 'TestApp';
+
+if ( $ENV{CAT_BENCHMARK} ) {
+ require Benchmark;
+ Benchmark::timethis( $iters, \&run_tests );
+
+ # new dispatcher:
+ # 11 wallclock secs (10.14 usr + 0.20 sys = 10.34 CPU) @ 15.18/s (n=157)
+ # old dispatcher (r1486):
+ # 11 wallclock secs (10.34 usr + 0.20 sys = 10.54 CPU) @ 13.76/s (n=145)
+}
+else {
+ for ( 1 .. $iters ) {
+ run_tests();
+ }
+}
+
+sub run_tests {
+ run_test_for($_) for @paths;
+}
+
+sub run_test_for {
+ my $test = shift;
+
+ my $path;
+ if (ref $test) {
+ $path = join "/", map uri_escape($_), @$test;
+ $test = join '', @$test;
+ } else {
+ $path = uri_escape($test);
+ }
+
+ SKIP:
+ {
+ # Skip %2F, ., [, (, and ) tests on real webservers
+ # Both Apache and lighttpd don't seem to like these
+ if ( $ENV{CATALYST_SERVER} && $path =~ /(?:%2F|\.|%5B|\(|\))/ ) {
+ skip "Skipping $path tests on remote server", 6;
+ }
+
+ my $response;
+
+ ok( $response = request("http://localhost/args/args/$path"), "Requested args for path $path");
+
+ is( $response->content, $test, "$test as args" );
+
+ undef $response;
+
+ ok( $response = request("http://localhost/args/params/$path"), "Requested params for path $path");
+
+ is( $response->content, $test, "$test as params" );
+
+ undef $response;
+
+ if( $test =~ m{/} ) {
+ $test =~ s{/}{}g;
+ $path = uri_escape( $test );
+ }
+
+ ok( $response = request("http://localhost/chained/multi_cap/$path/baz"), "Requested capture for path $path");
+
+ is( $response->content, join( ', ', split( //, $test ) ) ."; ", "$test as capture" );
+ }
+}
+
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/live_component_controller_args.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_request_body.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_request_body.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_request_body.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,77 @@
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+use Test::More tests => 18;
+use Catalyst::Test 'TestApp';
+
+use Catalyst::Request;
+use HTTP::Headers;
+use HTTP::Request::Common;
+
+{
+ my $creq;
+
+ my $request = POST(
+ 'http://localhost/dump/request/',
+ 'Content-Type' => 'text/plain',
+ 'Content' => 'Hello 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/'Catalyst::Request'/,
+ '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, 'text/plain', 'Catalyst::Request Content-Type' );
+ is( $creq->content_length, $request->content_length,
+ 'Catalyst::Request Content-Length' );
+}
+
+{
+ my $creq;
+
+ my $request = POST(
+ 'http://localhost/dump/request/',
+ 'Content-Type' => 'text/plain',
+ 'Content' => 'x' x 100_000
+ );
+
+ 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, 'text/plain', 'Catalyst::Request Content-Type' );
+ is( $creq->content_length, $request->content_length,
+ 'Catalyst::Request Content-Length' );
+}
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_request_body.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_request_body_demand.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_request_body_demand.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_request_body_demand.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,66 @@
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+use Test::More tests => 8;
+use Catalyst::Test 'TestAppOnDemand';
+
+use Catalyst::Request;
+use HTTP::Headers;
+use HTTP::Request::Common;
+
+# Test a simple POST request to make sure body parsing
+# works in on-demand mode.
+SKIP:
+{
+ if ( $ENV{CATALYST_SERVER} ) {
+ skip "Using remote server", 8;
+ }
+
+ {
+ my $params;
+
+ my $request = POST(
+ 'http://localhost/body/params',
+ 'Content-Type' => 'application/x-www-form-urlencoded',
+ 'Content' => 'foo=bar&baz=quux'
+ );
+
+ my $expected = { foo => 'bar', baz => 'quux' };
+
+ ok( my $response = request($request), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+
+ {
+ no strict 'refs';
+ ok(
+ eval '$params = ' . $response->content,
+ 'Unserialize params'
+ );
+ }
+
+ is_deeply( $params, $expected, 'Catalyst::Request body parameters' );
+ }
+
+ # Test reading chunks of the request body using $c->read
+ {
+ my $creq;
+
+ my $request = POST(
+ 'http://localhost/body/read',
+ 'Content-Type' => 'text/plain',
+ 'Content' => 'x' x 105_000
+ );
+
+ my $expected = '10000|10000|10000|10000|10000|10000|10000|10000|10000|10000|5000';
+
+ ok( my $response = request($request), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is( $response->content, $expected, 'Response Content' );
+ }
+}
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_request_body_demand.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_request_cookies.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_request_cookies.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_request_cookies.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,45 @@
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+use Test::More tests => 13;
+use Catalyst::Test 'TestApp';
+
+use Catalyst::Request;
+use CGI::Simple::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/'Catalyst::Request'/,
+ '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::Simple::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::Simple::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' );
+}
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_request_cookies.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_request_headers.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_request_headers.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_request_headers.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,71 @@
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+use Test::More tests => 17;
+use Catalyst::Test 'TestApp';
+
+use Catalyst::Request;
+use HTTP::Headers;
+use HTTP::Request::Common;
+
+{
+ my $creq;
+
+ my $request = GET( 'http://localhost/dump/request',
+ 'User-Agent' => 'MyAgen/1.0',
+ 'X-Whats-Cool' => 'Catalyst',
+ 'X-Multiple' => [ 1 .. 5 ],
+ 'X-Forwarded-Host' => 'frontend.server.com',
+ 'X-Forwarded-For' => '192.168.1.1, 1.2.3.4',
+ );
+
+ 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' );
+
+ { # Test that multiple headers are joined as per RFC 2616 4.2 and RFC 3875 4.1.18
+
+ my $excpected = '1, 2, 3, 4, 5';
+ my $got = $creq->header('X-Multiple'); # HTTP::Headers is context sensitive, "force" scalar context
+
+ is( $got, $excpected, 'Multiple message-headers are joined as a comma-separated list' );
+ }
+
+ 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' );
+
+ SKIP:
+ {
+ if ( $ENV{CATALYST_SERVER} && $ENV{CATALYST_SERVER} !~ /127.0.0.1|localhost/ ) {
+ skip "Using remote server", 2;
+ }
+
+ is( $creq->base->host, 'frontend.server.com', 'Catalyst::Request proxied base' );
+ is( $creq->address, '1.2.3.4', 'Catalyst::Request proxied address' );
+ }
+
+ SKIP:
+ {
+ if ( $ENV{CATALYST_SERVER} ) {
+ skip "Using remote server", 4;
+ }
+ # test that we can ignore the proxy support
+ TestApp->config->{ignore_frontend_proxy} = 1;
+ ok( $response = request($request), 'Request' );
+ ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
+ is( $creq->base, 'http://localhost/', 'Catalyst::Request non-proxied base' );
+ is( $creq->address, '127.0.0.1', 'Catalyst::Request non-proxied address' );
+ }
+}
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_request_headers.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_request_parameters.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_request_parameters.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_request_parameters.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,139 @@
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+use Test::More tests => 40;
+use Catalyst::Test 'TestApp';
+
+use Catalyst::Request;
+use HTTP::Headers;
+use HTTP::Request::Common;
+
+{
+ my $creq;
+
+ my $parameters = { 'a' => [qw(A b C d E f G)], };
+
+ my $query = join( '&', map { 'a=' . $_ } @{ $parameters->{a} } );
+
+ ok( my $response = request("http://localhost/dump/request?$query"),
+ '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, 'GET', 'Catalyst::Request method' );
+ is_deeply( $creq->{parameters}, $parameters,
+ 'Catalyst::Request parameters' );
+}
+
+{
+ my $creq;
+ ok( my $response = request("http://localhost/dump/request?q=foo%2bbar"),
+ 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ ok( eval '$creq = ' . $response->content );
+ is $creq->{parameters}->{q}, 'foo+bar', '%2b not double decoded';
+}
+
+{
+ my $creq;
+ ok( my $response = request("http://localhost/dump/request?q=foo=bar"),
+ 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ ok( eval '$creq = ' . $response->content );
+ is $creq->{parameters}->{q}, 'foo=bar', '= not ignored';
+}
+
+{
+ my $creq;
+
+ my $parameters = {
+ 'a' => [qw(A b C d E f G)],
+ '%' => [ '%', '"', '& - &' ],
+ 'blank' => '',
+ };
+
+ my $request = POST(
+ 'http://localhost/dump/request/a/b?a=1&a=2&a=3',
+ 'Content' => $parameters,
+ 'Content-Type' => 'application/x-www-form-urlencoded'
+ );
+
+ 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' );
+}
+
+# http://dev.catalyst.perl.org/ticket/37
+# multipart/form-data parameters that contain 'http://'
+# was an HTTP::Message bug, but HTTP::Body handles it properly now
+{
+ my $creq;
+
+ my $parameters = {
+ 'url' => 'http://www.google.com',
+ 'blank' => '',
+ };
+
+ my $request = POST( 'http://localhost/dump/request',
+ 'Content-Type' => 'multipart/form-data',
+ 'Content' => $parameters,
+ );
+
+ ok( my $response = request($request), 'Request' );
+ ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
+ is_deeply( $creq->{parameters}, $parameters, 'Catalyst::Request parameters' );
+}
+
+# raw query string support
+{
+ my $creq;
+
+ my $parameters = {
+ a => 1,
+ blank => '',
+ };
+
+ my $request = POST(
+ 'http://localhost/dump/request/a/b?query+string',
+ 'Content' => $parameters,
+ 'Content-Type' => 'application/x-www-form-urlencoded'
+ );
+
+ ok( my $response = request($request), 'Request' );
+ ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
+ is( $creq->{uri}->query, 'query+string', 'Catalyst::Request POST query_string' );
+ is( $creq->query_keywords, 'query string', 'Catalyst::Request query_keywords' );
+ is_deeply( $creq->{parameters}, $parameters, 'Catalyst::Request parameters' );
+
+ ok( $response = request('http://localhost/dump/request/a/b?x=1&y=1&z=1'), 'Request' );
+ ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
+ is( $creq->{uri}->query, 'x=1&y=1&z=1', 'Catalyst::Request GET query_string' );
+}
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_request_parameters.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_request_uploads.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_request_uploads.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_request_uploads.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,244 @@
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+use Test::More tests => 75;
+use Catalyst::Test 'TestApp';
+
+use Catalyst::Request;
+use Catalyst::Request::Upload;
+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' => 'form-data',
+ 'Content' => [
+ 'live_engine_request_cookies.t' =>
+ ["$FindBin::Bin/live_engine_request_cookies.t"],
+ 'live_engine_request_headers.t' =>
+ ["$FindBin::Bin/live_engine_request_headers.t"],
+ 'live_engine_request_uploads.t' =>
+ ["$FindBin::Bin/live_engine_request_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} };
+
+ isa_ok( $upload, 'Catalyst::Request::Upload' );
+
+ is( $upload->type, $part->content_type, 'Upload Content-Type' );
+ is( $upload->size, length( $part->content ), 'Upload Content-Length' );
+
+ # make sure upload is accessible via legacy params->{$file}
+ is( $creq->{parameters}->{ $upload->filename },
+ $upload->filename, 'legacy param method ok' );
+
+ ok( !-e $upload->tempname, 'Upload temp file was deleted' );
+ }
+}
+
+{
+ my $creq;
+
+ my $request = POST(
+ 'http://localhost/dump/request/',
+ 'Content-Type' => 'multipart/form-data',
+ 'Content' => [
+ 'testfile' => ["$FindBin::Bin/live_engine_request_cookies.t"],
+ 'testfile' => ["$FindBin::Bin/live_engine_request_headers.t"],
+ 'testfile' => ["$FindBin::Bin/live_engine_request_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' );
+
+ my @parts = $request->parts;
+
+ for ( my $i = 0 ; $i < @parts ; $i++ ) {
+
+ my $part = $parts[$i];
+ my $disposition = $part->header('Content-Disposition');
+ my %parameters = @{ ( split_header_words($disposition) )[0] };
+
+ my $upload = $creq->{uploads}->{ $parameters{name} }->[$i];
+
+ isa_ok( $upload, 'Catalyst::Request::Upload' );
+ is( $upload->type, $part->content_type, 'Upload Content-Type' );
+ is( $upload->filename, $parameters{filename}, 'Upload filename' );
+ is( $upload->size, length( $part->content ), 'Upload Content-Length' );
+
+ ok( !-e $upload->tempname, 'Upload temp file was deleted' );
+ }
+}
+
+{
+ my $creq;
+
+ my $request = POST(
+ 'http://localhost/engine/request/uploads/slurp',
+ 'Content-Type' => 'multipart/form-data',
+ 'Content' =>
+ [ 'slurp' => ["$FindBin::Bin/live_engine_request_uploads.t"], ]
+ );
+
+ ok( my $response = request($request), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is( $response->content, ( $request->parts )[0]->content, 'Content' );
+}
+
+{
+ my $request = POST(
+ 'http://localhost/dump/request',
+ 'Content-Type' => 'multipart/form-data',
+ 'Content' =>
+ [ 'file' => ["$FindBin::Bin/catalyst_130pix.gif"], ]
+ );
+
+ # LWP will auto-correct Content-Length when using a remote server
+ SKIP:
+ {
+ if ( $ENV{CATALYST_SERVER} ) {
+ skip 'Using remote server', 2;
+ }
+
+ # Sending wrong Content-Length here and see if subequent requests fail
+ $request->header('Content-Length' => $request->header('Content-Length') + 1);
+
+ ok( my $response = request($request), 'Request' );
+ ok( !$response->is_success, 'Response Error' );
+ }
+
+ $request = POST(
+ 'http://localhost/dump/request',
+ 'Content-Type' => 'multipart/form-data',
+ 'Content' =>
+ [ 'file1' => ["$FindBin::Bin/catalyst_130pix.gif"],
+ 'file2' => ["$FindBin::Bin/catalyst_130pix.gif"], ]
+ );
+
+ 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/file1 => bless/, 'Upload with name file1');
+ like( $response->content, qr/file2 => bless/, 'Upload with name file2');
+}
+
+{
+ my $creq;
+
+ my $request = POST(
+ 'http://localhost/dump/request/',
+ 'Content-Type' => 'form-data',
+ 'Content' => [
+ 'testfile' => 'textfield value',
+ 'testfile' => ["$FindBin::Bin/catalyst_130pix.gif"],
+ ]
+ );
+
+ 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' );
+
+ my $param = $creq->{parameters}->{testfile};
+
+ ok( @$param == 2, '2 values' );
+ is( $param->[0], 'textfield value', 'correct value' );
+ like( $param->[1], qr/\Qcatalyst_130pix.gif/, 'filename' );
+
+ for my $part ( $request->parts ) {
+
+ my $disposition = $part->header('Content-Disposition');
+ my %parameters = @{ ( split_header_words($disposition) )[0] };
+
+ next unless exists $parameters{filename};
+
+ my $upload = $creq->{uploads}->{ $parameters{name} };
+
+ isa_ok( $upload, 'Catalyst::Request::Upload' );
+
+ is( $upload->type, $part->content_type, 'Upload Content-Type' );
+ is( $upload->size, length( $part->content ), 'Upload Content-Length' );
+ is( $upload->filename, 'catalyst_130pix.gif' );
+ }
+}
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_request_uploads.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_request_uri.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_request_uri.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_request_uri.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,122 @@
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+use Test::More tests => 49;
+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 base is correct for HTTPS URLs
+SKIP:
+{
+ if ( $ENV{CATALYST_SERVER} ) {
+ skip 'Using remote server', 5;
+ }
+
+ local $ENV{HTTPS} = 'on';
+ ok( my $response = request('https://localhost/engine/request/uri'), 'HTTPS Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
+ is( $creq->base, 'https://localhost/', 'HTTPS base ok' );
+ is( $creq->uri, 'https://localhost/engine/request/uri', 'HTTPS uri 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(https?://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' );
+}
+
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_request_uri.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_response_cookies.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_response_cookies.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_response_cookies.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,73 @@
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+use Test::More tests => 15;
+use Catalyst::Test 'TestApp';
+use HTTP::Headers::Util 'split_header_words';
+
+my $expected = {
+ Catalyst => [qw|Catalyst Cool path /bah|],
+ 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 $string ( $response->header('Set-Cookie') ) {
+ my $cookie = [ split_header_words $string];
+ $cookies->{ $cookie->[0]->[0] } = $cookie->[0];
+ }
+
+ 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 $string ( $response->header('Set-Cookie') ) {
+ my $cookie = [ split_header_words $string];
+ $cookies->{ $cookie->[0]->[0] } = $cookie->[0];
+ }
+
+ is_deeply( $cookies, $expected, 'Response Cookies' );
+}
+
+{
+ ok( my $response = request('http://localhost/engine/response/cookies/three'),
+ '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/three', 'Test Action' );
+
+ my $cookies = {};
+
+ for my $string ( $response->header('Set-Cookie') ) {
+ my $cookie = [ split_header_words $string];
+ $cookies->{ $cookie->[0]->[0] } = $cookie->[0];
+ }
+
+ is_deeply( $cookies, {
+ hash => [ qw(hash a&b&c path /) ],
+ this_is_the_real_name => [ qw(this_is_the_real_name foo&bar path /) ], # not "object"
+ }, 'Response Cookies' );
+}
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_response_cookies.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_response_errors.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_response_errors.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_response_errors.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,60 @@
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+use Test::More tests => 18;
+use Catalyst::Test 'TestApp';
+
+close STDERR; # i'm naughty :)
+
+{
+ 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, '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/two', 'Test Action' );
+ like(
+ $response->header('X-Catalyst-Error'),
+ qr/^Couldn't forward to/,
+ '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/I'm going to die!/,
+ 'Catalyst Error'
+ );
+}
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_response_errors.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_response_headers.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_response_headers.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_response_headers.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,58 @@
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+use Test::More tests => 18;
+use Catalyst::Test 'TestApp';
+use HTTP::Request::Common;
+
+my $content_length;
+
+foreach my $method qw(HEAD GET) {
+ my $expected = join( ', ', 1 .. 10 );
+
+ my $request = HTTP::Request::Common->can($method)
+ ->( 'http://localhost/engine/response/headers/one' );
+
+ ok( my $response = request($request), '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-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' );
+
+ use bytes;
+ if ( $method eq 'HEAD' ) {
+ $content_length = $response->header('Content-Length');
+ ok( $content_length > 0, 'Response Header Content-Length' );
+ is( length($response->content),
+ 0,
+ 'HEAD method content is empty' );
+ }
+ elsif ( $method eq 'GET' ) {
+ # method name is echo'd back in content-body, which
+ # accounts for difference in content length. In normal
+ # cases the Content-Length should be the same regardless
+ # of if its a GET or HEAD request.
+ SKIP:
+ {
+ if ( $ENV{CATALYST_SERVER} ) {
+ skip "Using remote server", 2;
+ }
+ is( $response->header('Content-Length'),
+ $content_length - 1, 'Response Header Content-Length' );
+ is( length($response->content),
+ $response->header('Content-Length'),
+ 'GET method content' );
+ }
+ }
+}
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_response_headers.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_response_large.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_response_large.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_response_large.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,27 @@
+#!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' );
+}
+
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_response_large.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_response_redirect.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_response_redirect.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_response_redirect.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,48 @@
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+use Test::More tests => 26;
+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( $response->header('Content-Length'), '302 Redirect contains Content-Length' );
+ ok( $response->content, '302 Redirect contains a response body' );
+}
+
+{
+ 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( $response->header('Content-Length'), '301 Redirect contains Content-Length' );
+ ok( $response->content, '301 Redirect contains a response body' );
+}
+
+{
+ 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' );
+ ok( $response->header('Content-Length'), '307 Redirect contains Content-Length' );
+ ok( $response->content, '307 Redirect contains a response body' );
+}
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_response_redirect.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_response_status.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_response_status.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_response_status.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,55 @@
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+use Test::More tests => 30;
+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' );
+}
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_response_status.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_setup_basics.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_setup_basics.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_setup_basics.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,19 @@
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+use Test::More tests => 1;
+use Catalyst::Test 'TestApp';
+
+SKIP:
+{
+ if ( $ENV{CATALYST_SERVER} ) {
+ skip "Using remote server", 1;
+ }
+ # Allow overriding automatic root.
+ is( TestApp->config->{root}, '/some/dir' );
+}
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_setup_basics.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_setup_plugins.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_setup_plugins.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_setup_plugins.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,16 @@
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+use Test::More tests => 2;
+use Catalyst::Test 'TestApp';
+
+{
+ # Allow overriding automatic root.
+ ok( my $response = request('http://localhost/engine/response/headers/one'), 'Request' );
+ is( $response->header('X-Catalyst-Plugin-Setup'), '1' );
+}
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/live_engine_setup_plugins.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/live_fork.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/live_fork.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/live_fork.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,60 @@
+#!/usr/bin/perl
+# live_fork.t
+# Copyright (c) 2006 Jonathan Rockway <jrockway at cpan.org>
+
+=head1 SYNOPSIS
+
+Tests if Catalyst can fork/exec other processes successfully
+
+=cut
+use strict;
+use warnings;
+use Test::More;
+use YAML;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use Catalyst::Test qw(TestApp);
+
+plan skip_all => 'Using remote server'
+ if $ENV{CATALYST_SERVER};
+
+plan skip_all => 'Skipping fork tests: no /bin/ls'
+ if !-e '/bin/ls'; # see if /bin/ls exists
+
+plan tests => 13; # otherwise
+
+{
+ system:
+ ok(my $result = get('/fork/system/%2Fbin%2Fls'), 'system');
+ my @result = split /$/m, $result;
+ $result = join q{}, @result[-4..-1];
+
+ my $result_ref = eval { Load($result) };
+ ok($result_ref, 'is YAML');
+ is($result_ref->{result}, 0, 'exited OK');
+}
+
+{
+ backticks:
+ ok(my $result = get('/fork/backticks/%2Fbin%2Fls'), '`backticks`');
+ my @result = split /$/m, $result;
+ $result = join q{}, @result[-4..-1];
+
+ my $result_ref = eval { Load($result) };
+ ok($result_ref, 'is YAML');
+ is($result_ref->{code}, 0, 'exited successfully');
+ like($result_ref->{result}, qr{^/bin/ls[^:]}, 'contains ^/bin/ls$');
+ like($result_ref->{result}, qr{\n.*\n}m, 'contains two newlines');
+}
+{
+ fork:
+ ok(my $result = get('/fork/fork'), 'fork');
+ my @result = split /$/m, $result;
+ $result = join q{}, @result[-4..-1];
+
+ my $result_ref = eval { Load($result) };
+ ok($result_ref, 'is YAML');
+ isnt($result_ref->{pid}, 0, q{fork's "pid" wasn't 0});
+ isnt($result_ref->{pid}, $$, 'fork got a new pid');
+ is($result_ref->{result}, 'ok', 'fork was effective');
+}
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/live_fork.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/live_loop.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/live_loop.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/live_loop.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,23 @@
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+use Test::More tests => 3;
+use Catalyst::Test 'TestApp';
+
+SKIP:
+{
+ # Net::HTTP::Methods crashes when talking to a remote server because this
+ # test causes a very long header line to be sent
+ if ( $ENV{CATALYST_SERVER} ) {
+ skip 'Using remote server', 3;
+ }
+
+ ok( my $response = request('http://localhost/loop_test'), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ ok( $response->header('X-Class-Forward-Test-Method'), 'Loop OK' );
+}
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/live_loop.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/live_plugin_loaded.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/live_plugin_loaded.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/live_plugin_loaded.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,27 @@
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+use Test::More tests => 5;
+use Catalyst::Test 'TestApp';
+
+my @expected = qw[
+ Catalyst::Plugin::Test::Errors
+ Catalyst::Plugin::Test::Headers
+ Catalyst::Plugin::Test::Inline
+ Catalyst::Plugin::Test::Plugin
+ TestApp::Plugin::FullyQualified
+];
+
+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/'Catalyst::Request'/,
+ 'Content is a serialized Catalyst::Request' );
+is( $response->header('X-Catalyst-Plugins'), $expected, 'Loaded plugins' );
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/live_plugin_loaded.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/live_priorities.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/live_priorities.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/live_priorities.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,81 @@
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+use Test::More tests => 28;
+use Catalyst::Test 'TestApp';
+use Data::Dumper;
+
+local $^W = 0;
+
+my $uri_base = 'http://localhost/priorities';
+my @tests = (
+
+ # Simple
+ 'Regex vs. Local', { path => '/re_vs_loc', expect => 'local' },
+ 'Regex vs. LocalRegex', { path => '/re_vs_locre', expect => 'regex' },
+ 'Regex vs. Path', { path => '/re_vs_path', expect => 'path' },
+ 'Local vs. LocalRegex', { path => '/loc_vs_locre', expect => 'local' },
+ 'Local vs. Path 1', { path => '/loc_vs_path1', expect => 'local' },
+ 'Local vs. Path 2', { path => '/loc_vs_path2', expect => 'path' },
+ 'Path vs. LocalRegex', { path => '/path_vs_locre', expect => 'path' },
+
+ # index
+ 'index vs. Regex', { path => '/re_vs_index', expect => 'index' },
+ 'index vs. Local', { path => '/loc_vs_index', expect => 'index' },
+ 'index vs. LocalRegex', { path => '/locre_vs_index', expect => 'index' },
+ 'index vs. Path', { path => '/path_vs_index', expect => 'index' },
+
+ 'multimethod zero', { path => '/multimethod', expect => 'zero' },
+ 'multimethod one', { path => '/multimethod/1', expect => 'one 1' },
+ 'multimethod two', { path => '/multimethod/1/2',
+ expect => 'two 1 2' },
+);
+
+while ( @tests ) {
+
+ my $name = shift @tests;
+ my $data = shift @tests;
+
+ # Run tests for path with trailing slash and without
+ SKIP: for my $req_uri
+ (
+ join( '' => $uri_base, $data->{ path } ), # Without trailing path
+ join( '' => $uri_base, $data->{ path }, '/' ), # With trailing path
+ ) {
+ my $end_slash = ( $req_uri =~ qr(/$) ? 1 : 0 );
+
+ # use slash_expect argument if URI ends with slash
+ # and the slash_expect argument is defined
+ my $expect = $data->{ expect } || '';
+ if ( $end_slash and exists $data->{ slash_expect } ) {
+ $expect = $data->{ slash_expect };
+ }
+
+ # Call the URI on the TestApp
+ my $response = request( $req_uri );
+
+ # Leave expect out to see the result
+ unless ( $expect ) {
+ skip 'Nothing expected, winner is ' . $response->content, 1;
+ }
+
+ # Show error if response was no success
+ if ( not $response->is_success ) {
+ diag 'Error: ' . $response->headers->{ 'x-catalyst-error' };
+ }
+
+ # Test if content matches expectations.
+ # TODO This might flood the screen with the catalyst please-come-later
+ # page. So I don't know it is a good idea.
+ is( $response->content, $expect,
+ "$name: @{[ $data->{ expect } ]} wins"
+ . ( $end_slash ? ' (trailing slash)' : '' )
+ );
+ }
+}
+
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/live_priorities.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/live_recursion.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/live_recursion.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/live_recursion.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,25 @@
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+use Test::More tests => 3;
+use Catalyst::Test 'TestApp';
+
+local $^W = 0;
+
+SKIP:
+{
+ # Net::HTTP::Methods crashes when talking to a remote server because this
+ # test causes a very long header line to be sent
+ if ( $ENV{CATALYST_SERVER} ) {
+ skip 'Using remote server', 3;
+ }
+
+ ok( my $response = request('http://localhost/recursion_test'), 'Request' );
+ ok( !$response->is_success, 'Response Not Successful' );
+ is( $response->header('X-Catalyst-Error'), 'Deep recursion detected calling "/recursion_test"', 'Deep Recursion Detected' );
+}
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/live_recursion.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/live_stats.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/live_stats.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/live_stats.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,29 @@
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+use Test::More;
+use Catalyst::Test 'TestAppStats';
+
+if ( $ENV{CATALYST_SERVER} ) {
+ plan skip_all => 'Using remote server';
+}
+else {
+ plan tests => 5;
+}
+
+{
+ ok( my $response = request('http://localhost/'), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+}
+{
+ ok( my $response = request('http://localhost/'), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ ok( $response->content =~ m/\/default.*?[\d.]+s.*- test.*[\d.]+s/s, 'Stats report');
+
+}
+
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/live_stats.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/optional_prefork-server.t
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/optional_prefork-server.t (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/optional_prefork-server.t 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,74 @@
+#!perl
+
+use strict;
+use warnings;
+
+use File::Copy;
+use File::Path;
+use FindBin;
+use IO::Socket;
+use Test::More;
+eval "use File::Copy::Recursive";
+
+plan skip_all => 'set TEST_PREFORK to enable this test' unless $ENV{TEST_PREFORK};
+plan skip_all => 'File::Copy::Recursive required' if $@;
+plan tests => 1;
+
+# 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 "catalyst.pl TestApp";
+copy "$FindBin::Bin/../t/testapp_prefork.pl", "$FindBin::Bin/../t/tmp/TestApp/script/testapp_prefork.pl";
+chdir "$FindBin::Bin/..";
+File::Copy::Recursive::dircopy( 't/lib', 't/tmp/TestApp/lib' );
+
+# remove TestApp's tests
+rmtree 't/tmp/TestApp/t';
+
+# remove the Root controller
+unlink 't/tmp/TestApp/lib/TestApp/Controller/Root.pm';
+
+# spawn the standalone Prefork 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_prefork.pl -port $port 2>&1 |"
+ or die "Unable to spawn standalone Prefork server: $!";
+
+# wait for it to start
+print "Waiting for server to start...\n";
+while ( check_port( 'localhost', $port ) != 1 ) {
+ sleep 1;
+}
+
+# run the testsuite against the Prefork server
+$ENV{CATALYST_SERVER} = "http://localhost:$port";
+system( 'prove -r -Ilib/ t/live_*' );
+
+# shut it down
+kill 'INT', $pid;
+close $server;
+
+# clean up
+#rmtree "$FindBin::Bin/../t/tmp" if -d "$FindBin::Bin/../t/tmp";
+
+ok( 'done' );
+
+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;
+ }
+}
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/optional_prefork-server.t
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/Catalyst-Engine-HTTP-Prefork/t/testapp_prefork.pl
===================================================================
--- trunk/Catalyst-Engine-HTTP-Prefork/t/testapp_prefork.pl (rev 0)
+++ trunk/Catalyst-Engine-HTTP-Prefork/t/testapp_prefork.pl 2008-02-23 16:37:48 UTC (rev 7456)
@@ -0,0 +1,41 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+ $ENV{CATALYST_ENGINE} ||= 'HTTP::Prefork';
+}
+
+use strict;
+use Getopt::Long;
+use Pod::Usage;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+
+my $debug = 0;
+my $help = 0;
+my $host = undef;
+my $port = 3000;
+
+my @argv = @ARGV;
+
+GetOptions(
+ 'debug|d' => \$debug,
+ 'help|?' => \$help,
+ 'host=s' => \$host,
+ 'port=s' => \$port,
+);
+
+pod2usage(1) if $help;
+
+if ( $debug ) {
+ $ENV{CATALYST_DEBUG} = 1;
+}
+
+# This is require instead of use so that the above environment
+# variables can be set at runtime.
+require TestApp;
+
+TestApp->run( $port, $host, {
+ argv => \@argv,
+} );
+
+1;
Property changes on: trunk/Catalyst-Engine-HTTP-Prefork/t/testapp_prefork.pl
___________________________________________________________________
Name: svn:executable
+ *
Name: svn:keywords
+ Id
More information about the Catalyst-commits
mailing list