# This file documents the revision history for Perl extension Catalyst.
+ - Announcing the repo is now open for development of Perl Catalyst 'Runner'
+ - http://questhub.io/realm/perl/explore/latest/tag/runner
+
+5.90059_006 - TBA
+ - MyApp->setup now returns $app to allow class method chaining.
+ - New Util helper functional localize $env to make it easier to mount PSIG
+ applications under controllers and actions. See Catalyst::Utils/PSGI Helpers.
+
+5.90059_005 - 2014-01-28
+ - Specify newest versions of some middleware in attempt to solve test errors
+ reported while installing.
+5.90059_004 - 2014-01-27
+ - Make sure IO handle objects do 'getline' before sending them to the
+ response callback, to properly support the PSGI specification.
+ - Added some backcompat code when setting a response body to an object
+ that does 'read' but not 'getline'. Added deprecation notice for this
+ case. Added docs to Catalyst::Delta.
+ - Catalyst::Delta contains a list of behaviors which will be considered
+ deprecated immediatelty. Most items have workarounds and tweaks you can
+ make to avoid issues. These deprecations are targeted for removal/enforcement
+ in the Catalyst 6 release. Please review and give your feedback.
+ - More middleware to replace inline code (upasana++)
+ - Documentation around Exceptions and how we handle them.
+ - update copyright notices.
+
+5.90059_003 - 2013-12-24
+ - More documentation about alternative ways to setup middleware.
+ - removed unneeded use of Devel::Dwarn in test case that was causing
+ fails to install (sorry).
+ - When finalizing caught errors, if the error conforms to the interface as
+ described by Plack::Middleware::HTTPExceptions, rethrow it and let the
+ middleware deal with it.
+
+5.90059_002 - 2013-12-21
+ - We now pass a scalar or filehandle directly to you Plack handler, rather
+ than always use the streaming interface (we are still always using a
+ delayed response callback). This means that you can make use of Plack
+ middleware like Plack::Middleware::XSendfile and we expect better use of
+ server features (when they exist) like correct use of chunked encoding or
+ properly non blocking streaming when running under a supporting server like
+ Twiggy. See Catalyst::Delta for more. This change might cause issues if
+ you are making heaving use of streaming (although in general we expect things
+ to work much better.
+ - In the case when we remove a content body from the response because you set
+ an information status or a no content type status, warn that we are doing so
+ when in debug mode. You might see additional debugging information to help
+ you find and remove unneeded response bodies.
+ - Updated the code where Catalyst tries to guess a content length when you
+ fail to provide one. This should cause less issues when trying to guess the
+ length of a funky filehandle. This now uses Plack::Middleware::ContentLength
+ - Removed custom code to remove body content when the request is HEAD and
+ swapped it for Plack::Middleware::Head
+ - Merged fix for regressions from stable..
+
+5.90059_001 - 2013-12-19
+ - Removed deprecated Regexp dispatch type from dependency list. If you are
+ using Regex[p] type dispatching you need to add the standalone distribution
+ 'Catalyst::DispatchType::Regex' to you build system NOW or you application
+ will be broken.
+
5.90053 - 2013-12-21
- Reverted a change in the previous release that moved the setup_log phase
to after setup_config. This change was made to allow people to use
requires 'Hash::MultiValue';
requires 'Plack::Request::Upload';
requires 'CGI::Struct';
-
-# Install the standalone Regex dispatch modules in order to ease the
-# deprecation transition
-requires 'Catalyst::DispatchType::Regex' => '5.90021';
+requires "Plack::Middleware::Conditional";
+requires "Plack::Middleware::IIS6ScriptNameFix";
+requires "Plack::Middleware::IIS7KeepAliveFix";
+requires "Plack::Middleware::LighttpdScriptNameFix";
+requires "Plack::Middleware::ContentLength";
+requires "Plack::Middleware::Head";
+requires "Plack::Middleware::HTTPExceptions";
+requires "Plack::Middleware::FixMissingBodyInRedirect" => '0.09';
+requires "Plack::Middleware::MethodOverride";
+requires "Plack::Middleware::RemoveRedundantBody" => '0.03';
test_requires 'Test::Fatal';
test_requires 'Test::More' => '0.88';
use Plack::Middleware::IIS6ScriptNameFix;
use Plack::Middleware::IIS7KeepAliveFix;
use Plack::Middleware::LighttpdScriptNameFix;
+use Plack::Middleware::ContentLength;
+use Plack::Middleware::Head;
+use Plack::Middleware::HTTPExceptions;
+use Plack::Middleware::FixMissingBodyInRedirect;
+use Plack::Middleware::MethodOverride;
+use Plack::Middleware::RemoveRedundantBody;
use Plack::Util;
use Class::Load 'load_class';
# Remember to update this in Catalyst::Runtime as well!
-our $VERSION = '5.90053';
+our $VERSION = '5.90059_005';
sub import {
my ( $class, @arguments ) = @_;
# Should be the last thing we do so that user things hooking
# setup_finalize can log..
$class->log->_flush() if $class->log->can('_flush');
- return 1; # Explicit return true as people have __PACKAGE__->setup as the last thing in their class. HATE.
+ return $class || 1; # Just in case someone named their Application 0...
}
=head2 $app->setup_finalize
$c->finalize_headers unless $c->response->finalized_headers;
- # HEAD request
- if ( $c->request->method eq 'HEAD' ) {
- $c->response->body('');
- }
-
$c->finalize_body;
}
=head2 $c->finalize_error
-Finalizes error.
+Finalizes error. If there is only one error in L</error> and it is an object that
+does C<as_psgi> or C<code> we rethrow the error and presume it caught by middleware
+up the ladder. Otherwise we return the debugging error page (in debug mode) or we
+return the default error page (production mode).
=cut
-sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
+sub finalize_error {
+ my $c = shift;
+ if($#{$c->error} > 0) {
+ $c->engine->finalize_error( $c, @_ );
+ } else {
+ my ($error) = @{$c->error};
+ if(
+ blessed $error &&
+ ($error->can('as_psgi') || $error->can('code'))
+ ) {
+ # In the case where the error 'knows what it wants', becauses its PSGI
+ # aware, just rethow and let middleware catch it
+ $error->can('rethrow') ? $error->rethrow : croak $error;
+ croak $error;
+ } else {
+ $c->engine->finalize_error( $c, @_ )
+ }
+ }
+}
=head2 $c->finalize_headers
if ( my $location = $response->redirect ) {
$c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
$response->header( Location => $location );
-
- if ( !$response->has_body ) {
- # Add a default body if none is already present
- my $encoded_location = encode_entities($location);
- $response->body(<<"EOF");
-<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
-<html xmlns="http://www.w3.org/1999/xhtml">
- <head>
- <title>Moved</title>
- </head>
- <body>
- <p>This item has moved <a href="$encoded_location">here</a>.</p>
- </body>
-</html>
-EOF
- $response->content_type('text/html; charset=utf-8');
- }
- }
-
- # Content-Length
- if ( defined $response->body && length $response->body && !$response->content_length ) {
-
- # get the length from a filehandle
- if ( blessed( $response->body ) && $response->body->can('read') || ref( $response->body ) eq 'GLOB' )
- {
- my $size = -s $response->body;
- if ( $size ) {
- $response->content_length( $size );
- }
- else {
- $c->log->warn('Serving filehandle without a content-length');
- }
- }
- else {
- # everything should be bytes at this point, but just in case
- $response->content_length( length( $response->body ) );
- }
}
- # Errors
- if ( $response->status =~ /^(1\d\d|[23]04)$/ ) {
- $response->headers->remove_header("Content-Length");
- $response->body('');
- }
+ # Remove incorrectly added body and content related meta data when returning
+ # an information response, or a response the is required to not include a body
$c->finalize_cookies;
my $c = $class->prepare(@arguments);
$c->dispatch;
$status = $c->finalize;
- }
- catch {
+ } catch {
chomp(my $error = $_);
$class->log->error(qq/Caught exception in engine "$error"/);
+ #rethow if this can be handled by middleware
+ if(blessed $error && ($error->can('as_psgi') || $error->can('code'))) {
+ $error->can('rethrow') ? $error->rethrow : croak $error;
+ }
};
$COUNT++;
sub registered_middlewares {
my $class = shift;
if(my $middleware = $class->_psgi_middleware) {
- return @$middleware;
+ return (
+ Plack::Middleware::HTTPExceptions->new,
+ Plack::Middleware::RemoveRedundantBody->new,
+ Plack::Middleware::FixMissingBodyInRedirect->new,
+ Plack::Middleware::ContentLength->new,
+ Plack::Middleware::MethodOverride->new,
+ Plack::Middleware::Head->new,
+ @$middleware);
} else {
die "You cannot call ->registered_middlewares until middleware has been setup";
}
=back
+=head1 EXCEPTIONS
+
+Generally when you throw an exception inside an Action (or somewhere in
+your stack, such as in a model that an Action is calling) that exception
+is caught by Catalyst and unless you either catch it yourself (via eval
+or something like L<Try::Tiny> or by reviewing the L</error> stack, it
+will eventually reach L</finalize_errors> and return either the debugging
+error stack page, or the default error page. However, if your exception
+can be caught by L<Plack::Middleware::HTTPExceptions>, L<Catalyst> will
+instead rethrow it so that it can be handled by that middleware (which
+is part of the default middleware). For example this would allow
+
+ use HTTP::Throwable::Factory 'http_throw';
+
+ sub throws_exception :Local {
+ my ($self, $c) = @_;
+
+ http_throw(SeeOther => { location =>
+ $c->uri_for($self->action_for('redirect')) });
+
+ }
+
=head1 INTERNAL ACTIONS
Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>,
Where C<@middleware> is one or more of the following, applied in the REVERSE of
the order listed (to make it function similarly to L<Plack::Builder>:
+
+Alternatively, you may also define middleware by calling the L</setup_middleware>
+package method:
+
+ package MyApp::Web;
+
+ use Catalyst;
+
+ __PACKAGE__->setup_middleware( \@middleware_definitions);
+ __PACKAGE__->setup;
+
+In the case where you do both (use 'setup_middleware' and configuration) the
+package call to setup_middleware will be applied earlier (in other words its
+middleware will wrap closer to the application). Keep this in mind since in
+some cases the order of middleware is important.
+
+The two approaches are not exclusive.
=over 4
dd070: Dhaval Dhanani <dhaval070@gmail.com>
+Upasana <me@upasana.me>
+
=head1 COPYRIGHT
-Copyright (c) 2005, the above named PROJECT FOUNDER and CONTRIBUTORS.
+Copyright (c) 2005-2014, the above named PROJECT FOUNDER and CONTRIBUTORS.
=head1 LICENSE
around ['match','match_captures'] => sub {
my ($orig, $self, $ctx, @args) = @_;
- my $expected = $self->_normalize_expected_http_method($ctx->req);
+ my $expected = $ctx->req->method;
return $self->_has_expected_http_method($expected) ?
$self->$orig($ctx, @args) :
0;
};
-sub _normalize_expected_http_method {
- my ($self, $req) = @_;
- return $req->header('X-HTTP-Method') ||
- $req->header('X-HTTP-Method-Override') ||
- $req->header('X-METHOD-OVERRIDE') ||
- $req->header('x-tunneled-method') ||
- $req->method;
-}
sub _has_expected_http_method {
my ($self, $expected) = @_;
HTTP methods, such as GET, POST, etc.
Since most web browsers have limited support for rich HTTP Method vocabularies
-we also support setting the expected match method via the follow non standard
-but widely used http extensions. Our support for these should not be taken as
-an endorsement of the technique. Rt is merely a reflection of our desire to
-work well with existing systems and common client side tools.
-
-=over 4
-
-=item X-HTTP-Method (Microsoft)
-
-=item X-HTTP-Method-Override (Google/GData)
-
-=item X-METHOD-OVERRIDE (IBM)
-
-=item x-tunneled-method (used in many other similar systems on CPAN
-
-=back
-
-Please note the insanity of overriding a GET request with a DELETE override...
-Rational practices suggest that using POST with overrides to emulate PUT and
-DELETE can be an acceptable way to deal with client limitations and security
-rules on your proxy server. I recommend going no further.
+we use L<Plack::Middleware::MethodOverride> which allows you to 'tunnel' your
+request method over POST This works in two ways. You can set an extension
+HTTP header C<X-HTTP-Method-Override> which will contain the value of the
+desired request method, or you may set a search query parameter
+C<x-tunneled-method>. Remember, these only work over HTTP Request type
+POST. See L<Plack::Middleware::MethodOverride> for more.
=head1 REQUIRES
=head1 DESCRIPTION
-This is an overview of the user-visible changes to Catalyst between major Catalyst releases.
+This is an overview of the user-visible changes to Catalyst between major
+Catalyst releases.
+
+=head2 VERSION 5.90060+
+
+=head3 Support passing Body filehandles directly to your Plack server.
+
+We changed the way we return body content (from response) to whatever
+Plack handler you are using (Starman, FastCGI, etc.) We no longer
+always use the streaming interface for the cases when the body is a
+simple scalar, object or filehandle like. In those cases we now just
+pass the simple response on to the plack handler. This might lead to
+some minor differences in how streaming is handled. For example, you
+might notice that streaming starts properly supportubg chunked encoding when
+on a server that supports that, or that previously missing headers
+(possible content-length) might appear suddenly correct. Also, if you
+are using middleware like L<Plack::Middleware::XSendfile> and are using
+a filehandle that sets a readable path, your server might now correctly
+handle the file (rather than as before where Catalyst would stream it
+very likely very slowly).
+
+In other words, some things might be meaninglessly different and some
+things that were broken codewise but worked because of Catalyst being
+incorrect might suddenly be really broken. The behavior is now more
+correct in that Catalyst plays better with features that Plack offers
+but if you are making heavy use of the streaming interface there could
+be some differences so you should test carefully (this is probably not
+the vast majority of people). In particular if you are developing
+using one server but deploying using a different one, differences in
+what those server do with streaming should be noted.
+
+Please see note below about changes to filehandle support and existing
+Plack middleware to aid in back compatibility.
+
+=head3 Distinguish between body null versus undef.
+
+We also now more carefully distingush the different between a body set
+to '' and a body that is undef. This might lead to situations where
+again you'll get a content-length were you didn't get one before or
+where a supporting server will start chunking output. If this is an
+issue you can apply the middleware L<Plack::Middleware::BufferedStreaming>
+or report specific problems to the dev team.
+
+=head3 More Catalyst Middleware
+
+We have started migrating code in Catalyst to equivilent Plack
+Middleware when such exists and is correct to do so. For example we now use
+L<Plack::Middleware::ContentLength> to determine content length of a response
+when none is provided. This replaces similar code inlined with L<Catalyst>
+The main advantages to doing this is 1) more similar Catalyst core that is
+focused on the Catalyst special sauce, 2) Middleware is more broadly shared
+so we benefit from better collaboration with developers outside Catalyst, 3)
+In the future you'll be able to change or trim the middleware stack to get
+additional performance when you don't need all the checks and constraints.
+
+=head3 Deprecation of Filehandle like objects that do read but not getline
+
+We also deprecated setting the response body to an object that does 'read'
+but not 'getline'. If you are using a custom IO-Handle like object for
+response you should verify that 'getline' is supported in your interface.
+Unless we here this case is a major issue for people, we will be removing support
+in a near future release of Catalyst. When the code encounters this it
+will issue a warning. You also may run into this issue with L<MogileFS::Client>
+which does read but not getline. For now we will just warn when encountering
+such an object and fallback to the previous behavior (where L<Catalyst::Engine>
+itself unrolls the filehandle and performs blocking streams). However
+this backcompat will be removed in an upcoming release so you should either
+rewrite your custom filehandle objects to support getline or start using the
+middleware that adapts read for getline L<Plack::Middleware::AdaptFilehandleRead>.
+
+=head3 Response->headers become readonly after finalizing
+
+Once the response headers are finalized, trying to change them is not allowed
+(in the past you could change them and this would lead to unexpected results).
+
+=head3 Offically deprecation of L<Catalyst::Engine::PSGI>
+
+L<Catalyst::Engine::PSGI> is also officially no longer supported. We will
+no long run test cases against this and can remove backcompat code for it
+as deemed necessary for the evolution of the platform. You should simple
+discontinue use of this engine, as L<Catalyst> has been PSGI at the core
+for several years.
+
+=head2 Officially deprecate finding the PSGI $env anyplace other than Request
+
+A few early releases of Cataplack had the PSGI $env in L<Catalyst::Engine>.
+Code has been maintained here for backcompat reasons. This is no longer
+supported and will be removed in upcoming release, so you should update
+your code and / or upgrade to a newer version of L<Catalyst>
+
+=head2 Deprecate setting Response->body after using write/write_fh
+
+Setting $c->res->body to a filehandle after using $c->res->write or
+$c->res->write_fh is no longer considered allowed, since we can't send
+the filehandle to the underlying Plack handler. For now we will continue
+to support setting body to a simple value since this is possible, but at
+some future release a choice to use streaming indicates that you will do
+so for the rest of the request.
+
=head2 VERSION 5.90053
sub finalize_body {
my ( $self, $c ) = @_;
- return if $c->response->_has_write_fh;
-
- my $body = $c->response->body;
- no warnings 'uninitialized';
- if ( blessed($body) && $body->can('read') or ref($body) eq 'GLOB' ) {
- my $got;
- do {
- $got = read $body, my ($buffer), $CHUNKSIZE;
- $got = 0 unless $self->write( $c, $buffer );
- } while $got > 0;
-
- close $body;
- }
- else {
- $self->write( $c, $body );
- }
+ my $res = $c->response; # We use this all over
+
+ ## If we've asked for the write 'filehandle' that means the application is
+ ## doing something custom and is expected to close the response
+ return if $res->_has_write_fh;
+
+ my $body = $res->body; # save some typing
+ if($res->_has_response_cb) {
+ ## we have not called the response callback yet, so we are safe to send
+ ## the whole body to PSGI
+
+ my @headers;
+ $res->headers->scan(sub { push @headers, @_ });
+
+ # We need to figure out what kind of body we have and normalize it to something
+ # PSGI can deal with
+ if(defined $body) {
+ # Handle objects first
+ if(blessed($body)) {
+ if($body->can('getline')) {
+ # Body is an IO handle that meets the PSGI spec. Nothing to normalize
+ } elsif($body->can('read')) {
+
+ # In the past, Catalyst only looked for ->read not ->getline. It is very possible
+ # that one might have an object that respected read but did not have getline.
+ # As a result, we need to handle this case for backcompat.
+
+ # We will just do the old loop for now. In a future version of Catalyst this support
+ # will be removed and one will have to rewrite their custom object or use
+ # Plack::Middleware::AdaptFilehandleRead. In anycase support for this is officially
+ # deprecated and described as such as of 5.90060
+
+ my $got;
+ do {
+ $got = read $body, my ($buffer), $CHUNKSIZE;
+ $got = 0 unless $self->write($c, $buffer );
+ } while $got > 0;
+
+ close $body;
+ return;
+ } else {
+ # Looks like for backcompat reasons we need to be able to deal
+ # with stringyfiable objects.
+ $body = ["$body"];
+ }
+ } elsif(ref $body) {
+ if( (ref($body) eq 'GLOB') or (ref($body) eq 'ARRAY')) {
+ # Again, PSGI can just accept this, no transform needed. We don't officially
+ # document the body as arrayref at this time (and there's not specific test
+ # cases. we support it because it simplifies some plack compatibility logic
+ # and we might make it official at some point.
+ } else {
+ $c->log->error("${\ref($body)} is not a valid value for Response->body");
+ return;
+ }
+ } else {
+ # Body is defined and not an object or reference. We assume a simple value
+ # and wrap it in an array for PSGI
+ $body = [$body];
+ }
+ } else {
+ # There's no body...
+ $body = [];
+ }
+
+ $res->_response_cb->([ $res->status, \@headers, $body]);
+ $res->_clear_response_cb;
+
+ } else {
+ ## Now, if there's no response callback anymore, that means someone has
+ ## called ->write in order to stream 'some stuff along the way'. I think
+ ## for backcompat we still need to handle a ->body. I guess I could see
+ ## someone calling ->write to presend some stuff, and then doing the rest
+ ## via ->body, like in a template.
+
+ ## We'll just use the old, existing code for this (or most of it)
+
+ if(my $body = $res->body) {
+
+ if ( blessed($body) && $body->can('read') or ref($body) eq 'GLOB' ) {
+
+ ## In this case we have no choice and will fall back on the old
+ ## manual streaming stuff. Not optimal. This is deprecated as of 5.900560+
+
+ my $got;
+ do {
+ $got = read $body, my ($buffer), $CHUNKSIZE;
+ $got = 0 unless $self->write($c, $buffer );
+ } while $got > 0;
+
+ close $body;
+ }
+ else {
+
+ # Case where body was set afgter calling ->write. We'd prefer not to
+ # support this, but I can see some use cases with the way most of the
+ # views work.
+
+ $self->write($c, $body );
+ }
+ }
- my $res = $c->response;
- $res->_writer->close;
- $res->_clear_writer;
+ $res->_writer->close;
+ $res->_clear_writer;
+ }
return;
}
$req->uri;
$req->user;
$req->user_agent;
+ $req->env;
See also L<Catalyst>, L<Catalyst::Request::Upload>.
If parameters have already been set will clear the parameters and build them again.
+=head2 $self->env
+
+Access to the raw PSGI env.
=head2 meta
has _response_cb => (
is => 'ro',
- isa => 'CodeRef',
+ isa => 'CodeRef',
writer => '_set_response_cb',
clearer => '_clear_response_cb',
predicate => '_has_response_cb',
has _writer => (
is => 'ro',
- isa => 'Catalyst::Engine::Types::Writer',
- writer => '_set_writer',
+ isa => 'Catalyst::Engine::Types::Writer', #Pointless since we control how this is built
+ #writer => '_set_writer', Now that its lazy I think this is safe to remove
clearer => '_clear_writer',
predicate => '_has_writer',
+ lazy => 1,
+ builder => '_build_writer',
);
+sub _build_writer {
+ my $self = shift;
+
+ ## These two lines are probably crap now...
+ $self->_context->finalize_headers unless
+ $self->finalized_headers;
+
+ my @headers;
+ $self->headers->scan(sub { push @headers, @_ });
+
+ my $writer = $self->_response_cb->([ $self->status, \@headers ]);
+ $self->_clear_response_cb;
+
+ return $writer;
+}
+
has write_fh => (
is=>'ro',
predicate=>'_has_write_fh',
builder=>'_build_write_fh',
);
-sub _build_write_fh {
- my $self = shift;
- $self->_context->finalize_headers unless
- $self->finalized_headers;
- $self->_writer;
-};
+sub _build_write_fh { shift ->_writer }
sub DEMOLISH {
my $self = shift;
clearer => '_clear_context',
);
+before [qw(status headers content_encoding content_length content_type header)] => sub {
+ my $self = shift;
+
+ $self->_context->log->warn(
+ "Useless setting a header value after finalize_headers called." .
+ " Not what you want." )
+ if ( $self->finalized_headers && @_ );
+};
+
sub output { shift->body(@_) }
sub code { shift->status(@_) }
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;
}
my ($status, $headers, $body) = @$psgi_res;
$self->status($status);
$self->headers(HTTP::Headers->new(@$headers));
- if(ref $body eq 'ARRAY') {
- $self->body(join '', grep defined, @$body);
- } else {
- $self->body($body);
- }
+ $self->body($body);
} elsif(ref $psgi_res eq 'CODE') {
$psgi_res->(sub {
my $response = shift;
my ($status, $headers, $maybe_body) = @$response;
$self->status($status);
$self->headers(HTTP::Headers->new(@$headers));
- if($maybe_body) {
- if(ref $maybe_body eq 'ARRAY') {
- $self->body(join '', grep defined, @$maybe_body);
- } else {
- $self->body($maybe_body);
- }
+ if(defined $maybe_body) {
+ $self->body($maybe_body);
} else {
return $self->write_fh;
}
# Remember to update this in Catalyst as well!
-our $VERSION = '5.90053';
+our $VERSION = '5.90059_005';
=head1 NAME
Catalyst::Upgrading - Instructions for upgrading to the latest Catalyst
+=head1 Upgrading to Catalyst 5.90060
+
+Starting in the v5.90059_001 development release, the regexp dispatch type is
+no longer automatically included as a dependency. If you are still using this
+dispatch type, you need to add L<Catalyst::DispatchType::Regex> into your build
+system.
+
+The standalone distribution of Regexp will be supported for the time being, but
+should we find that supporting it prevents us from moving L<Catalyst> forward
+in necessary ways, we reserve the right to drop that support. It is highly
+recommended that you use this last stage of deprecation to change your code.
+
=head1 Upgrading to Catalyst 5.90040
=head2 Catalyst::Plugin::Unicode::Encoding is now core
return $new_psgi;
}
+=head1 PSGI Helpers
+
+Utility functions to make it easier to work with PSGI applications under Catalyst
+
+=head2 env_at_path_prefix
+
+Localize C<$env> under the current controller path prefix:
+
+ package MyApp::Controller::User;
+
+ use Catalyst::Utils;
+
+ use base 'Catalyst::Controller';
+
+ sub name :Local {
+ my ($self, $c) = @_;
+ my $env = $c->Catalyst::Utils::env_at_path_prefix;
+ }
+
+Assuming you have a requst like GET /user/name:
+
+In the example case C<$env> will have PATH_INFO of '/name' instead of
+'/user/name' and SCRIPT_NAME will now be '/user'.
+
+=cut
+
+sub env_at_path_prefix {
+ my $ctx = shift;
+ my $path_prefix = $ctx->controller->path_prefix;
+ my $env = $ctx->request->env;
+ my $path_info = $env->{PATH_INFO};
+ my $script_name = ($env->{SCRIPT_NAME} || '');
+
+ $path_info =~ s/(^\/\Q$path_prefix\E)//;
+ $script_name = "$script_name$1";
+
+ return +{
+ %$env,
+ PATH_INFO => $path_info,
+ SCRIPT_NAME => $script_name };
+}
+
+=head2 env_at_action
+
+Localize C<$env> under the current controller path prefix:
+
+ package MyApp::Controller::User;
+
+ use Catalyst::Utils;
+
+ use base 'Catalyst::Controller';
+
+ sub name :Local {
+ my ($self, $c) = @_;
+ my $env = $c->Catalyst::Utils::env_at_action;
+ }
+
+Assuming you have a requst like GET /user/name:
+
+In the example case C<$env> will have PATH_INFO of '/' instead of
+'/user/name' and SCRIPT_NAME will now be '/user/name'.
+
+This is probably a common case where you want to mount a PSGI application
+under an action but let the Args fall through to the PSGI app.
+
+=cut
+
+sub env_at_action {
+ my $ctx = shift;
+ my $argpath = join '/', @{$ctx->request->arguments};
+ my $path = '/' . $ctx->request->path;
+
+ $path =~ s/\/?\Q$argpath\E\/?$//;
+
+ my $env = $ctx->request->env;
+ my $path_info = $env->{PATH_INFO};
+ my $script_name = ($env->{SCRIPT_NAME} || '');
+
+ $path_info =~ s/(^\Q$path\E)//;
+ $script_name = "$script_name$1";
+
+ return +{
+ %$env,
+ PATH_INFO => $path_info,
+ SCRIPT_NAME => $script_name };
+}
+
+=head2 env_at_request_uri
+
+Localize C<$env> under the current controller path prefix:
+
+ package MyApp::Controller::User;
+
+ use Catalyst::Utils;
+
+ use base 'Catalyst::Controller';
+
+ sub name :Local Args(1) {
+ my ($self, $c, $id) = @_;
+ my $env = $c->Catalyst::Utils::env_at_request_uri
+ }
+
+Assuming you have a requst like GET /user/name/hello:
+
+In the example case C<$env> will have PATH_INFO of '/' instead of
+'/user/name' and SCRIPT_NAME will now be '/user/name/hello'.
+
+=cut
+
+sub env_at_request_uri {
+ my $ctx = shift;
+ my $path = '/' . $ctx->request->path;
+ my $env = $ctx->request->env;
+ my $path_info = $env->{PATH_INFO};
+ my $script_name = ($env->{SCRIPT_NAME} || '');
+
+ $path_info =~ s/(^\Q$path\E)//;
+ $script_name = "$script_name$1";
+
+ return +{
+ %$env,
+ PATH_INFO => $path_info,
+ SCRIPT_NAME => $script_name };
+}
+
=head1 AUTHORS
Catalyst Contributors, see Catalyst.pm
{
my @expected = qw[
TestApp::Controller::Action::Chained->begin
+ TestApp::Controller::Action::Chained->chain_error_a
+ TestApp::Controller::Action::Chained->end
+ ];
+
+ my $expected = join( ", ", @expected );
+
+ ok( my $response = request('http://localhost/chained/chain_error/1/end/2'),
+ "Break a chain in the middle" );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, 'Executed actions' );
+ is( $response->content, 'FATAL ERROR: break in the middle of a chain', 'Content OK' );
+ }
+
+ #
+ # Test dieing in the middle of a chain.
+ #
+ {
+ my @expected = qw[
+ TestApp::Controller::Action::Chained->begin
TestApp::Controller::Action::Chained->chain_die_a
TestApp::Controller::Action::Chained->end
];
"Break a chain in the middle" );
is( $response->header('X-Catalyst-Executed'),
$expected, 'Executed actions' );
- is( $response->content, 'FATAL ERROR: break in the middle of a chain', 'Content OK' );
+ is( $response->content, 'FATAL ERROR: Caught exception in TestApp::Controller::Action::Chained->chain_die_a "die in the middle of a chain"', 'Content OK' );
}
#
{
my $res = request('/emptybody');
is $res->content, '';
- ok !defined $res->header('Content-Length');
+
+ SKIP: {
+ skip "content-length for body of '' is now server dependent", 1;
+ ok !defined $res->header('Content-Length');
+ }
}
done_testing;
ActionClass LocalRegex LocalRegexp MyAction metadata cometd io psgix websockets
UTF async codebase dev filenames params MyMiddleware
JSON POSTed RESTful configuation performant subref actionrole
+ chunked chunking codewise distingush equivilent plack Javascript
Andreas
Ashton
Axel
--- /dev/null
+use warnings;
+use strict;
+use Test::More;
+use HTTP::Request::Common;
+use HTTP::Message::PSGI;
+use Plack::Util;
+
+# Test case to check that we now send scalar and filehandle like
+# bodys directly to the PSGI engine, rather than call $writer->write
+# or unroll the filehandle ourselves.
+
+{
+ package MyApp::Controller::Root;
+
+ use base 'Catalyst::Controller';
+
+ sub flat_response :Local {
+ my $response = 'Hello flat_response';
+ pop->res->body($response);
+ }
+
+ sub memory_stream :Local {
+ my $response = 'Hello memory_stream';
+ open my $fh, '<', \$response || die "$!";
+
+ pop->res->body($fh);
+ }
+
+ sub manual_write_fh :Local {
+ my ($self, $c) = @_;
+ my $response = 'Hello manual_write_fh';
+ my $writer = $c->res->write_fh;
+ $writer->write($response);
+ $writer->close;
+ }
+
+ sub manual_write :Local {
+ my ($self, $c) = @_;
+ $c->res->write('Hello');
+ $c->res->body('manual_write');
+ }
+
+ package MyApp;
+ use Catalyst;
+
+}
+
+$INC{'MyApp/Controller/Root.pm'} = '1'; # sorry...
+
+ok(MyApp->setup);
+ok(my $psgi = MyApp->psgi_app);
+
+{
+ ok(my $env = req_to_psgi(GET '/root/flat_response'));
+ ok(my $psgi_response = $psgi->($env));
+
+ $psgi_response->(sub {
+ my $response_tuple = shift;
+ my ($status, $headers, $body) = @$response_tuple;
+
+ ok $status;
+ ok $headers;
+ is $body->[0], 'Hello flat_response';
+
+ });
+}
+
+{
+ ok(my $env = req_to_psgi(GET '/root/memory_stream'));
+ ok(my $psgi_response = $psgi->($env));
+
+ $psgi_response->(sub {
+ my $response_tuple = shift;
+ my ($status, $headers, $body) = @$response_tuple;
+
+ ok $status;
+ ok $headers;
+ is ref($body), 'GLOB';
+
+ });
+}
+
+{
+ ok(my $env = req_to_psgi(GET '/root/manual_write_fh'));
+ ok(my $psgi_response = $psgi->($env));
+
+ $psgi_response->(sub {
+ my $response_tuple = shift;
+ my ($status, $headers, $body) = @$response_tuple;
+
+ ok $status;
+ ok $headers;
+ ok !$body;
+
+ return Plack::Util::inline_object(
+ write => sub { is shift, 'Hello manual_write_fh' },
+ close => sub { ok 1, 'closed' },
+ );
+ });
+}
+
+{
+ ok(my $env = req_to_psgi(GET '/root/manual_write'));
+ ok(my $psgi_response = $psgi->($env));
+
+ $psgi_response->(sub {
+ my $response_tuple = shift;
+ my ($status, $headers, $body) = @$response_tuple;
+
+ ok $status;
+ ok $headers;
+ ok !$body;
+
+ my @expected = (qw/Hello manual_write/);
+ return Plack::Util::inline_object(
+ close => sub { ok 1, 'closed'; is scalar(@expected), 0; },
+ write => sub { is shift, shift(@expected) },
+ );
+ });
+}
+
+## We need to specify the number of expected tests because tests that live
+## in the callbacks might never get run (thus all ran tests pass but not all
+## required tests run).
+
+done_testing(28);
--- /dev/null
+use warnings;
+use strict;
+use Test::More;
+use HTTP::Request::Common;
+use HTTP::Message::PSGI;
+use Plack::Util;
+use Plack::Test;
+
+# Test to make sure we let HTTP style exceptions bubble up to the middleware
+# rather than catching them outselves.
+
+{
+ package MyApp::Exception;
+
+ sub new {
+ my ($class, $code, $headers, $body) = @_;
+ return bless +{res => [$code, $headers, $body]}, $class;
+ }
+
+ sub throw { die shift->new(@_) }
+
+ sub as_psgi {
+ my ($self, $env) = @_;
+ my ($code, $headers, $body) = @{$self->{res}};
+
+ return [$code, $headers, $body]; # for now
+
+ return sub {
+ my $responder = shift;
+ $responder->([$code, $headers, $body]);
+ };
+ }
+
+ package MyApp::Controller::Root;
+
+ use base 'Catalyst::Controller';
+
+ my $psgi_app = sub {
+ my $env = shift;
+ die MyApp::Exception->new(
+ 404, ['content-type'=>'text/plain'], ['Not Found']);
+ };
+
+ sub from_psgi_app :Local {
+ my ($self, $c) = @_;
+ $c->res->from_psgi_response(
+ $psgi_app->(
+ $c->req->env));
+ }
+
+ sub from_catalyst :Local {
+ my ($self, $c) = @_;
+ MyApp::Exception->throw(
+ 403, ['content-type'=>'text/plain'], ['Forbidden']);
+ }
+
+ sub classic_error :Local {
+ my ($self, $c) = @_;
+ Catalyst::Exception->throw("Ex Parrot");
+ }
+
+ sub just_die :Local {
+ my ($self, $c) = @_;
+ die "I'm not dead yet";
+ }
+
+ package MyApp;
+ use Catalyst;
+
+ sub debug { 1 }
+
+ MyApp->setup_log('fatal');
+}
+
+$INC{'MyApp/Controller/Root.pm'} = '1'; # sorry...
+MyApp->setup_log('error');
+
+Test::More::ok(MyApp->setup);
+
+ok my $psgi = MyApp->psgi_app;
+
+test_psgi $psgi, sub {
+ my $cb = shift;
+ my $res = $cb->(GET "/root/from_psgi_app");
+ is $res->code, 404;
+ is $res->content, 'Not Found', 'NOT FOUND';
+};
+
+test_psgi $psgi, sub {
+ my $cb = shift;
+ my $res = $cb->(GET "/root/from_catalyst");
+ is $res->code, 403;
+ is $res->content, 'Forbidden', 'Forbidden';
+};
+
+test_psgi $psgi, sub {
+ my $cb = shift;
+ my $res = $cb->(GET "/root/classic_error");
+ is $res->code, 500;
+ like $res->content, qr'Ex Parrot', 'Ex Parrot';
+};
+
+test_psgi $psgi, sub {
+ my $cb = shift;
+ my $res = $cb->(GET "/root/just_die");
+ is $res->code, 500;
+ like $res->content, qr'not dead yet', 'not dead yet';
+};
+
+
+
+# We need to specify the number of expected tests because tests that live
+# in the callbacks might never get run (thus all ran tests pass but not all
+# required tests run).
+
+done_testing(10);
+
--- /dev/null
+use warnings;
+use strict;
+use Test::More;
+
+plan skip_all => "Test Cases are Sketch for next release";
+
+__END__
+
+# Test case to check that we now send scalar and filehandle like
+# bodys directly to the PSGI engine, rather than call $writer->write
+# or unroll the filehandle ourselves.
+
+{
+ package MyApp::Controller::User;
+
+ use base 'Catalyst::Controller';
+ use JSON::MaybeXS;
+
+ my %user = (
+ name => 'John',
+ age => 44,
+ );
+
+
+ sub get_user :Chained(/) PathPrefix CaptureArgs(0)
+ {
+ pop->stash(user=>\%user);
+ }
+
+ sub show :GET Chained(get_user) PathPart('') Args(0) {
+ my ($self, $c) = @_;
+ my $user = $c->stash->{user};
+ $c->res->format(
+ 'application/json' => sub { encode_json $user },
+ 'text/html' => sub { "<p>Hi I'm $user->{name} and my age is $user->{age}</p>" }
+ );
+ }
+
+ sub post_user :POST Chained(root) PathPart('') Args(0) Consumes(HTMLForm,JSON)
+ {
+ my ($self, $c) = @_;
+ %user = (%user, %{$c->req->body_data});
+ $c->res->status(201);
+ $c->res->location($c->uri_for( $self->action_for('show')));
+ }
+
+ $INC{'MyApp/Controller/User.pm'} = __FILE__;
+
+ package MyApp;
+ use Catalyst;
+
+ use HTTP::Headers::ActionPack;
+
+ my $cn = HTTP::Headers::ActionPack->new
+ ->get_content_negotiator;
+
+ sub Catalyst::Response::format
+ {
+ my $self = shift;
+ my %formats = @_;
+ my @formats = keys %formats;
+
+ my $accept = $self->_context->req->header('Accept') ||
+ $format{default} ||
+ $_[0];
+
+ $self->headers->header('Vary' => 'Accept');
+ $self->headers->header('Accepts' => (join ',', @formats));
+
+ if(my $which = $cn->choose_media_type(\@formats, $accept)) {
+ $self->content_type($which);
+ if(my $possible_body = $formats{$which}->($self)) {
+ $self->body($possible_body) unless $self->has_body || $self->has_write_fh;
+ }
+ } else {
+ $self->status(406);
+ $self->body("Method Not Acceptable");
+ }
+ }
+
+
+ MyApp->setup;
+}
+
+
+
+
+use HTTP::Request::Common;
+use Catalyst::Test 'MyApp';
+
+ok my($res, $c) = ctx_request('/');
+
+done_testing();
sub chain_dt_b :Chained('chain_dt_a') :PathPart('end') :Args(1) { }
#
+# Error in the middle of a chain
+#
+sub chain_error_a :Chained :PathPart('chained/chain_error') :CaptureArgs(1) {
+ $_[1]->error( 'break in the middle of a chain' );
+}
+
+sub chain_error_b :Chained('chain_error_a') :PathPart('end') :Args(1) {}
+
+#
# Die in the middle of a chain
#
sub chain_die_a :Chained :PathPart('chained/chain_die') :CaptureArgs(1) {
- $_[1]->error( 'break in the middle of a chain' );
+ die( "die in the middle of a chain\n" );
}
sub chain_die_b :Chained('chain_die_a') :PathPart('end') :Args(1) {}
# Don't set content_type
# Don't set body
$c->res->redirect('/go_here');
+ # route for /go_here doesn't exist
+ # it is only for checking HTTP response code, content-type etc.
}
sub test_redirect_uri_for :Global {
# Don't set content_type
# Don't set body
$c->res->redirect($c->uri_for('/go_here'));
+ # route for /go_here doesn't exist
+ # it is only for checking HTTP response code, content-type etc.
}
sub test_redirect_with_contenttype :Global {
# set content_type but don't set body
$c->res->content_type('image/jpeg');
$c->res->redirect('/go_here');
+ # route for /go_here doesn't exist
+ # it is only for checking HTTP response code, content-type etc.
}
sub test_redirect_with_content :Global {
$c->res->content_type('text/plain');
$c->res->body('Please kind sir, I beg you to go to /go_here.');
$c->res->redirect('/go_here');
+ # route for /go_here doesn't exist
+ # it is only for checking HTTP response code, content-type etc.
+}
+
+sub test_remove_body_with_304 :Global {
+ my ($self, $c) = @_;
+ $c->res->status(304);
+ $c->res->content_type('text/html');
+ $c->res->body("<html><body>Body should not be set</body></html>");
+}
+
+sub test_remove_body_with_204 :Global {
+ my ($self, $c) = @_;
+ $c->res->status(204);
+ $c->res->content_type('text/html');
+ $c->res->body("<html><body>Body should not be set</body></html>");
+}
+
+sub test_remove_body_with_100 :Global {
+ my ($self, $c) = @_;
+ $c->res->status(100);
+ $c->res->body("<html><body>Body should not be set</body></html>");
+}
+
+sub test_nobody_with_100 :Global {
+ my ($self, $c) = @_;
+ $c->res->status(100);
}
sub end : Private {
--- /dev/null
+use warnings;
+use strict;
+
+# Make it easier to mount PSGI apps under catalyst
+
+{
+ package MyApp::Controller::User;
+
+ use base 'Catalyst::Controller';
+ use Plack::Request;
+ use Catalyst::Utils;
+
+ my $psgi_app = sub {
+ my $req = Plack::Request->new(shift);
+ return [200,[],[$req->path]];
+ };
+
+ sub local_example :Local {
+ my ($self, $c) = @_;
+ my $env = $self->get_env($c);
+ $c->res->from_psgi_response(
+ $psgi_app->($env));
+ }
+
+ sub local_example_args1 :Local Args(1) {
+ my ($self, $c) = @_;
+ my $env = $self->get_env($c);
+ $c->res->from_psgi_response(
+ $psgi_app->($env));
+ }
+
+ sub path_example :Path('path-example') {
+ my ($self, $c) = @_;
+ my $env = $self->get_env($c);
+ $c->res->from_psgi_response(
+ $psgi_app->($env));
+ }
+
+ sub path_example_args1 :Path('path-example-args1') {
+ my ($self, $c) = @_;
+ my $env = $self->get_env($c);
+ $c->res->from_psgi_response(
+ $psgi_app->($env));
+ }
+
+ sub chained :Chained(/) PathPrefix CaptureArgs(0) { }
+
+ sub from_chain :Chained('chained') PathPart('') CaptureArgs(0) {}
+
+ sub end_chain :Chained('from_chain') PathPath(abc-123) Args(1)
+ {
+ my ($self, $c) = @_;
+ my $env = $self->get_env($c);
+ $c->res->from_psgi_response(
+ $psgi_app->($env));
+ }
+
+ sub get_env {
+ my ($self, $c) = @_;
+ if($c->req->query_parameters->{path_prefix}) {
+ return $c->Catalyst::Utils::env_at_path_prefix;
+ } elsif($c->req->query_parameters->{env_path}) {
+ return $c->Catalyst::Utils::env_at_action;
+ } elsif($c->req->query_parameters->{path}) {
+ return $c->Catalyst::Utils::env_at_request_uri;
+ } else {
+ return $c->req->env;
+ }
+ }
+
+ $INC{'MyApp/Controller/User.pm'} = __FILE__;
+
+ package MyApp;
+ use Catalyst;
+ MyApp->setup;
+
+}
+
+use Test::More;
+use Catalyst::Test 'MyApp';
+
+# BEGIN [user/local_example]
+{
+ my ($res, $c) = ctx_request('/user/local_example');
+ is $c->action, 'user/local_example';
+ is $res->content, '/user/local_example';
+ is_deeply $c->req->args, [];
+}
+
+{
+ my ($res, $c) = ctx_request('/user/local_example/111/222');
+ is $c->action, 'user/local_example';
+ is $res->content, '/user/local_example/111/222';
+ is_deeply $c->req->args, [111,222];
+}
+
+{
+ my ($res, $c) = ctx_request('/user/local_example?path_prefix=1');
+ is $c->action, 'user/local_example';
+ is $res->content, '/local_example';
+ is_deeply $c->req->args, [];
+}
+
+{
+ my ($res, $c) = ctx_request('/user/local_example/111/222?path_prefix=1');
+ is $c->action, 'user/local_example';
+ is $res->content, '/local_example/111/222';
+ is_deeply $c->req->args, [111,222];
+}
+
+{
+ my ($res, $c) = ctx_request('/user/local_example?env_path=1');
+ is $c->action, 'user/local_example';
+ is $res->content, '/';
+ is_deeply $c->req->args, [];
+}
+
+{
+ my ($res, $c) = ctx_request('/user/local_example/111/222?env_path=1');
+ is $c->action, 'user/local_example';
+ is $res->content, '/111/222';
+ is_deeply $c->req->args, [111,222];
+}
+
+{
+ my ($res, $c) = ctx_request('/user/local_example?path=1');
+ is $c->action, 'user/local_example';
+ is $res->content, '/';
+ is_deeply $c->req->args, [];
+}
+
+{
+ my ($res, $c) = ctx_request('/user/local_example/111/222?path=1');
+ is $c->action, 'user/local_example';
+ is $res->content, '/';
+ is_deeply $c->req->args, [111,222];
+}
+
+# END [user/local_example]
+
+# BEGIN [/user/local_example_args1/***/]
+
+{
+ my ($res, $c) = ctx_request('/user/local_example_args1/333');
+ is $c->action, 'user/local_example_args1';
+ is $res->content, '/user/local_example_args1/333';
+ is_deeply $c->req->args, [333];
+}
+
+{
+ my ($res, $c) = ctx_request('/user/local_example_args1/333?path_prefix=1');
+ is $c->action, 'user/local_example_args1';
+ is $res->content, '/local_example_args1/333';
+ is_deeply $c->req->args, [333];
+}
+
+{
+ my ($res, $c) = ctx_request('/user/local_example_args1/333?env_path=1');
+ is $c->action, 'user/local_example_args1';
+ is $res->content, '/333';
+ is_deeply $c->req->args, [333];
+}
+
+{
+ my ($res, $c) = ctx_request('/user/local_example_args1/333?path=1');
+ is $c->action, 'user/local_example_args1';
+ is $res->content, '/';
+ is_deeply $c->req->args, [333];
+}
+
+# END [/user/local_example_args1/***/]
+
+# BEGIN [/user/path-example]
+
+{
+ my ($res, $c) = ctx_request('/user/path-example');
+ is $c->action, 'user/path_example';
+ is $res->content, '/user/path-example';
+ is_deeply $c->req->args, [];
+}
+
+{
+ my ($res, $c) = ctx_request('/user/path-example?path_prefix=1');
+ is $c->action, 'user/path_example';
+ is $res->content, '/path-example';
+ is_deeply $c->req->args, [];
+}
+
+{
+ my ($res, $c) = ctx_request('/user/path-example?env_path=1');
+ is $c->action, 'user/path_example';
+ is $res->content, '/';
+ is_deeply $c->req->args, [];
+}
+
+{
+ my ($res, $c) = ctx_request('/user/path-example?path=1');
+ is $c->action, 'user/path_example';
+ is $res->content, '/';
+ is_deeply $c->req->args, [];
+}
+
+
+{
+ my ($res, $c) = ctx_request('/user/path-example/111/222');
+ is $c->action, 'user/path_example';
+ is $res->content, '/user/path-example/111/222';
+ is_deeply $c->req->args, [111,222];
+}
+
+{
+ my ($res, $c) = ctx_request('/user/path-example/111/222?path_prefix=1');
+ is $c->action, 'user/path_example';
+ is $res->content, '/path-example/111/222';
+ is_deeply $c->req->args, [111,222];
+}
+
+{
+ my ($res, $c) = ctx_request('/user/path-example/111/222?env_path=1');
+ is $c->action, 'user/path_example';
+ is $res->content, '/111/222';
+ is_deeply $c->req->args, [111,222];
+}
+
+{
+ my ($res, $c) = ctx_request('/user/path-example/111/222?path=1');
+ is $c->action, 'user/path_example';
+ is $res->content, '/';
+ is_deeply $c->req->args, [111,222];
+}
+
+{
+ my ($res, $c) = ctx_request('/user/path-example-args1/333');
+ is $c->action, 'user/path_example_args1';
+ is $res->content, '/user/path-example-args1/333';
+ is_deeply $c->req->args, [333];
+}
+
+{
+ my ($res, $c) = ctx_request('/user/path-example-args1/333?path_prefix=1');
+ is $c->action, 'user/path_example_args1';
+ is $res->content, '/path-example-args1/333';
+ is_deeply $c->req->args, [333];
+}
+
+{
+ my ($res, $c) = ctx_request('/user/path-example-args1/333?env_path=1');
+ is $c->action, 'user/path_example_args1';
+ is $res->content, '/333';
+ is_deeply $c->req->args, [333];
+}
+
+{
+ my ($res, $c) = ctx_request('/user/path-example-args1/333?path=1');
+ is $c->action, 'user/path_example_args1';
+ is $res->content, '/';
+ is_deeply $c->req->args, [333];
+}
+
+# Chaining test /user/end_chain/*
+#
+#
+
+{
+ my ($res, $c) = ctx_request('/user/end_chain/444');
+ is $c->action, 'user/end_chain';
+ is $res->content, '/user/end_chain/444';
+ is_deeply $c->req->args, [444];
+}
+
+{
+ my ($res, $c) = ctx_request('/user/end_chain/444?path_prefix=1');
+ is $c->action, 'user/end_chain';
+ is $res->content, '/end_chain/444';
+ is_deeply $c->req->args, [444];
+}
+
+{
+ my ($res, $c) = ctx_request('/user/end_chain/444?env_path=1');
+ is $c->action, 'user/end_chain';
+ is $res->content, '/444';
+ is_deeply $c->req->args, [444];
+}
+
+{
+ my ($res, $c) = ctx_request('/user/end_chain/444?path=1');
+ is $c->action, 'user/end_chain';
+ is $res->content, '/';
+ is_deeply $c->req->args, [444];
+}
+
+
+done_testing();
+
+__END__
+
+
+use Plack::App::URLMap;
+use HTTP::Request::Common;
+use HTTP::Message::PSGI;
+
+my $urlmap = Plack::App::URLMap->new;
+
+my $app1 = sub {
+ my $env = shift;
+ return [200, [], [
+ "REQUEST_URI: $env->{REQUEST_URI}, FROM: $env->{MAP_TO}, PATH_INFO: $env->{PATH_INFO}, SCRIPT_NAME $env->{SCRIPT_NAME}"]];
+};
+
+$urlmap->map("/" => sub { my $env = shift; $env->{MAP_TO} = '/'; $app1->($env)});
+$urlmap->map("/foo" => sub { my $env = shift; $env->{MAP_TO} = '/foo'; $app1->($env)});
+$urlmap->map("/bar/baz" => sub { my $env = shift; $env->{MAP_TO} = '/foo/bar'; $app1->($env)});
+
+my $app = $urlmap->to_app;
+
+warn $app->(req_to_psgi(GET '/'))->[2]->[0];
+warn $app->(req_to_psgi(GET '/111'))->[2]->[0];
+warn $app->(req_to_psgi(GET '/foo'))->[2]->[0];
+warn $app->(req_to_psgi(GET '/foo/222'))->[2]->[0];
+warn $app->(req_to_psgi(GET '/bar/baz'))->[2]->[0];
+warn $app->(req_to_psgi(GET '/bar/baz/333'))->[2]->[0];
+
--- /dev/null
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use Catalyst::Test 'TestApp', {default_host => 'default.com'};
+use Catalyst::Request;
+
+use Test::More;
+
+{
+ my @routes = (
+ ["test_remove_body_with_304",
+ 304 ],
+ ["test_remove_body_with_204",
+ 204 ],
+ ["test_remove_body_with_100",
+ 100 ],
+ ["test_nobody_with_100",
+ 100 ]
+ );
+
+ foreach my $element (@routes ) {
+ my $route = $element->[0];
+ my $expected_code = $element->[1];
+ my $request =
+ HTTP::Request->new( GET => "http://localhost:3000/$route" );
+ ok( my $response = request($request), "Request for $route");
+ is( $response->code,
+ $expected_code,
+ "Status code for $route is $expected_code");
+ is( $response->content,
+ '',
+ "Body for $route is not present");
+ }
+}
+
+done_testing;