if an exception is http, let middleware handle it
[catagits/Catalyst-Runtime.git] / lib / Catalyst.pm
index a2ee5e1..b9dc3f1 100644 (file)
@@ -35,13 +35,17 @@ use utf8;
 use Carp qw/croak carp shortmess/;
 use Try::Tiny;
 use Safe::Isa;
+use Moose::Util 'find_meta';
 use Plack::Middleware::Conditional;
 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::Util;
-use Class::Load;
+use Class::Load 'load_class';
 
 BEGIN { require 5.008003; }
 
@@ -63,6 +67,9 @@ sub _build_request_constructor_args {
     my $self = shift;
     my %p = ( _log => $self->log );
     $p{_uploadtmp} = $self->_uploadtmp if $self->_has_uploadtmp;
+    $p{data_handlers} = {$self->registered_data_handlers};
+    $p{_use_hash_multivalue} = $self->config->{use_hash_multivalue_in_request}
+      if $self->config->{use_hash_multivalue_in_request};
     \%p;
 }
 
@@ -106,7 +113,8 @@ our $GO        = Catalyst::Exception::Go->new;
 __PACKAGE__->mk_classdata($_)
   for qw/components arguments dispatcher engine log dispatcher_class
   engine_loader context_class request_class response_class stats_class
-  setup_finished _psgi_app loading_psgi_file run_options _psgi_middleware/;
+  setup_finished _psgi_app loading_psgi_file run_options _psgi_middleware
+  _data_handlers/;
 
 __PACKAGE__->dispatcher_class('Catalyst::Dispatcher');
 __PACKAGE__->request_class('Catalyst::Request');
@@ -115,7 +123,7 @@ __PACKAGE__->stats_class('Catalyst::Stats');
 
 # Remember to update this in Catalyst::Runtime as well!
 
-our $VERSION = '5.90042';
+our $VERSION = '5.90059_003';
 
 sub import {
     my ( $class, @arguments ) = @_;
@@ -324,7 +332,18 @@ cookies, HTTP headers, etc.). See L<Catalyst::Request>.
 
 =head2 $c->forward( $class, $method, [, \@arguments ] )
 
-Forwards processing to another action, by its private name. If you give a
+This is one way of calling another action (method) in the same or
+a different controller. You can also use C<< $self->my_method($c, @args) >>
+in the same controller or C<< $c->controller('MyController')->my_method($c, @args) >>
+in a different controller.
+The main difference is that 'forward' uses some of the Catalyst request
+cycle overhead, including debugging, which may be useful to you. On the
+other hand, there are some complications to using 'forward', restrictions
+on values returned from 'forward', and it may not handle errors as you prefer.
+Whether you use 'forward' or not is up to you; it is not considered superior to
+the other ways to call a method.
+
+'forward' calls  another action, by its private name. If you give a
 class name but no method, C<process()> is called. You may also optionally
 pass arguments in an arrayref. The action will receive the arguments in
 C<@_> and C<< $c->req->args >>. Upon returning from the function,
