merged and resolved conflicts from stable
John Napiorkowski [Wed, 31 Dec 2014 16:36:02 +0000 (10:36 -0600)]
Changes
lib/Catalyst.pm
lib/Catalyst/Middleware/Stash.pm
lib/Catalyst/ROADMAP.pod [deleted file]
lib/Catalyst/Request.pm
lib/Catalyst/Runtime.pm
t/consumes.t [new file with mode: 0644]
t/http_exceptions_backcompat.t [new file with mode: 0644]

diff --git a/Changes b/Changes
index 5014bfc..857ab36 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,8 @@
 # This file documents the revision history for Perl extension Catalyst.
 
+5.90079_005 - 2014-12-31
+  - Merged changes from 5.90078
+
 5.90079_004 - 2014-12-26
   - Starting adding some docs around the new encoding stuff
   - Exposed the reqexp we use to match content types that need encoding via a
     scheme for the generated URI object instead of just using whatever the incoming
     request uses.
 
+5.90078 - 2014-12-30
+  - POD corrections (sergey++)
+  - New configuration option to disable the HTTP Exception passthru feature
+    introduced in 5.90060.  You can use this if that feature is causing you
+    trouble. (davewood++);
+  - Some additional helper methods for dealing with errors.
+  - More clear exception when $request->body_data tries to parse malformed POSTed
+    data.  Added documentation and tests around this.
+
 5.90077 - 2014-11-18
   - We store the PSGI $env in Catalyst::Engine for backcompat reasons.  Changed
     this so that the storage is a weak reference, so that it goes out of scope
index 3ef4bc8..582ebb3 100644 (file)
@@ -129,7 +129,7 @@ __PACKAGE__->stats_class('Catalyst::Stats');
 __PACKAGE__->_encode_check(Encode::FB_CROAK | Encode::LEAVE_SRC);
 
 # Remember to update this in Catalyst::Runtime as well!
