X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst.pm;h=1b73f235b2b96b81d8d4c10906ab387fef79c4a7;hp=b904aa79f50c7b5313993db415fc9a1c89f551a9;hb=0ca510f0aa1cabe138d81897d38111d7b772449c;hpb=591feafa881b4842124e75fccdf87c76da555e9a diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm index b904aa7..1b73f23 100644 --- a/lib/Catalyst.pm +++ b/lib/Catalyst.pm @@ -50,7 +50,7 @@ use Plack::Middleware::RemoveRedundantBody; use Catalyst::Middleware::Stash; use Plack::Util; use Class::Load 'load_class'; -use Encode 2.21 (); +use Encode 2.21 'decode_utf8', 'encode_utf8'; BEGIN { require 5.008003; } @@ -127,7 +127,8 @@ __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.90073'; +our $VERSION = '5.90080_001'; +$VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases sub import { my ( $class, @arguments ) = @_; @@ -495,6 +496,18 @@ Catalyst). # stash is automatically passed to the view for use in a template $c->forward( 'MyApp::View::TT' ); +The stash hash is currently stored in the PSGI C<$env> and is managed by +L. Since it's part of the C<$env> items in +the stash can be accessed in sub applications mounted under your main +L application. For example if you delegate the response of an +action to another L application, that sub application will have +access to all the stash keys of the main one, and if can of course add +more keys of its own. However those new keys will not 'bubble' back up +to the main application. + +For more information the best thing to do is to review the test case: +t/middleware-stash.t in the distribution /t directory. + =cut sub stash { @@ -1376,30 +1389,38 @@ sub uri_for { ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} ); carp "uri_for called with undef argument" if grep { ! defined $_ } @args; + + my @encoded_args = (); foreach my $arg (@args) { - utf8::encode($arg) if utf8::is_utf8($arg); - $arg =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go; + if(ref($arg)||'' eq 'ARRAY') { + push @encoded_args, [map { + my $encoded = encode_utf8 $_; + $encoded =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go; + $encoded; + } @$arg]; + } else { + push @encoded_args, do { + my $encoded = encode_utf8 $arg; + $encoded =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go; + $encoded; + } + } } if ( $path->$_isa('Catalyst::Action') ) { # action object - s|/|%2F|g for @args; + s|/|%2F|g for @encoded_args; my $captures = [ map { s|/|%2F|g; $_; } - ( scalar @args && ref $args[0] eq 'ARRAY' - ? @{ shift(@args) } + ( scalar @encoded_args && ref $encoded_args[0] eq 'ARRAY' + ? @{ shift(@encoded_args) } : ()) ]; - foreach my $capture (@$captures) { - utf8::encode($capture) if utf8::is_utf8($capture); - $capture =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go; - } - my $action = $path; # ->uri_for( $action, \@captures_and_args, \%query_values? ) - if( !@args && $action->number_of_args ) { + if( !@encoded_args && $action->number_of_args ) { my $expanded_action = $c->dispatcher->expand_action( $action ); my $num_captures = $expanded_action->number_of_captures; - unshift @args, splice @$captures, $num_captures; + unshift @encoded_args, splice @$captures, $num_captures; } $path = $c->dispatcher->uri_for_action($action, $captures); @@ -1411,18 +1432,18 @@ sub uri_for { $path = '/' if $path eq ''; } - unshift(@args, $path); + unshift(@encoded_args, $path); unless (defined $path && $path =~ s!^/!!) { # in-place strip my $namespace = $c->namespace; if (defined $path) { # cheesy hack to handle path '../foo' - $namespace =~ s{(?:^|/)[^/]+$}{} while $args[0] =~ s{^\.\./}{}; + $namespace =~ s{(?:^|/)[^/]+$}{} while $encoded_args[0] =~ s{^\.\./}{}; } - unshift(@args, $namespace || ''); + unshift(@encoded_args, $namespace || ''); } # join args with '/', or a blank string - my $args = join('/', grep { defined($_) } @args); + my $args = join('/', grep { defined($_) } @encoded_args); $args =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE $args =~ s!^/+!!; @@ -1439,16 +1460,22 @@ sub uri_for { # somewhat lifted from URI::_query's query_form $query = '?'.join('&', map { my $val = $params->{$_}; - s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/go; + #s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/go; ## Commented out because seems to lead to double encoding - JNAP s/ /+/g; my $key = $_; $val = '' unless defined $val; (map { my $param = "$_"; - utf8::encode( $param ) if utf8::is_utf8($param); + $param = encode_utf8($param); # 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 )); } @keys); } @@ -2036,8 +2063,9 @@ sub finalize_encoding { # Oh my, I wonder what filehandle responses and streams do... - jnap. # Encode expects plain scalars (IV, NV or PV) and segfaults on ref's - $c->response->body( $c->encoding->encode( $body, $c->_encode_check ) ) - if ref(\$body) eq 'SCALAR'; + if (ref(\$body) eq 'SCALAR') { + $c->response->body( $c->encoding->encode( $body, $c->_encode_check ) ); + }; } =head2 $c->finalize_output @@ -2345,6 +2373,10 @@ sub log_request { $method ||= ''; $path = '/' unless length $path; $address ||= ''; + + $path =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; + $path = decode_utf8($path); + $c->log->debug(qq/"$method" request for "$path" from "$address"/); $c->log_request_headers($request->headers); @@ -2535,7 +2567,7 @@ sub prepare_uploads { return unless $enc; # Uggg we hook prepare uploads to do the encoding crap on post and query - # parameters! Sorry -jnap + # parameters! Cargo culted from old encoding plugin. Sorry -jnap for my $key (qw/ parameters query_parameters body_parameters /) { for my $value ( values %{ $c->request->{$key} } ) { # N.B. Check if already a character string and if so do not try to double decode. @@ -2993,7 +3025,9 @@ sub apply_default_middlewares { return $psgi_app; } -=head2 $c->psgi_app +=head2 App->psgi_app + +=head2 App->to_app Returns a PSGI application code reference for the catalyst application C<$c>. This is the bare application without any middlewares @@ -3004,6 +3038,8 @@ reference of your Catalyst application for use in F<.psgi> files. =cut +*to_app = \&psgi_app; + sub psgi_app { my ($app) = @_; my $psgi = $app->engine->build_psgi_app($app); @@ -3095,9 +3131,7 @@ sub _handle_param_unicode_decoding { my $enc = $self->encoding; return try { - Encode::is_utf8( $value ) ? - $value - : $enc->decode( $value, $self->_encode_check ); + $enc->decode( $value, $self->_encode_check ); } catch { $self->handle_unicode_encoding_exception({