@@ -1110,7 +1129,17 @@ sub setup {
 
     $class->setup_log( delete $flags->{log} );
     $class->setup_plugins( delete $flags->{plugins} );
+
+    # Call plugins setup, this is stupid and evil.
+    # Also screws C3 badly on 5.10, hack to avoid.
+    {
+        no warnings qw/redefine/;
+        local *setup = sub { };
+        $class->setup unless $Catalyst::__AM_RESTARTING;
+    }
+
     $class->setup_middleware();
+    $class->setup_data_handlers();
     $class->setup_dispatcher( delete $flags->{dispatcher} );
     if (my $engine = delete $flags->{engine}) {
         $class->log->warn("Specifying the engine in ->setup is no longer supported, see Catalyst::Upgrading");
@@ -1142,6 +1171,11 @@ You are running an old script!
 EOF
     }
 
+    # Initialize our data structure
+    $class->components( {} );
+
+    $class->setup_components;
+
     if ( $class->debug ) {
         my @plugins = map { "$_  " . ( $_->VERSION || '' ) } $class->registered_plugins;
 
@@ -1152,8 +1186,11 @@ EOF
             $class->log->debug( "Loaded plugins:\n" . $t->draw . "\n" );
         }
 
-        my @middleware = map { ref $_ eq 'CODE' ? "Inline Coderef" : (ref($_) .'  '. $_->VERSION || '')  }
-          $class->registered_middlewares;
+        my @middleware = map {
+          ref $_ eq 'CODE' ? 
+            "Inline Coderef" : 
+              (ref($_) .'  '. ($_->can('VERSION') ? $_->VERSION || '' : '') 
+                || '')  } $class->registered_middlewares;
 
         if (@middleware) {
             my $column_width = Catalyst::Utils::term_width() - 6;
@@ -1162,6 +1199,14 @@ EOF
             $class->log->debug( "Loaded PSGI Middleware:\n" . $t->draw . "\n" );
         }
 
+        my %dh = $class->registered_data_handlers;
+        if (my @data_handlers = keys %dh) {
+            my $column_width = Catalyst::Utils::term_width() - 6;
+            my $t = Text::SimpleTable->new($column_width);
+            $t->row($_) for @data_handlers;
+            $class->log->debug( "Loaded Request Data Handlers:\n" . $t->draw . "\n" );
+        }
+
         my $dispatcher = $class->dispatcher;
         my $engine     = $class->engine;
         my $home       = $class->config->{home};
@@ -1174,22 +1219,7 @@ EOF
           ? $class->log->debug(qq/Found home "$home"/)
           : $class->log->debug(qq/Home "$home" doesn't exist/)
           : $class->log->debug(q/Couldn't find home/);
-    }
-
-    # Call plugins setup, this is stupid and evil.
-    # Also screws C3 badly on 5.10, hack to avoid.
-    {
-        no warnings qw/redefine/;
-        local *setup = sub { };
-        $class->setup unless $Catalyst::__AM_RESTARTING;
-    }
 
-    # Initialize our data structure
-    $class->components( {} );
-
-    $class->setup_components;
-
-    if ( $class->debug ) {
         my $column_width = Catalyst::Utils::term_width() - 8 - 9;
         my $t = Text::SimpleTable->new( [ $column_width, 'Class' ], [ 8, 'Type' ] );
         for my $comp ( sort keys %{ $class->components } ) {
@@ -1809,7 +1839,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) {
+    if($c->request->_has_io_fh) {
       $c->log_response;
       return;
     }
@@ -1830,11 +1860,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;
     }
 
@@ -1872,7 +1897,25 @@ Finalizes error.
 
 =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
 
@@ -1911,30 +1954,15 @@ EOF
         }
     }
 
-    # 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 ) );
-        }
-    }
+    # 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
 
-    # Errors
     if ( $response->status =~ /^(1\d\d|[23]04)$/ ) {
-        $response->headers->remove_header("Content-Length");
-        $response->body('');
+        if($response->has_body) {
+          $c->log->debug('Removing body for informational or no content http responses');
+          $response->body('');
+          $response->headers->remove_header("Content-Length");
+        }
     }
 
     $c->finalize_cookies;