-our $VERSION = '5.90079_004';
+our $VERSION = '5.90079_005';
 $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
 
 sub import {
@@ -533,6 +533,9 @@ Add a new error.
 
     $c->error('Something bad happened');
 
+Calling this will always return an arrayref (if there are no errors it
+will be an empty arrayref.
+
 =cut
 
 sub error {
@@ -577,6 +580,29 @@ Returns true if you have errors
 
 sub has_errors { scalar(@{shift->error}) ? 1:0 }
 
+=head2 $c->last_error
+
+Returns the most recent error in the stack (the one most recently added...)
+or nothing if there are no errors.
+
+=cut
+
+sub last_error { my ($err, @errs) = @{shift->error}; return $err }
+
+=head2 shift_errors
+
+shifts the most recently added error off the error stack and returns if.  Returns
+nothing if there are nomore errors.
+
+=cut
+
+sub shift_errors {
+    my ($self) = @_;
+    my ($err, @errors) = @{$self->error};
+    $self->{error} = \@errors;
+    return $err;
+}
+
 sub _comp_search_prefixes {
     my $c = shift;
     return map $c->components->{ $_ }, $c->_comp_names_search_prefixes(@_);
@@ -1841,15 +1867,7 @@ sub execute {
 
     if ( my $error = $@ ) {
         #rethow if this can be handled by middleware
-        if(
-          blessed $error && (
-            $error->can('as_psgi') ||
-            (
-              $error->can('code') &&
-              $error->code =~m/^[1-5][0-9][0-9]$/
-            )
-          )
-        ) {
+        if ( $c->_handle_http_exception($error) ) {
             foreach my $err (@{$c->error}) {
                 $c->log->error($err);
             }
@@ -1962,7 +1980,7 @@ sub finalize {
 
     # Support skipping finalize for psgix.io style 'jailbreak'.  Used to support
     # stuff like cometd and websockets
-    
+
     if($c->request->_has_io_fh) {
       $c->log_response;
       return;
@@ -2030,10 +2048,7 @@ sub finalize_error {
         $c->engine->finalize_error( $c, @_ );
     } else {
         my ($error) = @{$c->error};
-        if(
-          blessed $error &&
-          ($error->can('as_psgi') || $error->can('code'))
-        ) {
+        if ( $c->_handle_http_exception($error) ) {
             # 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;
@@ -2184,15 +2199,7 @@ sub handle_request {
         $status = $c->finalize;
     } catch {
         #rethow if this can be handled by middleware
-        if(
-          blessed($_) && (
-            $_->can('as_psgi') ||
-            (
-              $_->can('code') &&
-              $_->code =~m/^[1-5][0-9][0-9]$/
-            )
-          )
-        ) {
+        if ( $class->_handle_http_exception($_) ) {
             $_->can('rethrow') ? $_->rethrow : croak $_;
         }
         chomp(my $error = $_);
@@ -3102,7 +3109,7 @@ sub setup_home {
 
 =head2 $c->setup_encoding
 
-Sets up the input/output encoding.  See L<ENCODING>
+Sets up the input/output encoding. See L<ENCODING>
 
 =cut
 
@@ -3344,7 +3351,7 @@ the plugin name does not begin with C<Catalyst::Plugin::>.
             $class => @roles
         ) if @roles;
     }
-}    
+}
 
 =head2 registered_middlewares
 
@@ -3403,7 +3410,7 @@ sub registered_middlewares {
 
 sub setup_middleware {
     my $class = shift;
-    my @middleware_definitions = @_ ? 
+    my @middleware_definitions = @_ ?
       reverse(@_) : reverse(@{$class->config->{'psgi_middleware'}||[]});
 
     my @middleware = ();
@@ -3495,12 +3502,34 @@ sub default_data_handlers {
             ->can('build_cgi_struct')->($params);
       },
       'application/json' => sub {
-          Class::Load::load_first_existing_class('JSON::MaybeXS', 'JSON')
-            ->can('decode_json')->(do { local $/; $_->getline });
-      },
+          my ($fh, $req) = @_;
+          my $parser = Class::Load::load_first_existing_class('JSON::MaybeXS', 'JSON');
+          my $slurped;
+          return eval { 
+            local $/;
+            $slurped = $fh->getline;
+            $parser->can("decode_json")->($slurped);
+          } || Catalyst::Exception->throw(sprintf "Error Parsing POST '%s', Error: %s", (defined($slurped) ? $slurped : 'undef') ,$@);
+        },
     };
 }
 
+sub _handle_http_exception {
+    my ( $self, $error ) = @_;
+    if (
+           !$self->config->{always_catch_http_exceptions}
+        && blessed $error
+        && (
+            $error->can('as_psgi')
+            || (   $error->can('code')
+                && $error->code =~ m/^[1-5][0-9][0-9]$/ )
+        )
+      )
+    {
+        return 1;
+    }
+}
+
 =head2 $c->stack
 
 Returns an arrayref of the internal execution stack (actions that are
@@ -3567,6 +3596,13 @@ There are a number of 'base' config variables which can be set:
 
 =item *
 
+C<always_catch_http_exceptions> - As of version 5.90060 Catalyst
+rethrows errors conforming to the interface described by
+L<Plack::Middleware::HTTPExceptions> and lets the middleware deal with it.
+Set true to get the deprecated behaviour and have Catalyst catch HTTP exceptions.
+
+=item *
+
 C<default_model> - The default model picked if you say C<< $c->model >>. See L<< /$c->model($name) >>.
 
 =item *
@@ -3622,7 +3658,7 @@ to be shown in hit debug tables in the test server.
 =item *
 
 C<use_request_uri_for_path> - Controls if the C<REQUEST_URI> or C<PATH_INFO> environment
-variable should be used for determining the request path. 
+variable should be used for determining the request path.
 
 Most web server environments pass the requested path to the application using environment variables,
 from which Catalyst has to reconstruct the request base (i.e. the top level path to / in the application,
@@ -3661,7 +3697,7 @@ is having paths rewritten into it (e.g. as a .cgi/fcgi in a public_html director
 at other URIs than that which the app is 'normally' based at with C<mod_rewrite>), the resolution of
 C<< $c->request->base >> will be incorrect.
 
-=back 
+=back
 
 =item *
 
@@ -3682,7 +3718,7 @@ When there is an error in an action chain, the default behavior is to continue
 processing the remaining actions and then catch the error upon chain end.  This
 can lead to running actions when the application is in an unexpected state.  If
 you have this issue, setting this config value to true will promptly exit a
-chain when there is an error raised in any action (thus terminating the chain 
+chain when there is an error raised in any action (thus terminating the chain
 early.)
 
 use like:
@@ -3728,7 +3764,7 @@ 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 
+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
@@ -3738,7 +3774,7 @@ is part of the default middleware).  For example this would allow
     sub throws_exception :Local {
       my ($self, $c) = @_;
 
-      http_throw(SeeOther => { location => 
+      http_throw(SeeOther => { location =>
         $c->uri_for($self->action_for('redirect')) });
 
     }
@@ -4162,6 +4198,8 @@ Chisel Wright C<pause@herlpacker.co.uk>
 
 Danijel Milicevic C<me@danijel.de>
 
+davewood: David Schmidt <davewood@cpan.org>
+
 David Kamholz E<lt>dkamholz@cpan.orgE<gt>
 
 David Naughton, C<naughton@umn.edu>
index e99285c..e31f2d6 100644 (file)
@@ -47,7 +47,7 @@ sub call {
   return $self->app->($new_env);
 }
 
-=head1 TITLE
+=head1 NAME
 
 Catalyst::Middleware::Stash - The Catalyst stash - in middleware
 
diff --git a/lib/Catalyst/ROADMAP.pod b/lib/Catalyst/ROADMAP.pod
deleted file mode 100644 (file)
index 470b645..0000000
+++ /dev/null
@@ -1,58 +0,0 @@
-=head1 ROADMAP
-
-This is a living document, that represents the core team's current plans for
-the Catalyst framework. It's liable to change at any time. This document lives
-in the the catalyst trunk, currently at
-
-  http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits/Catalyst-Runtime.git;a=blob;f=lib/Catalyst/ROADMAP.pod;h=acb5775e4f9ec2db88ab90953f8cf175ba276009;hb=HEAD
-
-Make sure you get it from there to ensure you have the latest version.
-
-=head2 5.91000 
-
-=over
-
-=item Reduce core class data usage.
-
-Refactor everything that doesn't have to be class data into object data
-
-=item Work towards a declarative syntax mode
-
-Dispatcher refactoring to provide alternatives to deprecated methods, and
-support for pluggable dispatcher builders (so that attributes can be
-replaced).
-
-=back
-
-=head2 5.92000
-
-=over
-
-=item Extend pluggability of the Catalyst core.
-
-good support for reusable components good support for reusable plugins good
-separation of plugins (some reusable components want different plugins) near
-total engine independence
-
-=back
-
-=head2 6.00000
-
-=over
-
-=item  Application / Context Split 
-
-Catalyst needs to be split so that $c refers to the current context, and is a
-separate thing from the Application class.
-
-=back
-
-=head2 Wishlist
-
-=over
-
-=item move all inline pod to bottom of file.
-
-=item update pod coverage tests to detect stubbed pod, ensure real coverage
-
-=back
index 0fe34b0..5e57305 100644 (file)
@@ -11,6 +11,7 @@ use Stream::Buffered;
 use Hash::MultiValue;
 use Scalar::Util;
 use HTTP::Body;
+use Catalyst::Exception;
 use Moose;
 
 use namespace::clean -except => 'meta';
@@ -118,7 +119,11 @@ has body_data => (
 
 sub _build_body_data {
     my ($self) = @_;
-    my $content_type = $self->content_type;
+
+    # Not sure if these returns should not be exceptions...
+    my $content_type = $self->content_type || return;
+    return unless ($self->method eq 'POST' || $self->method eq 'PUT');
+
     my ($match) = grep { $content_type =~/$_/i }
       keys(%{$self->data_handlers});
 
@@ -127,7 +132,7 @@ sub _build_body_data {
       local $_ = $fh;
       return $self->data_handlers->{$match}->($fh, $self);
     } else { 
-      return undef;
+      Catalyst::Exception->throw("$content_type is does not have an available data handler");
     }
 }
 
@@ -522,6 +527,13 @@ data of the type 'application/json' and return access to that data via this
 method.  You may define addition data_handlers via a global configuration
 setting.  See L<Catalyst\DATA HANDLERS> for more information.
 
+If the POST is malformed in some way (such as undefined or not content that
+matches the content-type) we raise a L<Catalyst::Exception> with the error
+text as the message.
+
+If the POSTed content type does not match an availabled data handler, this
+will also raise an exception.
+
 =head2 $req->body_parameters
 
 Returns a reference to a hash containing body (POST) parameters. Values can
index 465ffb0..416f0de 100644 (file)
@@ -7,7 +7,7 @@ BEGIN { require 5.008003; }
 
 # Remember to update this in Catalyst as well!
 
-our $VERSION = '5.90079_004';
+our $VERSION = '5.90079_005';
 $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
 
 =head1 NAME
diff --git a/t/consumes.t b/t/consumes.t
new file mode 100644 (file)
index 0000000..a96d209
--- /dev/null
@@ -0,0 +1,59 @@
+use warnings;
+use strict;
+use Test::More;
+
+# Test case for reported issue when an action consumes JSON but a
+# POST sends nothing we get a hard error
+
+{
+  package MyApp::Controller::Root;
+  $INC{'MyApp/Controller/Root.pm'} = __FILE__;
+
+  use base 'Catalyst::Controller';
+
+  sub bar :Local Args(0) POST Consumes(JSON) {
+    my( $self, $c ) = @_;
+    my $foo = $c->req->body_data;
+  }
+
+  sub end :Private {
+    my( $self, $c ) = @_;
+    my $body = $c->shift_errors;
+    $c->res->body( $body || "No errors");
+  }
+
+  package MyApp;
+  use Catalyst;
+  MyApp->setup;
+}
+
+use HTTP::Request::Common;
+use Catalyst::Test 'MyApp';
+
+{
+  # Test to send no post
+  ok my $res = request POST 'root/bar',
+    'Content-Type' => 'application/json';
+
+  like $res->content, qr"Error Parsing POST 'undef'";
+}
+
+{
+  # Test to send bad (malformed JSON) post
+  ok my $res = request POST 'root/bar',
+    'Content-Type' => 'application/json',
+    'Content' => 'i am not JSON';
+
+  like $res->content, qr/Error Parsing POST 'i am not JSON'/;
+}
+
+{
+  # Test to send bad (malformed JSON) post
+  ok my $res = request POST 'root/bar',
+    'Content-Type' => 'application/json',
+    'Content' => '{ "a":"b" }';
+
+  is $res->content, 'No errors';
+}
+
+done_testing();
diff --git a/t/http_exceptions_backcompat.t b/t/http_exceptions_backcompat.t
new file mode 100644 (file)
index 0000000..7a1bd86
--- /dev/null
@@ -0,0 +1,140 @@
+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 HTTP style exceptions do NOT bubble up to the middleware
+# if the backcompat setting 'always_catch_http_exceptions' is enabled.
+
+{
+  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::AnotherException;
+
+  sub new { bless +{}, shift }
+
+  sub code { 400 }
+
+  sub as_string { 'bad stringy bad' }
+
+  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 from_code_type :Local {
+    my $e = MyApp::AnotherException->new;
+    die $e;
+  }
+
+  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";
+  }
+
+  sub end : ActionClass('RenderView') {}
+
+  package MyApp;
+  use Catalyst;
+
+  MyApp->config(
+      abort_chain_on_error_fix=>1,
+      always_catch_http_exceptions=>1,
+  );
+
+  sub debug { 1 }
+
+  MyApp->setup_log('fatal');
+}
+
+$INC{'MyApp/Controller/Root.pm'} = __FILE__; # 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, 500;
+    like $res->content, qr/MyApp::Exception=HASH/;
+};
+
+test_psgi $psgi, sub {
+    my $cb = shift;
+    my $res = $cb->(GET "/root/from_catalyst");
+    is $res->code, 500;
+    like $res->content, qr/MyApp::Exception=HASH/;
+};
+
+test_psgi $psgi, sub {
+    my $cb = shift;
+    my $res = $cb->(GET "/root/from_code_type");
+    is $res->code, 500;
+    like $res->content, qr/MyApp::AnotherException=HASH/;
+};
+
+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(12);