X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst.pm;h=8173fb0e3d570594c2c2906eb101646265ed856f;hp=5b2472aa2228d24c66aafaffb6489aa5eac56e34;hb=de9bcba0ca9757cfc5ce79b13e3e38fc316dfb52;hpb=645c3f0b7ac9db50149e7a220e784ecf8cfaae69 diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm index 5b2472a..8173fb0 100644 --- a/lib/Catalyst.pm +++ b/lib/Catalyst.pm @@ -35,12 +35,20 @@ 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::Middleware::FixMissingBodyInRedirect; +use Plack::Middleware::MethodOverride; +use Plack::Middleware::RemoveRedundantBody; use Plack::Util; +use Class::Load 'load_class'; BEGIN { require 5.008003; } @@ -62,6 +70,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; } @@ -105,7 +116,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'); @@ -114,7 +126,7 @@ __PACKAGE__->stats_class('Catalyst::Stats'); # Remember to update this in Catalyst::Runtime as well! -our $VERSION = '5.90049_001'; +our $VERSION = '5.90060'; sub import { my ( $class, @arguments ) = @_; @@ -323,7 +335,18 @@ cookies, HTTP headers, etc.). See L. =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 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, @@ -1109,7 +1132,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"); @@ -1141,6 +1174,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; @@ -1151,8 +1189,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; @@ -1161,6 +1202,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}; @@ -1173,22 +1222,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 } ) { @@ -1220,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 @@ -1808,7 +1842,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; } @@ -1829,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; } @@ -1867,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 and it is an object that +does C or C 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 @@ -1891,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"); - - - - Moved - - -

This item has moved here.

- - -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; @@ -2003,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++; @@ -2473,7 +2486,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 @@ -2664,7 +2677,7 @@ sub setup_dispatcher { $dispatcher = $class->dispatcher_class; } - Class::MOP::load_class($dispatcher); + load_class($dispatcher); # dispatcher instance $class->dispatcher( $dispatcher->new ); @@ -2714,7 +2727,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; @@ -2990,7 +3003,7 @@ the plugin name does not begin with C. 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); @@ -3038,7 +3051,7 @@ the plugin name does not begin with C. } @{ $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'); @@ -3074,7 +3087,15 @@ See under L information regarding C and how to use it to enable L This method is automatically called during 'setup' of your application, so -you really don't need to invoke it. +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: + + package MyApp; + + use Catalyst; + + __PACKAGE__->setup_middleware('Head'); + __PACKAGE__->setup; 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 @@ -3086,16 +3107,23 @@ L (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"; } } 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)) { @@ -3117,7 +3145,78 @@ sub setup_middleware { } } - $class->_psgi_middleware(\@middleware); + my @existing = @{$class->_psgi_middleware || []}; + $class->_psgi_middleware([@middleware,@existing,]); +} + +=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 or +from passed @args. + +See under L information regarding C. + +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. 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 or via L 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 or L, depending on which +is installed. This allows you to fail back to L, which is a Pure Perl +JSON decoder, and has the smallest dependency impact. + +Because we don't wish to add more dependencies to L, if you wish to +use this new feature we recommend installing L or L 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"; + } +} + +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 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 @@ -3309,10 +3408,56 @@ In the future this might become the default behavior. =item * +C + +In L the methods C, C +and C 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 populate the +attributes underlying these methods with an instance of L +which is used by L 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 - See L. +=item * + +C - See L. + =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 or by reviewing the L stack, it +will eventually reach L and return either the debugging +error stack page, or the default error page. However, if your exception +can be caught by L, L 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>, @@ -3402,6 +3547,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, are not thread-safe. +=head1 DATA HANDLERS + +The L object uses L 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 defines a global configuration +option, C, 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 comes with a generic JSON data handler similar to the +example given above, which uses L to provide either L +(a pure Perl, dependency free JSON parser) or L 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 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 or a compatible @@ -3441,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: + +Alternatively, you may also define middleware by calling the L +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 @@ -3755,9 +3957,11 @@ rainboxx: Matthias Dietrich, C dd070: Dhaval Dhanani +Upasana + =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