Merge branch 'master' into runner
John Napiorkowski [Thu, 6 Feb 2014 17:48:29 +0000 (11:48 -0600)]
21 files changed:
Changes
Makefile.PL
lib/Catalyst.pm
lib/Catalyst/ActionRole/HTTPMethods.pm
lib/Catalyst/Delta.pod
lib/Catalyst/Engine.pm
lib/Catalyst/Request.pm
lib/Catalyst/Response.pm
lib/Catalyst/Runtime.pm
lib/Catalyst/Upgrading.pod
lib/Catalyst/Utils.pm
t/aggregate/live_component_controller_action_chained.t
t/aggregate/live_engine_response_emptybody.t
t/author/spelling.t
t/body_fh.t [new file with mode: 0644]
t/http_exceptions.t [new file with mode: 0644]
t/http_method.t [new file with mode: 0644]
t/lib/TestApp/Controller/Action/Chained.pm
t/lib/TestApp/Controller/Root.pm
t/psgi_utils.t [new file with mode: 0644]
t/remove_redundant_body.t [new file with mode: 0644]

diff --git a/Changes b/Changes
index d903a0f..68673ef 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,65 @@
 # 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
index 33a73a6..12b3e8d 100644 (file)
@@ -75,10 +75,16 @@ requires 'Stream::Buffered';
 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';
index 1240a44..2c4c354 100644 (file)
@@ -41,6 +41,12 @@ use Plack::Middleware::ReverseProxy;
 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';
 
@@ -120,7 +126,7 @@ __PACKAGE__->stats_class('Catalyst::Stats');
 
 # Remember to update this in Catalyst::Runtime as well!
 
-our $VERSION = '5.90053';
+our $VERSION = '5.90059_005';
 
 sub import {
     my ( $class, @arguments ) = @_;
@@ -1248,7 +1254,7 @@ EOF
     # 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
@@ -1857,11 +1863,6 @@ sub finalize {
 
         $c->finalize_headers unless $c->response->finalized_headers;
 
-        # HEAD request
-        if ( $c->request->method eq 'HEAD' ) {
-            $c->response->body('');
-        }
-
         $c->finalize_body;
     }
 
@@ -1895,11 +1896,32 @@ sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
 
 =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
 
@@ -1919,50 +1941,10 @@ sub 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;
 
@@ -2031,10 +2013,13 @@ sub handle_request {
         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++;
@@ -3122,7 +3107,14 @@ L<Catalyst::Plugin::EnableMiddleware> (which is now considered deprecated)
 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";
     }
@@ -3444,6 +3436,28 @@ C<data_handlers> - See L<DATA HANDLERS>.
 
 =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>,
@@ -3612,6 +3626,23 @@ So the general form is:
 
 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
  
@@ -3926,9 +3957,11 @@ rainboxx: Matthias Dietrich, C<perl@rainboxx.de>
 
 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
 
index 8d9033d..8b9eef8 100644 (file)
@@ -6,20 +6,12 @@ requires 'match', 'match_captures', 'list_extra_info';
 
 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) = @_;
@@ -75,27 +67,12 @@ This is an action role that lets your L<Catalyst::Action> match on standard
 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
 
index 985b571..b7fcb37 100755 (executable)
@@ -4,7 +4,105 @@ Catalyst::Delta - Overview of changes between versions of Catalyst
 
 =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
 
index a5c177a..017b2d4 100644 (file)
@@ -69,26 +69,111 @@ See L<Catalyst::Response/write> and L<Catalyst::Response/write_fh> for more.
 
 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;
 }
index 9f0e4ec..09fb8d5 100644 (file)
@@ -439,6 +439,7 @@ Catalyst::Request - provides information about the current client request
     $req->uri;
     $req->user;
     $req->user_agent;
+    $req->env;
 
 See also L<Catalyst>, L<Catalyst::Request::Upload>.
 
@@ -989,6 +990,9 @@ combined from those in the request and those in the body.
 
 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
 
index 9c571b8..4d0e85a 100644 (file)
@@ -9,7 +9,7 @@ with 'MooseX::Emulate::Class::Accessor::Fast';
 
 has _response_cb => (
     is      => 'ro',
-    isa     => 'CodeRef',
+    isa     => 'CodeRef', 
     writer  => '_set_response_cb',
     clearer => '_clear_response_cb',
     predicate => '_has_response_cb',
@@ -20,12 +20,30 @@ subtype 'Catalyst::Engine::Types::Writer',
 
 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',
@@ -33,12 +51,7 @@ 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;
@@ -69,6 +82,15 @@ has _context => (
   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(@_) }
@@ -89,26 +111,6 @@ sub write {
 
 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;
 }
 
@@ -118,23 +120,15 @@ sub from_psgi_response {
         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;
             }
index 677e547..7bf13bf 100644 (file)
@@ -7,7 +7,7 @@ BEGIN { require 5.008003; }
 
 # Remember to update this in Catalyst as well!
 
-our $VERSION = '5.90053';
+our $VERSION = '5.90059_005';
 
 =head1 NAME
 
index 03a24ab..11d0198 100644 (file)
@@ -2,6 +2,18 @@
 
 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
index 81ab727..3f594e6 100644 (file)
@@ -486,6 +486,131 @@ sub apply_registered_middleware {
     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
index 99ea3c7..f0cbc6a 100644 (file)
@@ -776,6 +776,25 @@ sub run_tests {
     {
         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
         ];
@@ -786,7 +805,7 @@ sub run_tests {
             "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' );
     }
 
     #
index beb83fe..e4f407c 100644 (file)
@@ -18,7 +18,11 @@ use Catalyst::Test 'TestApp';
 {
     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;
index b4c5119..e98de80 100644 (file)
@@ -21,6 +21,7 @@ add_stopwords(qw(
     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
diff --git a/t/body_fh.t b/t/body_fh.t
new file mode 100644 (file)
index 0000000..447794a
--- /dev/null
@@ -0,0 +1,126 @@
+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);
diff --git a/t/http_exceptions.t b/t/http_exceptions.t
new file mode 100644 (file)
index 0000000..c8fae7c
--- /dev/null
@@ -0,0 +1,117 @@
+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);
+
diff --git a/t/http_method.t b/t/http_method.t
new file mode 100644 (file)
index 0000000..797c807
--- /dev/null
@@ -0,0 +1,93 @@
+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();
index 2af1ec6..4c02130 100644 (file)
@@ -143,10 +143,19 @@ sub chain_dt_a :Chained :PathPart('chained/chain_dt') :CaptureArgs(1) {
 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) {}
index b626bdb..8541e2e 100644 (file)
@@ -83,6 +83,8 @@ sub test_redirect :Global {
     # 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 {
@@ -90,6 +92,8 @@ 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 {
@@ -97,6 +101,8 @@ 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 {
@@ -104,6 +110,33 @@ 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 {
diff --git a/t/psgi_utils.t b/t/psgi_utils.t
new file mode 100644 (file)
index 0000000..21f6004
--- /dev/null
@@ -0,0 +1,322 @@
+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];
+
diff --git a/t/remove_redundant_body.t b/t/remove_redundant_body.t
new file mode 100644 (file)
index 0000000..a43026c
--- /dev/null
@@ -0,0 +1,35 @@
+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;