has stats => (is => 'rw');
has action => (is => 'rw');
has counter => (is => 'rw', default => sub { {} });
-has request => (is => 'rw', default => sub { $_[0]->request_class->new({}) }, required => 1, lazy => 1);
-has response => (is => 'rw', default => sub { $_[0]->response_class->new({}) }, required => 1, lazy => 1);
+has request => (
+ is => 'rw',
+ default => sub {
+ my $self = shift;
+ my %p = ( _log => $self->log );
+ $p{_uploadtmp} = $self->_uploadtmp if $self->_has_uploadtmp;
+ $self->request_class->new(\%p);
+ },
+ lazy => 1,
+);
+has response => (
+ is => 'rw',
+ default => sub {
+ my $self = shift;
+ $self->response_class->new({ _log => $self->log });
+ },
+ lazy => 1,
+);
has namespace => (is => 'rw');
sub depth { scalar @{ shift->stack || [] }; }
=cut
+has _uploadtmp => (
+ is => 'ro',
+ predicate => '_has_uploadtmp',
+);
+
sub prepare {
my ( $class, @arguments ) = @_;
# into the application.
$class->context_class( ref $class || $class ) unless $class->context_class;
- my $c = $class->context_class->new({});
-
- # For on-demand data
- $c->request->_context($c);
- $c->response->_context($c);
+ my $uploadtmp = $class->config->{uploadtmp};
+ my $c = $class->context_class->new({ $uploadtmp ? (_uploadtmp => $uploadtmp) : ()});
#surely this is not the most efficient way to do things...
$c->stats($class->stats_class->new)->enable($c->use_stats);
$c->prepare_request(@arguments);
$c->prepare_connection;
$c->prepare_query_parameters;
- $c->prepare_headers;
- $c->prepare_cookies;
+ $c->prepare_headers; # Just hooks, no longer needed - they just
+ $c->prepare_cookies; # cause the lazy attribute on req to build
$c->prepare_path;
# Prepare the body for reading, either by prepare_body
sub prepare_connection {
my $c = shift;
- $c->engine->prepare_connection( $c, @_ );
+ # XXX - This is called on the engine (not the request) to maintain
+ # Engine::PSGI back compat.
+ $c->engine->prepare_connection($c);
}
=head2 $c->prepare_cookies
-Prepares cookies.
+Prepares cookies by ensuring that the attribute on the request
+object has been built.
=cut
-sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
+sub prepare_cookies { my $c = shift; $c->request->cookies }
=head2 $c->prepare_headers
-Prepares headers.
+Prepares request headers by ensuring that the attribute on the request
+object has been built.
=cut
-sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
+sub prepare_headers { my $c = shift; $c->request->headers }
=head2 $c->prepare_parameters
=cut
-sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
+sub read { my $c = shift; return $c->request->read( @_ ) }
=head2 $c->run
sub write {
my $c = shift;
- # Finalize headers if someone manually writes output
+ # Finalize headers if someone manually writes output (for compat)
$c->finalize_headers;
- return $c->engine->write( $c, @_ );
+ return $c->response->write( @_ );
}
=head2 version
use HTTP::Body;
use HTTP::Headers;
use URI::QueryParam;
-use Moose::Util::TypeConstraints;
use Plack::Loader;
use Catalyst::EngineLoader;
use Encode ();
use namespace::clean -except => 'meta';
-has env => (is => 'ro', writer => '_set_env', clearer => '_clear_env');
+# Amount of data to read from input on each pass
+our $CHUNKSIZE = 64 * 1024;
+# XXX - this is only here for compat, do not use!
+has env => ( is => 'rw', writer => '_set_env' );
my $WARN_ABOUT_ENV = 0;
around env => sub {
my ($orig, $self, @args) = @_;
return $self->$orig;
};
-# input position and length
-has read_length => (is => 'rw');
-has read_position => (is => 'rw');
-
-has _prepared_write => (is => 'rw');
-
-has _response_cb => (
- is => 'ro',
- isa => 'CodeRef',
- writer => '_set_response_cb',
- clearer => '_clear_response_cb',
- predicate => '_has_response_cb',
-);
-
-subtype 'Catalyst::Engine::Types::Writer',
- as duck_type([qw(write close)]);
-
-has _writer => (
- is => 'ro',
- isa => 'Catalyst::Engine::Types::Writer',
- writer => '_set_writer',
- clearer => '_clear_writer',
-);
-
-# Amount of data to read from input on each pass
-our $CHUNKSIZE = 64 * 1024;
+# XXX - Only here for Engine::PSGI compat
+sub prepare_connection {
+ my ($self, $ctx) = @_;
+ $ctx->request->prepare_connection;
+}
=head1 NAME
$self->write( $c, $body );
}
- $self->_writer->close;
- $self->_clear_writer;
- $self->_clear_env;
+ my $res = $c->response;
+ $res->_writer->close;
+ $res->_clear_writer;
return;
}
=head2 $self->finalize_headers($c)
-Abstract method, allows engines to write headers to response
+Allows engines to write headers to response
=cut
sub finalize_headers {
my ($self, $ctx) = @_;
- # This is a less-than-pretty hack to avoid breaking the old
- # Catalyst::Engine::PSGI. 5.9 Catalyst::Engine sets a response_cb and
- # expects us to pass headers to it here, whereas Catalyst::Enngine::PSGI
- # just pulls the headers out of $ctx->response in its run method and never
- # sets response_cb. So take the lack of a response_cb as a sign that we
- # don't need to set the headers.
-
- return unless $self->_has_response_cb;
-
- my @headers;
- $ctx->response->headers->scan(sub { push @headers, @_ });
-
- $self->_set_writer($self->_response_cb->([ $ctx->response->status, \@headers ]));
- $self->_clear_response_cb;
-
+ $ctx->response->finalize_headers;
return;
}
-=head2 $self->finalize_read($c)
-
-=cut
-
-sub finalize_read { }
-
=head2 $self->finalize_uploads($c)
Clean up after uploads, deleting temp files.
sub prepare_body {
my ( $self, $c ) = @_;
- my $appclass = ref($c) || $c;
- if ( my $length = $self->read_length ) {
- my $request = $c->request;
- unless ( $request->_body ) {
- my $type = $request->header('Content-Type');
- $request->_body(HTTP::Body->new( $type, $length ));
- $request->_body->cleanup(1); # Make extra sure!
- $request->_body->tmpdir( $appclass->config->{uploadtmp} )
- if exists $appclass->config->{uploadtmp};
- }
-
- # Check for definedness as you could read '0'
- while ( defined ( my $buffer = $self->read($c) ) ) {
- $c->prepare_body_chunk($buffer);
- }
-
- # paranoia against wrong Content-Length header
- my $remaining = $length - $self->read_position;
- if ( $remaining > 0 ) {
- $self->finalize_read($c);
- Catalyst::Exception->throw(
- "Wrong Content-Length value: $length" );
- }
- }
- else {
- # Defined but will cause all body code to be skipped
- $c->request->_body(0);
- }
+ $c->request->prepare_body;
}
=head2 $self->prepare_body_chunk($c)
=cut
+# XXX - Can this be deleted?
sub prepare_body_chunk {
my ( $self, $c, $chunk ) = @_;
- $c->request->_body->add($chunk);
+ $c->request->prepare_body_chunk($chunk);
}
=head2 $self->prepare_body_parameters($c)
sub prepare_body_parameters {
my ( $self, $c ) = @_;
- return unless $c->request->_body;
-
- $c->request->body_parameters( $c->request->_body->param );
-}
-
-=head2 $self->prepare_connection($c)
-
-Abstract method implemented in engines.
-
-=cut
-
-sub prepare_connection {
- my ($self, $ctx) = @_;
-
- my $env = $self->env;
- my $request = $ctx->request;
-
- $request->address( $env->{REMOTE_ADDR} );
- $request->hostname( $env->{REMOTE_HOST} )
- if exists $env->{REMOTE_HOST};
- $request->protocol( $env->{SERVER_PROTOCOL} );
- $request->remote_user( $env->{REMOTE_USER} );
- $request->method( $env->{REQUEST_METHOD} );
- $request->secure( $env->{'psgi.url_scheme'} eq 'https' ? 1 : 0 );
-
- return;
-}
-
-=head2 $self->prepare_cookies($c)
-
-Parse cookies from header. Sets a L<CGI::Simple::Cookie> object.
-
-=cut
-
-sub prepare_cookies {
- my ( $self, $c ) = @_;
-
- if ( my $header = $c->request->header('Cookie') ) {
- $c->req->cookies( { CGI::Simple::Cookie->parse($header) } );
- }
-}
-
-=head2 $self->prepare_headers($c)
-
-=cut
-
-sub prepare_headers {
- my ($self, $ctx) = @_;
-
- my $env = $self->env;
- my $headers = $ctx->request->headers;
-
- for my $header (keys %{ $env }) {
- next unless $header =~ /^(HTTP|CONTENT|COOKIE)/i;
- (my $field = $header) =~ s/^HTTPS?_//;
- $field =~ tr/_/-/;
- $headers->header($field => $env->{$header});
- }
+ $c->request->prepare_body_parameters;
}
=head2 $self->prepare_parameters($c)
sub prepare_parameters {
my ( $self, $c ) = @_;
- my $request = $c->request;
- my $parameters = $request->parameters;
- my $body_parameters = $request->body_parameters;
- my $query_parameters = $request->query_parameters;
- # We copy, no references
- foreach my $name (keys %$query_parameters) {
- my $param = $query_parameters->{$name};
- $parameters->{$name} = ref $param eq 'ARRAY' ? [ @$param ] : $param;
- }
-
- # Merge query and body parameters
- foreach my $name (keys %$body_parameters) {
- my $param = $body_parameters->{$name};
- my @values = ref $param eq 'ARRAY' ? @$param : ($param);
- if ( my $existing = $parameters->{$name} ) {
- unshift(@values, (ref $existing eq 'ARRAY' ? @$existing : $existing));
- }
- $parameters->{$name} = @values > 1 ? \@values : $values[0];
- }
+ $c->request->parameters;
}
=head2 $self->prepare_path($c)
sub prepare_path {
my ($self, $ctx) = @_;
- my $env = $self->env;
+ my $env = $ctx->request->env;
my $scheme = $ctx->request->secure ? 'https' : 'http';
my $host = $env->{HTTP_HOST} || $env->{SERVER_NAME};
sub prepare_query_parameters {
my ($self, $c) = @_;
- my $query_string = exists $self->env->{QUERY_STRING}
- ? $self->env->{QUERY_STRING}
+ my $env = $c->request->env;
+ my $query_string = exists $env->{QUERY_STRING}
+ ? $env->{QUERY_STRING}
: '';
# Check for keywords (no = signs)
$query{$param} = $value;
}
}
-
$c->request->query_parameters( \%query );
}
=head2 $self->prepare_read($c)
-prepare to read from the engine.
+Prepare to read by initializing the Content-Length from headers.
=cut
sub prepare_read {
my ( $self, $c ) = @_;
- # Initialize the read position
- $self->read_position(0);
-
# Initialize the amount of data we think we need to read
- $self->read_length( $c->request->header('Content-Length') || 0 );
+ $c->request->_read_length;
}
=head2 $self->prepare_request(@arguments)
sub prepare_request {
my ($self, $ctx, %args) = @_;
- $self->_set_env($args{env});
+ $ctx->request->_set_env($args{env});
+ $self->_set_env($args{env}); # Nasty back compat!
+ $ctx->response->_set_response_cb($args{response_cb});
}
=head2 $self->prepare_uploads($c)
}
}
-=head2 $self->prepare_write($c)
+=head2 $self->write($c, $buffer)
-Abstract method. Implemented by the engines.
+Writes the buffer to the client.
=cut
-sub prepare_write { }
+sub write {
+ my ( $self, $c, $buffer ) = @_;
+
+ $c->response->write($buffer);
+}
=head2 $self->read($c, [$maxlength])
sub read {
my ( $self, $c, $maxlength ) = @_;
- my $remaining = $self->read_length - $self->read_position;
- $maxlength ||= $CHUNKSIZE;
-
- # Are we done reading?
- if ( $remaining <= 0 ) {
- $self->finalize_read($c);
- return;
- }
-
- my $readlen = ( $remaining > $maxlength ) ? $maxlength : $remaining;
- my $rc = $self->read_chunk( $c, my $buffer, $readlen );
- if ( defined $rc ) {
- if (0 == $rc) { # Nothing more to read even though Content-Length
- # said there should be.
- $self->finalize_read;
- return;
- }
- $self->read_position( $self->read_position + $rc );
- return $buffer;
- }
- else {
- Catalyst::Exception->throw(
- message => "Unknown error reading input: $!" );
- }
+ $c->request->read($maxlength);
}
-=head2 $self->read_chunk($c, $buffer, $length)
+=head2 $self->read_chunk($c, \$buffer, $length)
Each engine implements read_chunk as its preferred way of reading a chunk
of data. Returns the number of bytes read. A return of 0 indicates that
sub read_chunk {
my ($self, $ctx) = (shift, shift);
- return $self->env->{'psgi.input'}->read(@_);
+ return $ctx->request->read_chunk(@_);
}
-=head2 $self->read_length
-
-The length of input data to be read. This is obtained from the Content-Length
-header.
-
-=head2 $self->read_position
-
-The amount of input data that has already been read.
-
=head2 $self->run($app, $server)
Start the engine. Builds a PSGI application and calls the
return sub {
my ($respond) = @_;
- $self->_set_response_cb($respond);
- $app->handle_request(env => $env);
+ $app->handle_request(env => $env, response_cb => $respond);
};
};
}
-=head2 $self->write($c, $buffer)
-
-Writes the buffer to the client.
-
-=cut
-
-sub write {
- my ( $self, $c, $buffer ) = @_;
-
- unless ( $self->_prepared_write ) {
- $self->prepare_write($c);
- $self->_prepared_write(1);
- }
-
- $buffer = q[] unless defined $buffer;
-
- my $len = length($buffer);
- $self->_writer->write($buffer);
-
- return $len;
-}
-
=head2 $self->unescape_uri($uri)
Unescapes a given URI using the most efficient method available. Engines such
catalyst.pl -force -scripts MyApp
-to update your scripts to not do this.\n");
+to update your scripts to not do this.\n") unless $ENV{HARNESS_ACTIVE};
1;
with 'MooseX::Emulate::Class::Accessor::Fast';
+has env => (is => 'ro', writer => '_set_env');
+# XXX Deprecated crap here - warn?
has action => (is => 'rw');
+# XXX: Deprecated in docs ages ago (2006), deprecated with warning in 5.8000 due
+# to confusion between Engines and Plugin::Authentication. Remove in 5.8100?
+has user => (is => 'rw');
+sub snippets { shift->captures(@_) }
+
+has _read_position => (
+ init_arg => undef,
+ is => 'ro',
+ writer => '_set_read_position',
+ default => 0,
+);
+has _read_length => (
+ init_arg => undef,
+ is => 'ro',
+ default => sub {
+ my $self = shift;
+ $self->header('Content-Length') || 0;
+ },
+ lazy => 1,
+);
+
has address => (is => 'rw');
has arguments => (is => 'rw', default => sub { [] });
-has cookies => (is => 'rw', default => sub { {} });
+has cookies => (is => 'ro', builder => 'prepare_cookies', lazy => 1);
+
+sub prepare_cookies {
+ my ( $self ) = @_;
+
+ if ( my $header = $self->header('Cookie') ) {
+ return { CGI::Simple::Cookie->parse($header) };
+ }
+ {};
+}
+
has query_keywords => (is => 'rw');
has match => (is => 'rw');
has method => (is => 'rw');
is => 'rw',
isa => 'HTTP::Headers',
handles => [qw(content_encoding content_length content_type header referer user_agent)],
- default => sub { HTTP::Headers->new() },
- required => 1,
+ builder => 'prepare_headers',
lazy => 1,
);
-has _context => (
- is => 'rw',
- weak_ref => 1,
- handles => ['read'],
- clearer => '_clear_context',
+sub prepare_headers {
+ my ($self) = @_;
+
+ my $env = $self->env;
+ my $headers = HTTP::Headers->new();
+
+ for my $header (keys %{ $env }) {
+ next unless $header =~ /^(HTTP|CONTENT|COOKIE)/i;
+ (my $field = $header) =~ s/^HTTPS?_//;
+ $field =~ tr/_/-/;
+ $headers->header($field => $env->{$header});
+ }
+ return $headers;
+}
+
+has _log => (
+ is => 'ro',
+ weak_ref => 1,
+ required => 1,
);
+# Amount of data to read from input on each pass
+our $CHUNKSIZE = 64 * 1024;
+
+sub read {
+ my ($self, $maxlength) = @_;
+ my $remaining = $self->_read_length - $self->_read_position;
+ $maxlength ||= $CHUNKSIZE;
+
+ # Are we done reading?
+ if ( $remaining <= 0 ) {
+ return;
+ }
+
+ my $readlen = ( $remaining > $maxlength ) ? $maxlength : $remaining;
+ my $rc = $self->read_chunk( my $buffer, $readlen );
+ if ( defined $rc ) {
+ if (0 == $rc) { # Nothing more to read even though Content-Length
+ # said there should be.
+ return;
+ }
+ $self->_set_read_position( $self->_read_position + $rc );
+ return $buffer;
+ }
+ else {
+ Catalyst::Exception->throw(
+ message => "Unknown error reading input: $!" );
+ }
+}
+
+sub read_chunk {
+ my $self = shift;
+ return $self->env->{'psgi.input'}->read(@_);
+}
+
has body_parameters => (
is => 'rw',
required => 1,
);
has parameters => (
- is => 'rw',
- required => 1,
- lazy => 1,
- default => sub { {} },
+ is => 'rw',
+ lazy => 1,
+ builder => 'prepare_parameters',
);
# TODO:
# these lazy build from there and kill all the direct hash access
# in Catalyst.pm and Engine.pm?
-before $_ => sub {
+sub prepare_parameters {
+ my ( $self ) = @_;
+
+ $self->prepare_body;
+ my $parameters = {};
+ my $body_parameters = $self->body_parameters;
+ my $query_parameters = $self->query_parameters;
+ # We copy, no references
+ foreach my $name (keys %$query_parameters) {
+ my $param = $query_parameters->{$name};
+ $parameters->{$name} = ref $param eq 'ARRAY' ? [ @$param ] : $param;
+ }
+
+ # Merge query and body parameters
+ foreach my $name (keys %$body_parameters) {
+ my $param = $body_parameters->{$name};
+ my @values = ref $param eq 'ARRAY' ? @$param : ($param);
+ if ( my $existing = $parameters->{$name} ) {
+ unshift(@values, (ref $existing eq 'ARRAY' ? @$existing : $existing));
+ }
+ $parameters->{$name} = @values > 1 ? \@values : $values[0];
+ }
+ $parameters;
+}
+
+before body_parameters => sub {
+ my ($self) = @_;
+ $self->prepare_body;
+ $self->prepare_body_parameters;
+};
+
+has _uploadtmp => (
+ is => 'ro',
+ predicate => '_has_uploadtmp',
+);
+
+sub prepare_body {
+ my ( $self ) = @_;
+
+ if ( my $length = $self->_read_length ) {
+ unless ( $self->_body ) {
+ my $type = $self->header('Content-Type');
+ $self->_body(HTTP::Body->new( $type, $length ));
+ $self->_body->cleanup(1); # Make extra sure!
+ $self->_body->tmpdir( $self->_uploadtmp )
+ if $self->_has_uploadtmp;
+ }
+
+ # Check for definedness as you could read '0'
+ while ( defined ( my $buffer = $self->read() ) ) {
+ $self->prepare_body_chunk($buffer);
+ }
+
+ # paranoia against wrong Content-Length header
+ my $remaining = $length - $self->_read_position;
+ if ( $remaining > 0 ) {
+ Catalyst::Exception->throw(
+ "Wrong Content-Length value: $length" );
+ }
+ }
+ else {
+ # Defined but will cause all body code to be skipped
+ $self->_body(0);
+ }
+}
+
+sub prepare_body_chunk {
+ my ( $self, $chunk ) = @_;
+
+ $self->_body->add($chunk);
+}
+
+sub prepare_body_parameters {
+ my ( $self ) = @_;
+
+ return unless $self->_body;
+
+ $self->{body_parameters} = $self->_body->param; # FIXME!! Recursion here.
+}
+
+sub prepare_connection {
my ($self) = @_;
- my $context = $self->_context || return;
- $context->prepare_body;
-} for qw/parameters body_parameters/;
+ my $env = $self->env;
+
+ $self->address( $env->{REMOTE_ADDR} );
+ $self->hostname( $env->{REMOTE_HOST} )
+ if exists $env->{REMOTE_HOST};
+ $self->protocol( $env->{SERVER_PROTOCOL} );
+ $self->remote_user( $env->{REMOTE_USER} );
+ $self->method( $env->{REQUEST_METHOD} );
+ $self->secure( $env->{'psgi.url_scheme'} eq 'https' ? 1 : 0 );
+}
+
+# XXX - FIXME - method is here now, move this crap...
around parameters => sub {
my ($orig, $self, $params) = @_;
if ($params) {
if ( !ref $params ) {
- $self->_context->log->warn(
+ $self->_log->warn(
"Attempt to retrieve '$params' with req->params(), " .
"you probably meant to call req->param('$params')"
);
# and provide a custom reader..
sub body {
my $self = shift;
- $self->_context->prepare_body();
+ $self->prepare_body();
croak 'body is a reader' if scalar @_;
return blessed $self->_body ? $self->_body->body : $self->_body;
}
has _path => ( is => 'rw', predicate => '_has_path', clearer => '_clear_path' );
-# XXX: Deprecated in docs ages ago (2006), deprecated with warning in 5.8000 due
-# to confusion between Engines and Plugin::Authentication. Remove in 5.8100?
-has user => (is => 'rw');
-
sub args { shift->arguments(@_) }
sub body_params { shift->body_parameters(@_) }
sub input { shift->body(@_) }
sub params { shift->parameters(@_) }
sub query_params { shift->query_parameters(@_) }
sub path_info { shift->path(@_) }
-sub snippets { shift->captures(@_) }
=for stopwords param params
=head1 SYNOPSIS
$req = $c->request;
- $req->action;
- $req->address;
+ $req->address eq "127.0.0.1";
$req->arguments;
$req->args;
$req->base;
$req->read;
$req->referer;
$req->secure;
- $req->captures; # previously knows as snippets
+ $req->captures;
$req->upload;
$req->uploads;
$req->uri;
=head1 METHODS
-=head2 $req->action
-
-[DEPRECATED] Returns the name of the requested action.
-
-
-Use C<< $c->action >> instead (which returns a
-L<Catalyst::Action|Catalyst::Action> object).
-
=head2 $req->address
Returns the IP address of the client.
used in a while loop, reading $maxlength bytes on every call. $maxlength
defaults to the size of the request if not specified.
+=head2 $req->read_chunk(\$buff, $max)
+
+Reads a chunk..
+
You have to set MyApp->config(parse_on_demand => 1) to use this directly.
=head2 $req->referer
my @captures = @{ $c->request->captures };
-=head2 $req->snippets
-
-C<captures> used to be called snippets. This is still available for backwards
-compatibility, but is considered deprecated.
-
=head2 $req->upload
A convenient method to access $req->uploads.
Shortcut to $req->headers->user_agent. Returns the user agent (browser)
version string.
+=head1 SETUP METHODS
+
+You should never need to call these yourself in application code,
+however they are useful if extending Catalyst by applying a request role.
+
+=head2 $self->prepare_headers()
+
+Sets up the C<< $res->headers >> accessor.
+
+=head2 $self->prepare_body()
+
+Sets up the body using L<HTTP::Body>
+
+=head2 $self->prepare_body_chunk()
+
+Add a chunk to the request body.
+
+=head2 $self->prepare_body_parameters()
+
+Sets up parameters from body.
+
+=head2 $self->prepare_cookies()
+
+Parse cookies from header. Sets up a L<CGI::Simple::Cookie> object.
+
+=head2 $self->prepare_connection()
+
+Sets up various fields in the request like the local and remote addresses,
+request method, hostname requested etc.
+
+=head2 $self->prepare_parameters()
+
+Ensures that the body has been parsed, then builds the parameters, which are
+combined from those in the request and those in the body.
+
+This method is the builder for the 'parameters' attribute.
+
=head2 meta
Provided by Moose
use Moose;
use HTTP::Headers;
+use Moose::Util::TypeConstraints;
+use namespace::autoclean;
with 'MooseX::Emulate::Class::Accessor::Fast';
+has _response_cb => (
+ is => 'ro',
+ isa => 'CodeRef',
+ writer => '_set_response_cb',
+ clearer => '_clear_response_cb',
+ predicate => '_has_response_cb',
+);
+
+subtype 'Catalyst::Engine::Types::Writer',
+ as duck_type([qw(write close)]);
+
+has _writer => (
+ is => 'ro',
+ isa => 'Catalyst::Engine::Types::Writer',
+ writer => '_set_writer',
+ clearer => '_clear_writer',
+ predicate => '_has_writer',
+);
+
+sub DEMOLISH { $_[0]->_writer->close if $_[0]->_has_writer }
+
has cookies => (is => 'rw', default => sub { {} });
has body => (is => 'rw', default => undef);
sub has_body { defined($_[0]->body) }
required => 1,
lazy => 1,
);
-has _context => (
- is => 'rw',
- weak_ref => 1,
- handles => ['write'],
- clearer => '_clear_context',
-);
sub output { shift->body(@_) }
sub code { shift->status(@_) }
-no Moose;
+sub write {
+ my ( $self, $buffer ) = @_;
+
+ # Finalize headers if someone manually writes output
+ $self->finalize_headers;
+
+ $buffer = q[] unless defined $buffer;
+
+ my $len = length($buffer);
+ $self->_writer->write($buffer);
+
+ return $len;
+}
+
+sub finalize_headers {
+ my ($self) = @_;
+
+ # This is a less-than-pretty hack to avoid breaking the old
+ # Catalyst::Engine::PSGI. 5.9 Catalyst::Engine sets a response_cb and
+ # expects us to pass headers to it here, whereas Catalyst::Enngine::PSGI
+ # just pulls the headers out of $ctx->response in its run method and never
+ # sets response_cb. So take the lack of a response_cb as a sign that we
+ # don't need to set the headers.
+
+ return unless $self->_has_response_cb;
+
+ # If we already have a writer, we already did this, so don't do it again
+ return if $self->_has_writer;
+
+ my @headers;
+ $self->headers->scan(sub { push @headers, @_ });
+
+ my $writer = $self->_response_cb->([ $self->status, \@headers ]);
+ $self->_set_writer($writer);
+ $self->_clear_response_cb;
+
+ return;
+}
=head1 NAME
Writes $data to the output stream.
-=head2 meta
-
-Provided by Moose
-
=head2 $res->print( @data )
Prints @data to the output stream, separated by $,. This lets you pass
the response object to functions that want to write to an L<IO::Handle>.
+=head2 $self->finalize_headers($c)
+
+Writes headers to response if not already written
+
+=head2 DEMOLISH
+
+Ensures that the response is flushed and closed at the end of the
+request.
+
+=head2 meta
+
+Provided by Moose
+
=cut
sub print {
ok( my $response = request($request), 'Request' );
ok( $response->is_success, 'Response Successful 2xx' );
-
{
no strict 'refs';
ok(
$EXPECTED_ENV_VAL = "Test env value " . rand(100000);
}
-use Test::More tests => 7;
+use Test::More;
use Catalyst::Test 'TestApp';
use Catalyst::Request;
use HTTP::Headers;
use HTTP::Request::Common;
-{
- my $response = request("http://localhost/dump/env", {
+foreach my $path (qw/ env env_on_engine /) {
+ my $response = request("http://localhost/dump/${path}", {
extra_env => { $EXPECTED_ENV_VAR => $EXPECTED_ENV_VAL },
});
my $env;
ok( eval '$env = ' . $response->content, 'Unserialize Catalyst::Request' );
is ref($env), 'HASH';
- ok exists($env->{PATH_INFO}), 'Have a PATH_INFO env var';
+ ok exists($env->{PATH_INFO}), 'Have a PATH_INFO env var for ' . $path;
SKIP:
{
skip 'Using remote server', 1;
}
is $env->{$EXPECTED_ENV_VAR}, $EXPECTED_ENV_VAL,
- 'Value we set as expected';
+ 'Value we set as expected for ' . $path;
}
}
+done_testing;
+
{
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' );
+ ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' )
+ or diag("Exception '$@', content " . $response->content);
like( $creq->uri, qr{/my/app/lives/here$}, 'URI contains new path' );
}
use Moose::Meta::Class;
#use Moose::Meta::Attribute;
use Catalyst::Request;
+use Catalyst::Log;
use_ok('Catalyst::Action');
request => (
reader => 'request',
required => 1,
- default => sub { Catalyst::Request->new(arguments => [qw/one two/]) },
+ default => sub { Catalyst::Request->new(_log => Catalyst::Log->new, arguments => [qw/one two/]) },
),
),
],
use_ok('TestApp');
my $request = Catalyst::Request->new( {
+ _log => Catalyst::Log->new,
base => URI->new('http://127.0.0.1/foo')
} );
my $dispatcher = TestApp->dispatcher;
PATH_INFO => '/',
);
- my $engine = Catalyst::Engine->new(
- env => { %template, @_ },
- );
+ my $engine = Catalyst::Engine->new();
my $i = TestApp->new;
$i->setup_finished(0);
$i->config(use_request_uri_for_path => $use_request_uri_for_path);
$i->setup_finished(1);
+ $engine->prepare_request($i, env => { %template, @_ }, response_cb => sub {});
$engine->prepare_path($i);
return $i->req;
}
use_ok('TestApp');
my $request = Catalyst::Request->new( {
+ _log => Catalyst::Log->new,
base => URI->new('http://127.0.0.1/foo')
} );
my $dispatcher = TestApp->dispatcher;
# Tests with Context
#
my $request = Catalyst::Request->new( {
+ _log => Catalyst::Log->new,
base => URI->new('http://127.0.0.1/foo')
} );
my $base = 'http://127.0.0.1';
my $request = Catalyst::Request->new({
+ _log => Catalyst::Log->new,
base => URI->new($base),
uri => URI->new("$base/"),
});
use strict;
use warnings;
-use Test::More tests => 10;
+use Test::More;
use URI;
+use Catalyst::Log;
use_ok('Catalyst::Request');
my $request = Catalyst::Request->new( {
+ _log => Catalyst::Log->new,
uri => URI->new('http://127.0.0.1/foo/bar/baz')
} );
);
my $request2 = Catalyst::Request->new( {
+ _log => Catalyst::Log->new,
uri => URI->new('http://127.0.0.1/foo/bar/baz?bar=gorch')
} );
is(
'append mode URI appends arrayref param'
);
+done_testing;
+
foreach my $module (@modules) {
local @private = (@private, 'run') if $module =~ /^Catalyst::Script::/;
local @private = (@private, 'plugin') if $module =~ /^Catalyst$/;
+ local @private = (@private, 'snippets') if $module =~ /^Catalyst::Request$/;
+ local @private = (@private, 'prepare_connection') if $module =~ /^Catalyst::Engine$/;
+
pod_coverage_ok($module, {
also_private => \@private,
coverage_class => 'Pod::Coverage::TrustPod',
sub env : Action Relative {
my ( $self, $c ) = @_;
+ $c->stash(env => $c->req->env);
+ $c->forward('TestApp::View::Dump::Env');
+}
+
+sub env_on_engine : Action Relative {
+ my ( $self, $c ) = @_;
+ $c->stash(env => $c->engine->env);
$c->forward('TestApp::View::Dump::Env');
}
$dumper->Quotekeys(0);
$dumper->Terse(1);
+ local $SIG{ __WARN__ } = sub { warn unless $_[ 0 ] =~ m{dummy} };
return $dumper->Dump;
}
sub process {
my ( $self, $c ) = @_;
- my $env = $c->engine->env;
+ my $env = $c->stash->{env};
return $self->SUPER::process($c, {
map { ($_ => $env->{$_}) }
grep { $_ ne 'psgi.input' }
sub process {
my ( $self, $c ) = @_;
- return $self->SUPER::process( $c, $c->request );
+ my $r = $c->request;
+ local $r->{env};
+ return $self->SUPER::process( $c, $r );
}
1;
sub process {
my ( $self, $c ) = @_;
- return $self->SUPER::process( $c, $c->response );
+ my $r = $c->response;
+ local $r->{_writer};
+ local $r->{_reponse_cb};
+ return $self->SUPER::process( $c, $r );
}
1;
projects / catagits/Catalyst-Runtime.git / commitdiff