X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst.pm;h=53183edded8dd3bc52b9fd3a4bbe4af50f04bdaf;hp=41be15784dd762fd05e8c15f315aac6f5e5e25ed;hb=HEAD;hpb=46cb9323ef6bdb9e678a67e9bbd1533b785b9b3e diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm index 41be157..de488a4 100644 --- a/lib/Catalyst.pm +++ b/lib/Catalyst.pm @@ -27,7 +27,7 @@ use HTML::Entities; use Tree::Simple qw/use_weak_refs/; use Tree::Simple::Visitor::FindByUID; use Class::C3::Adopt::NEXT; -use List::MoreUtils qw/uniq/; +use List::Util qw/uniq/; use attributes; use String::RewritePrefix; use Catalyst::EngineLoader; @@ -51,6 +51,10 @@ use Catalyst::Middleware::Stash; use Plack::Util; use Class::Load 'load_class'; use Encode 2.21 'decode_utf8', 'encode_utf8'; +use Scalar::Util; + +our $VERSION = '5.90128'; +$VERSION =~ tr/_//d; BEGIN { require 5.008003; } @@ -67,6 +71,7 @@ has request => ( my $composed_request_class = $class->composed_request_class; return $composed_request_class->new( $self->_build_request_constructor_args); }, + predicate => 'has_request', lazy => 1, ); sub _build_request_constructor_args { @@ -112,6 +117,7 @@ has response => ( my $composed_response_class = $class->composed_response_class; return $composed_response_class->new( $self->_build_response_constructor_args); }, + predicate=>'has_response', lazy => 1, ); sub _build_response_constructor_args { @@ -124,7 +130,7 @@ sub _build_response_constructor_args { sub composed_response_class { my $class = shift; return $class->_composed_response_class if $class->_composed_response_class; - + my @traits = (@{$class->response_class_traits||[]}, @{$class->config->{response_class_traits}||[]}); my $trait_ns = 'TraitFor::Response'; @@ -164,7 +170,7 @@ our $RECURSION = 1000; our $DETACH = Catalyst::Exception::Detach->new; our $GO = Catalyst::Exception::Go->new; -#I imagine that very few of these really +#I imagine that very few of these really #need to be class variables. if any. #maybe we should just make them attributes with a default? __PACKAGE__->mk_classdata($_) @@ -203,10 +209,6 @@ sub composed_stats_class { __PACKAGE__->_encode_check(Encode::FB_CROAK | Encode::LEAVE_SRC); -# Remember to update this in Catalyst::Runtime as well! -our $VERSION = '5.90110'; -$VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases - sub import { my ( $class, @arguments ) = @_; @@ -246,11 +248,6 @@ sub _application { $_[0] } Catalyst - The Elegant MVC Web Application Framework -=for html -CPAN version -Catalyst></a>
-<a href=Kwalitee Score - =head1 SYNOPSIS See the L distribution for comprehensive @@ -413,6 +410,10 @@ Returns the current L object, giving access to information about the current client request (including parameters, cookies, HTTP headers, etc.). See L. +There is a predicate method C that returns true if the +request object has been created. This is something you might need to +check if you are writing plugins that run before a request is finalized. + =head2 REQUEST FLOW HANDLING =head2 $c->forward( $action [, \@arguments ] ) @@ -474,7 +475,7 @@ or stash it like so: and access it from the stash. -Keep in mind that the C method used is that of the caller action. So a C<$c-Edetach> inside a forwarded action would run the C method from the original action requested. +Keep in mind that the C method used is that of the caller action. So a C<< $c->detach >> inside a forwarded action would run the C method from the original action requested. =cut @@ -561,6 +562,10 @@ sub go { my $c = shift; $c->dispatcher->go( $c, @_ ) } Returns the current L object, see there for details. +There is a predicate method C that returns true if the +request object has been created. This is something you might need to +check if you are writing plugins that run before a request is finalized. + =head2 $c->stash Returns a hashref to the stash, which may be used to store data and pass @@ -1436,9 +1441,9 @@ EOF } my @middleware = map { - ref $_ eq 'CODE' ? - "Inline Coderef" : - (ref($_) .' '. ($_->can('VERSION') ? $_->VERSION || '' : '') + ref $_ eq 'CODE' ? + "Inline Coderef" : + (ref($_) .' '. ($_->can('VERSION') ? $_->VERSION || '' : '') || '') } $class->registered_middlewares; if (@middleware) { @@ -1605,11 +1610,11 @@ sub uri_for { $path .= '/'; } - my $fragment = ((scalar(@args) && ref($args[-1]) eq 'SCALAR') ? pop @args : undef ); + my $fragment = ((scalar(@args) && ref($args[-1]) eq 'SCALAR') ? ${pop @args} : undef ); unless(blessed $path) { if (defined($path) and $path =~ s/#(.+)$//) { - if(defined($1) and $fragment) { + if(defined($1) and defined $fragment) { carp "Abiguious fragment declaration: You cannot define a fragment in '$path' and as an argument '$fragment'"; } if(defined($1)) { @@ -1638,14 +1643,15 @@ sub uri_for { my $num_captures = $expanded_action->number_of_captures; # ->uri_for( $action, \@captures_and_args, \%query_values? ) - if( !@args && $action->number_of_args ) { + if( !@args && $action->number_of_args && @$captures > $num_captures ) { unshift @args, splice @$captures, $num_captures; } if($num_captures) { unless($expanded_action->match_captures_constraints($c, $captures)) { - carp "captures [@{$captures}] do not match the type constraints in actionchain ending with '$expanded_action'"; - return; + $c->log->debug("captures [@{$captures}] do not match the type constraints in actionchain ending with '$expanded_action'") + if $c->debug; + return undef; } } @@ -1660,8 +1666,9 @@ sub uri_for { # At this point @encoded_args is the remaining Args (all captures removed). if($expanded_action->has_args_constraints) { unless($expanded_action->match_args($c,\@args)) { - carp "args [@args] do not match the type constraints in action '$expanded_action'"; - return; + $c->log->debug("args [@args] do not match the type constraints in action '$expanded_action'") + if $c->debug; + return undef; } } } @@ -1705,23 +1712,20 @@ sub uri_for { # somewhat lifted from URI::_query's query_form $query = '?'.join('&', map { my $val = $params->{$_}; - #s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/go; ## Commented out because seems to lead to double encoding - JNAP - s/ /+/g; - my $key = $_; + my $key = encode_utf8($_); + # using the URI::Escape pattern here so utf8 chars survive + $key =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go; + $key =~ s/ /+/g; + $val = '' unless defined $val; (map { - my $param = "$_"; - $param = encode_utf8($param); + my $param = encode_utf8($_); # using the URI::Escape pattern here so utf8 chars survive $param =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go; $param =~ s/ /+/g; - $key = encode_utf8($key); - # using the URI::Escape pattern here so utf8 chars survive - $key =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go; - $key =~ s/ /+/g; - - "${key}=$param"; } ( ref $val eq 'ARRAY' ? @$val : $val )); + "${key}=$param"; + } ( ref $val eq 'ARRAY' ? @$val : $val )); } @keys); } @@ -1732,7 +1736,7 @@ sub uri_for { if(defined $fragment) { if(blessed $path) { - $fragment = encode_utf8(${$fragment}); + $fragment = encode_utf8($fragment); $fragment =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go; $fragment =~ s/ /+/g; } @@ -1776,7 +1780,7 @@ and it will create the URI /users/the-list. =item \@captures_and_args? -Optional array reference of Captures (i.e. C<req->captures>) +Optional array reference of Captures (i.e. C or C<< $c->req->captures >>) and arguments to the request. Usually used with L to interpolate all the parameters in the URI. @@ -2201,16 +2205,27 @@ sub finalize { $c->log_response; - if ($c->use_stats) { - my $elapsed = $c->stats->elapsed; - my $av = $elapsed == 0 ? '??' : sprintf '%.3f', 1 / $elapsed; - $c->log->info( - "Request took ${elapsed}s ($av/s)\n" . $c->stats->report . "\n" ); - } + $c->log_stats if $c->use_stats; return $c->response->status; } +=head2 $c->log_stats + +Logs statistics. + +=cut + +sub log_stats { + my $c = shift; + + my $elapsed = $c->stats->elapsed; + my $av = $elapsed == 0 ? '??' : sprintf '%.3f', 1 / $elapsed; + $c->log->info( + "Request took ${elapsed}s ($av/s)\n" . $c->stats->report . "\n" ); +} + + =head2 $c->finalize_body Finalizes body. @@ -2307,7 +2322,7 @@ sub finalize_encoding { # to do this early since encodable_response is false for this condition and we need # to match the debug output for backcompat (there's a test for this...) -JNAP if( - $res->content_type_charset and $c->encoding and + $res->content_type_charset and $c->encoding and (uc($c->encoding->mime_name) ne uc($res->content_type_charset)) ) { my $ct = lc($res->content_type_charset); @@ -2321,10 +2336,14 @@ sub finalize_encoding { (defined($res->body)) and (ref(\$res->body) eq 'SCALAR') ) { + # if you are finding yourself here and your body is already encoded correctly + # and you want to turn this off, use $c->clear_encoding to prevent encoding + # at this step, or set encoding to undef in the config to do so for the whole + # application. See the ENCODING documentaiton for better notes. $c->res->body( $c->encoding->encode( $c->res->body, $c->_encode_check ) ); # Set the charset if necessary. This might be a bit bonkers since encodable response - # is false when the set charset is not the same as the encoding mimetype (maybe + # is false when the set charset is not the same as the encoding mimetype (maybe # confusing action at a distance here.. # Don't try to set the charset if one already exists or if headers are already finalized $c->res->content_type($c->res->content_type . "; charset=" . $c->encoding->mime_name) @@ -2490,6 +2509,8 @@ sub prepare { }; $c->log_request; + $c->{stash} = $c->stash; + Scalar::Util::weaken($c->{stash}); return $c; } @@ -2738,9 +2759,16 @@ sub log_request_parameters { next if ! keys %$params; my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ $column_width, 'Value' ] ); for my $key ( sort keys %$params ) { - my $param = $params->{$key}; - my $value = defined($param) ? $param : ''; - $t->row( $key, ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value ); + my @values = (); + if(ref $params eq 'Hash::MultiValue') { + @values = $params->get_all($key); + } else { + my $param = $params->{$key}; + if( defined($param) ) { + @values = ref $param eq 'ARRAY' ? @$param : $param; + } + } + $t->row( $key.( scalar @values > 1 ? ' [multiple]' : ''), join(', ', @values) ); } $c->log->debug( ucfirst($type) . " Parameters are:\n" . $t->draw ); } @@ -2871,7 +2899,7 @@ We try each possible role in turn (and throw an error if none load) The namespace part 'TraitFor::Request' was chosen to assist in backwards compatibility with L which previously provided these features in a stand alone package. - + =head2 $app->composed_request_class This is the request class which has been composed with any request_class_traits. @@ -3231,7 +3259,7 @@ sub setup_component { $class->components->{ $component } = $class->setup_component($component); } - return $instance; + return $instance; } =head2 $app->config_for( $component_name ) @@ -3246,7 +3274,7 @@ component or component object. Example: my $config = MyApp->config_for('MyApp::Model::Foo'); -In this case $config is the hashref C< {a=>1, b=>2} >. +In this case $config is the hashref C<< {a=>1, b=>2} >>. This is also handy for looking up configuration for a plugin, to make sure you follow existing L standards for where a plugin should put its configuration. @@ -3356,7 +3384,7 @@ sub setup_engine { return; } -## This exists just to supply a prebuild psgi app for mod_perl and for the +## This exists just to supply a prebuild psgi app for mod_perl and for the ## build in server support (back compat support for pre psgi port behavior). ## This is so that we don't build a new psgi app for each request when using ## the mod_perl handler or the built in servers (http and fcgi, etc). @@ -3373,7 +3401,7 @@ sub _finalized_psgi_app { } ## Look for a psgi file like 'myapp_web.psgi' (if the app is MyApp::Web) in the -## home directory and load that and return it (just assume it is doing the +## home directory and load that and return it (just assume it is doing the ## right thing :) ). If that does not exist, call $app->psgi_app, wrap that ## in default_middleware and return it ( this is for backward compatibility ## with pre psgi port behavior ). @@ -3459,7 +3487,7 @@ sub apply_default_middlewares { condition => sub { my ($env) = @_; return if $app->config->{ignore_frontend_proxy}; - return $env->{REMOTE_ADDR} eq '127.0.0.1'; + return $env->{REMOTE_ADDR} && $env->{REMOTE_ADDR} eq '127.0.0.1'; }, ); } @@ -3654,6 +3682,9 @@ sub _handle_param_unicode_decoding { return $value if blessed($value); #don't decode when the value is an object. my $enc = $self->encoding; + + return $value unless $enc; # don't decode if no encoding is specified + $check ||= $self->_encode_check; return try { $enc->decode( $value, $check); @@ -4005,14 +4036,14 @@ only two default data handlers, for 'application/json' and an alternative to 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. +data structure. It uses L. 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.) +use this new feature we recommend installing L in order to get +the best performance. You should add either to your dependency list +(Makefile.PL, dist.ini, cpanfile, etc.) =cut @@ -4047,12 +4078,12 @@ sub default_data_handlers { }, 'application/json' => sub { my ($fh, $req) = @_; - my $parser = Class::Load::load_first_existing_class('JSON::MaybeXS', 'JSON'); + require JSON::MaybeXS; my $slurped; - return eval { + return eval { local $/; $slurped = $fh->getline; - $parser->can("decode_json")->($slurped); # decode_json does utf8 decoding for us + JSON::MaybeXS::decode_json($slurped); # decode_json does utf8 decoding for us } || Catalyst::Exception->throw(sprintf "Error Parsing POST '%s', Error: %s", (defined($slurped) ? $slurped : 'undef') ,$@); }, }; @@ -4086,7 +4117,7 @@ L, but can be set otherwise with L<< stats_class|/"$c->stats_class" >>. Even if L<< -Stats|/"-Stats" >> is not enabled, the stats object is still -available. By enabling it with C< $c->stats->enabled(1) >, it can be used to +available. By enabling it with C<< $c->stats->enabled(1) >>, it can be used to profile explicitly, although MyApp.pm still won't profile nor output anything by itself. @@ -4294,18 +4325,20 @@ value to undef. C -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 -early.) +Defaults to true. -use like: +When there is an error in an action chain, the default behavior is to +abort the processing of the remaining actions to avoid running them +when the application is in an unexpected state. - __PACKAGE__->config(abort_chain_on_error_fix => 1); +Before version 5.90070, the default used to be false. To keep the old +behaviour, you can explicitly set the value to false. E.g. + + __PACKAGE__->config(abort_chain_on_error_fix => 0); + +If this setting is set to false, then the remaining actions are +performed and the error is caught at the end of the chain. -In the future this might become the default behavior. =item * @@ -4336,7 +4369,7 @@ that does not contain uploads, but instead contains inlined complex data (very uncommon) we cannot reliably convert that into field => value pairs. So instead we create an instance of L. If this causes issue for you, you can disable this by setting C -to true (default is false). +to true (default is false). =item * @@ -4357,7 +4390,7 @@ request URL query or keywords. Most readings of the relevant specifications suggest these should be UTF-* encoded, which is the default that L will use, however if you are creating a lot of URLs manually or have external evil clients, this might cause you trouble. If you find the changes introduced -in Catalyst version 5.90080+ break some of your query code, you may disable +in Catalyst version 5.90080+ break some of your query code, you may disable the UTF-8 decoding globally using this configuration. This setting takes precedence over C @@ -4574,21 +4607,21 @@ 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; - + use JSON::MaybeXS; + __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 +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.) @@ -4610,12 +4643,12 @@ arrayref under the configuration key C. Here's an example with details to follow: package MyApp::Web; - + use Catalyst; use Plack::Middleware::StackTrace; - + my $stacktrace_middleware = Plack::Middleware::StackTrace->new; - + __PACKAGE__->config( 'psgi_middleware', [ 'Debug', @@ -4632,7 +4665,7 @@ with details to follow: }, ], ); - + __PACKAGE__->setup; So the general form is: @@ -4658,26 +4691,26 @@ 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 - + =item Middleware Object - + An already initialized object that conforms to the L specification: - + my $stacktrace_middleware = Plack::Middleware::StackTrace->new; - + __PACKAGE__->config( 'psgi_middleware', [ $stacktrace_middleware, ]); - - + + =item coderef - + A coderef that is an inlined middleware: - + __PACKAGE__->config( 'psgi_middleware', [ sub { @@ -4694,11 +4727,11 @@ A coderef that is an inlined middleware: }, }, ]); - - - + + + =item a scalar - + We assume the scalar refers to a namespace after normalizing it using the following rules: @@ -4729,12 +4762,12 @@ Examples: '+MyApp::Custom', ## MyApp::Custom->wrap ], ); - + =item a scalar followed by a hashref - + Just like the previous, except the following C is used as arguments to initialize the middleware object. - + __PACKAGE__->config( 'psgi_middleware', [ 'Session' => {store => 'File'}, @@ -4759,6 +4792,11 @@ the encoding configuration to undef. This is recommended for temporary backwards compatibility only. +To turn it off for a single request use the L +method to turn off encoding for this request. This can be useful +when you are setting the body to be an arbitrary block of bytes, +especially if that block happens to be a block of UTF8 text. + Encoding is automatically applied when the content-type is set to a type that can be encoded. Currently we encode when the content type matches the following regular expression: @@ -4881,7 +4919,7 @@ andrewalker: André Walker Andrew Bramble -Andrew Ford EA.Ford@ford-mason.co.ukE +Andrew Ford Andrew Ruthven @@ -4895,19 +4933,19 @@ Caelum: Rafael Kitover chansen: Christian Hansen -Chase Venters C +Chase Venters chicks: Christopher Hicks -Chisel Wright C +Chisel Wright -Danijel Milicevic C +Danijel Milicevic davewood: David Schmidt -David Kamholz Edkamholz@cpan.orgE +David Kamholz -David Naughton, C +David Naughton David E. Wheeler @@ -4929,7 +4967,7 @@ gabb: Danijel Milicevic Gary Ashton Jones -Gavin Henry C +Gavin Henry Geoff Richards @@ -4941,7 +4979,7 @@ ilmari: Dagfinn Ilmari Mannsåker jcamacho: Juan Camacho -jester: Jesse Sheidlower C +jester: Jesse Sheidlower jhannah: Jay Hannah @@ -4951,9 +4989,9 @@ Johan Lindstrom jon: Jon Schutz -Jonathan Rockway C<< >> +Jonathan Rockway -Kieren Diment C +Kieren Diment konobi: Scott McWhirter @@ -4989,7 +5027,11 @@ rafl: Florian Ragwitz random: Roland Lammel -Robert Sedlacek C<< >> +revmischa: Mischa Spiegelmock + +Robert Sedlacek + +rrwo: Robert Rothenberg SpiceMan: Marcel Montes @@ -5003,17 +5045,17 @@ Ulf Edvinsson vanstyn: Henry Van Styn -Viljo Marrandi C +Viljo Marrandi -Will Hawes C +Will Hawes willert: Sebastian Willert wreis: Wallace Reis -Yuval Kogman, C +Yuval Kogman -rainboxx: Matthias Dietrich, C +rainboxx: Matthias Dietrich dd070: Dhaval Dhanani