@@ -2004,10 +2032,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++;
@@ -2474,7 +2505,7 @@ sub run {
 
 sub _make_immutable_if_needed {
     my $class = shift;
-    my $meta = Class::MOP::get_metaclass_by_name($class);
+    my $meta = find_meta($class);
     my $isa_ca = $class->isa('Class::Accessor::Fast') || $class->isa('Class::Accessor');
     if (
         $meta->is_immutable
@@ -2665,7 +2696,7 @@ sub setup_dispatcher {
         $dispatcher = $class->dispatcher_class;
     }
 
-    Class::MOP::load_class($dispatcher);
+    load_class($dispatcher);
 
     # dispatcher instance
     $class->dispatcher( $dispatcher->new );
@@ -2715,7 +2746,7 @@ sub setup_engine {
     # Don't really setup_engine -- see _setup_psgi_app for explanation.
     return if $class->loading_psgi_file;
 
-    Class::MOP::load_class($engine);
+    load_class($engine);
 
     if ($ENV{MOD_PERL}) {
         my $apache = $class->engine_loader->auto;
@@ -2872,7 +2903,7 @@ reference of your Catalyst application for use in F<.psgi> files.
 sub psgi_app {
     my ($app) = @_;
     my $psgi = $app->engine->build_psgi_app($app);
-    return $app->apply_registered_middleware($psgi);
+    return $app->Catalyst::Utils::apply_registered_middleware($psgi);
 }
 
 =head2 $c->setup_home
@@ -2991,7 +3022,7 @@ the plugin name does not begin with C<Catalyst::Plugin::>.
         my ( $proto, $plugin, $instant ) = @_;
         my $class = ref $proto || $proto;
 
-        Class::MOP::load_class( $plugin );
+        load_class( $plugin );
         $class->log->warn( "$plugin inherits from 'Catalyst::Component' - this is deprecated and will not work in 5.81" )
             if $plugin->isa( 'Catalyst::Component' );
         my $plugin_meta = Moose::Meta::Class->create($plugin);
@@ -3039,7 +3070,7 @@ the plugin name does not begin with C<Catalyst::Plugin::>.
          } @{ $plugins };
 
         for my $plugin ( reverse @plugins ) {
-            Class::MOP::load_class($plugin->[0], $plugin->[1]);
+            load_class($plugin->[0], $plugin->[1]);
             my $meta = find_meta($plugin->[0]);
             next if $meta && $meta->isa('Moose::Meta::Role');
 
@@ -3058,121 +3089,150 @@ the plugin name does not begin with C<Catalyst::Plugin::>.
     }
 }    
 
-=head2 setup_middleware (?@middleware)
-
-Read configuration information stored in configuration key 'psgi_middleware'
-and invoke L</register_middleware> for each middleware prototype found.  See
-under L</CONFIGURATION> information regarding L</psgi_middleware> and how to
-use it to enable L<Plack::Middleware>
-
-This method is automatically called during 'setup' of your application, so
-you really don't need to invoke it.
-
-When we read middleware definitions from configuration, we reverse the list
-which sounds odd but is likely how you expect it to work if you have prior
-experience with L<Plack::Builder> or if you previously used the plugin
-L<Catalyst::Plugin::EnableMiddleware> (which is now considered deprecated)
-
-You can pass middleware definitions to this as well, from the application
-class if you like.
+=head2 registered_middlewares
 
-=head2 register_middleware (@args)
+Read only accessor that returns an array of all the middleware in the order
+that they were added (which is the REVERSE of the order they will be applied).
 
-Given @args that represent the definition of some L<Plack::Middleware> or 
-middleware with a compatible interface, register it with your L<Catalyst>
-application.
+The values returned will be either instances of L<Plack::Middleware> or of a
+compatible interface, or a coderef, which is assumed to be inlined middleware
 
-This is called by L</setup_middleware>.  the behavior of invoking it yourself
-at run time is currently undefined, and anything that works or doesn't work
-as a result of doing so is considered a side effect subject to change.
+=head2 setup_middleware (?@middleware)
 
-=head2 _build_middleware (@args)
+Read configuration information stored in configuration key C<psgi_middleware> or
+from passed @args.
 
-Internal application that converts a single middleware definition (see
-L</psgi_middleware>) into an actual instance of middleware.
+See under L</CONFIGURATION> information regarding C<psgi_middleware> and how
+to use it to enable L<Plack::Middleware>
 
-=head2 registered_middlewares
+This method is automatically called during 'setup' of your application, so
+you really don't need to invoke it.  However you may do so if you find the idea
+of loading middleware via configuration weird :).  For example:
 
-Read only accessor that returns an array of all the middleware in the order
-that they were added (which is the REVERSE of the order they will be applied).
+    package MyApp;
 
-The values returned will be either instances of L<Plack::Middleware> or of a
-compatible interface, or a coderef, which is assumed to be inlined middleware
+    use Catalyst;
 
-=head2 apply_registered_middleware ($psgi)
+    __PACKAGE__->setup_middleware('Head');
+    __PACKAGE__->setup;
 
-Given a $psgi reference, wrap all the L<registered_middlewares> around it and
-return the wrapped version.
+When we read middleware definitions from configuration, we reverse the list
+which sounds odd but is likely how you expect it to work if you have prior
+experience with L<Plack::Builder> or if you previously used the plugin
+L<Catalyst::Plugin::EnableMiddleware> (which is now considered deprecated)
 
 =cut
 
-sub registered_middlewares { @{shift->_psgi_middleware || []} }
+sub registered_middlewares {
+    my $class = shift;
+    if(my $middleware = $class->_psgi_middleware) {
+        return (
+          Plack::Middleware::HTTPExceptions->new,
+          Plack::Middleware::ContentLength->new,
+          Plack::Middleware::Head->new,
+          @$middleware);
+    } else {
+        die "You cannot call ->registered_middlewares until middleware has been setup";
+    }
+}
 
 sub setup_middleware {
-    my ($class, @middleware_definitions) = @_;
-    push @middleware_definitions, reverse(
-      @{$class->config->{'psgi_middleware'}||[]});
+    my $class = shift;
+    my @middleware_definitions = @_ ? 
+      @_ : reverse(@{$class->config->{'psgi_middleware'}||[]});
 
+    my @middleware = ();
     while(my $next = shift(@middleware_definitions)) {
         if(ref $next) {
             if(Scalar::Util::blessed $next && $next->can('wrap')) {
-                $class->register_middleware($next);
+                push @middleware, $next;
             } elsif(ref $next eq 'CODE') {
-                $class->register_middleware($next);
+                push @middleware, $next;
             } elsif(ref $next eq 'HASH') {
                 my $namespace = shift @middleware_definitions;
-                my $mw = $class->_build_middleware($namespace, %$next);
-                $class->register_middleware($mw);
+                my $mw = $class->Catalyst::Utils::build_middleware($namespace, %$next);
+                push @middleware, $mw;
             } else {
               die "I can't handle middleware definition ${\ref $next}";
             }
         } else {
-          my $mw = $class->_build_middleware($next);
-          $class->register_middleware($mw);
+          my $mw = $class->Catalyst::Utils::build_middleware($next);
+          push @middleware, $mw;
         }
     }
+
+    my @existing = @{$class->_psgi_middleware || []};
+    $class->_psgi_middleware([@middleware,@existing,]);
 }
 
-sub register_middleware {
-  my ($class, @middleware) = @_;
-  if($class->_psgi_middleware) {
-    push @{$class->_psgi_middleware}, @middleware;
-  } else {
-    $class->_psgi_middleware(\@middleware);
-  }
-}
-
-sub _build_middleware {
-    my ($class, $namespace, @init_args) = @_;
-
-    if(
-      $namespace =~s/^\+// ||
-      $namespace =~/^Plack::Middleware/ ||
-      $namespace =~/^$class/
-    ) {  ## the string is a full namespace
-        return Class::Load::try_load_class($namespace) ?
-          $namespace->new(@init_args) :
-            die "Can't load class $namespace";
-    } else { ## the string is a partial namespace
-        if(Class::Load::try_load_class("Plack::Middleware::$namespace")) { ## Act like Plack::Builder
-            return "Plack::Middleware::$namespace"->new(@init_args);
-        } elsif(Class::Load::try_load_class("$class::$namespace")) { ## Load Middleware from Project namespace
-            return "$class::$namespace"->new(@init_args);
-        }
+=head2 registered_data_handlers
+
+A read only copy of registered Data Handlers returned as a Hash, where each key
+is a content type and each value is a subref that attempts to decode that content
+type.
+
+=head2 setup_data_handlers (?@data_handler)
+
+Read configuration information stored in configuration key C<data_handlers> or
+from passed @args.
+
+See under L</CONFIGURATION> information regarding C<data_handlers>.
+
+This method is automatically called during 'setup' of your application, so
+you really don't need to invoke it.
+
+=head2 default_data_handlers
+
+Default Data Handlers that come bundled with L<Catalyst>.  Currently there are
+only two default data handlers, for 'application/json' and an alternative to
+'application/x-www-form-urlencoded' which supposed nested form parameters via
+L<CGI::Struct> or via L<CGI::Struct::XS> IF you've installed it.
+
+The 'application/json' data handler is used to parse incoming JSON into a Perl
+data structure.  It used either L<JSON::MaybeXS> or L<JSON>, depending on which
+is installed.  This allows you to fail back to L<JSON:PP>, which is a Pure Perl
+JSON decoder, and has the smallest dependency impact.
+
+Because we don't wish to add more dependencies to L<Catalyst>, if you wish to
+use this new feature we recommend installing L<JSON> or L<JSON::MaybeXS> in
+order to get the best performance.  You should add either to your dependency
+list (Makefile.PL, dist.ini, cpanfile, etc.)
+
+=cut
+
+sub registered_data_handlers {
+    my $class = shift;
+    if(my $data_handlers = $class->_data_handlers) {
+        return %$data_handlers;
+    } else {
+        die "You cannot call ->registered_data_handlers until data_handers has been setup";
     }
+}
 
-    return; ## be sure we can count on a proper return when valid
+sub setup_data_handlers {
+    my ($class, %data_handler_callbacks) = @_;
+    %data_handler_callbacks = (
+      %{$class->default_data_handlers},
+      %{$class->config->{'data_handlers'}||+{}},
+      %data_handler_callbacks);
+
+    $class->_data_handlers(\%data_handler_callbacks);
 }
 
-sub apply_registered_middleware {
-    my ($class, $psgi) = @_;
-    my $new_psgi = $psgi;
-    foreach my $middleware ($class->registered_middlewares) {
-        $new_psgi = Scalar::Util::blessed $middleware ?
-          $middleware->wrap($new_psgi) :
-            $middleware->($new_psgi);
-    }
-    return $new_psgi;
+sub default_data_handlers {
+    my ($class) = @_;
+    return +{
+      'application/x-www-form-urlencoded' => sub {
+          my ($fh, $req) = @_;
+          my $params = $req->_use_hash_multivalue ? $req->body_parameters->mixed : $req->body_parameters;
+          Class::Load::load_first_existing_class('CGI::Struct::XS', 'CGI::Struct')
+            ->can('build_cgi_struct')->($params);
+      },
+      'application/json' => sub {
+          Class::Load::load_first_existing_class('JSON::MaybeXS', 'JSON')
+            ->can('decode_json')->(do { local $/; $_->getline });
+      },
+    };
 }
 
 =head2 $c->stack
@@ -3364,8 +3424,32 @@ In the future this might become the default behavior.
 
 =item *
 
+C<use_hash_multivalue_in_request>
+
+In L<Catalyst::Request> the methods C<query_parameters>, C<body_parametes>
+and C<parameters> return a hashref where values might be scalar or an arrayref
+depending on the incoming data.  In many cases this can be undesirable as it
+leads one to writing defensive code like the following:
+
+    my ($val) = ref($c->req->parameters->{a}) ?
+      @{$c->req->parameters->{a}} :
+        $c->req->parameters->{a};
+
+Setting this configuration item to true will make L<Catalyst> populate the
+attributes underlying these methods with an instance of L<Hash::MultiValue>
+which is used by L<Plack::Request> and others to solve this very issue.  You
+may prefer this behavior to the default, if so enable this option (be warned
+if you enable it in a legacy application we are not sure if it is completely
+backwardly compatible).
+
+=item *
+
 C<psgi_middleware> - See L<PSGI MIDDLEWARE>.
 
+=item *
+
+C<data_handlers> - See L<DATA HANDLERS>.
+
 =back
 
 =head1 INTERNAL ACTIONS
@@ -3457,6 +3541,46 @@ If you plan to operate in a threaded environment, remember that all other
 modules you are using must also be thread-safe. Some modules, most notably
 L<DBD::SQLite>, are not thread-safe.
 
+=head1 DATA HANDLERS
+
+The L<Catalyst::Request> object uses L<HTTP::Body> to populate 'classic' HTML
+form parameters and URL search query fields.  However it has become common
+for various alternative content types to be PUT or POSTed to your controllers
+and actions.  People working on RESTful APIs, or using AJAX often use JSON,
+XML and other content types when communicating with an application server.  In
+order to better support this use case, L<Catalyst> defines a global configuration
+option, C<data_handlers>, which lets you associate a content type with a coderef
+that parses that content type into something Perl can readily access.
+
+    package MyApp::Web;
+    use Catalyst;
+    use JSON::Maybe;
+    __PACKAGE__->config(
+      data_handlers => {
+        'application/json' => sub { local $/; decode_json $_->getline },
+      },
+      ## Any other configuration.
+    );
+    __PACKAGE__->setup;
+
+By default L<Catalyst> comes with a generic JSON data handler similar to the
+example given above, which uses L<JSON::Maybe> to provide either L<JSON::PP>
+(a pure Perl, dependency free JSON parser) or L<Cpanel::JSON::XS> if you have
+it installed (if you want the faster XS parser, add it to you project Makefile.PL
+or dist.ini, cpanfile, etc.)
+
+The C<data_handlers> configuation is a hashref whose keys are HTTP Content-Types
+(matched against the incoming request type using a regexp such as to be case
+insensitive) and whose values are coderefs that receive a localized version of
+C<$_> which is a filehandle object pointing to received body.
+
+This feature is considered an early access release and we reserve the right
+to alter the interface in order to provide a performant and secure solution to
+alternative request body content.  Your reports welcomed!
+
 =head1 PSGI MIDDLEWARE
 
 You can define middleware, defined as L<Plack::Middleware> or a compatible
@@ -3496,6 +3620,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