X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst.pm;h=eaf50796505107af939e11f6a1533b6f1154b1ea;hp=2fe20f0563171dd0daa7d06fd82e1f329c0e3a58;hb=4a62800defdaa16ec1a5bef88f3e639c983b6f1d;hpb=5c779e9841d052721162a48ad96fdbda2acd1035 diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm index 2fe20f0..eaf5079 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; } @@ -1390,26 +1390,37 @@ sub uri_for { carp "uri_for called with undef argument" if grep { ! defined $_ } @args; - foreach my $arg (@args) { - ref $arg eq 'ARRAY' ? do { utf8::encode($_) for @$arg } : utf8::encode($arg); - ref $arg eq 'ARRAY' ? do { $_ =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go for @$arg } : - $arg =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go; + my @encoded_args = (); + foreach my $arg (@args) { + 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) } : ()) ]; 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); @@ -1421,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!^/+!!; @@ -1455,12 +1466,12 @@ sub uri_for { $val = '' unless defined $val; (map { my $param = "$_"; - utf8::encode( $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; - utf8::encode( $key ); + $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; @@ -2052,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 @@ -2267,7 +2279,24 @@ Prepares body parameters. sub prepare_body_parameters { my $c = shift; - $c->engine->prepare_body_parameters( $c, @_ ); + $c->request->prepare_body_parameters( $c, @_ ); + + # If we have an encoding configured (like UTF-8) in general we expect a client + # to POST with the encoding we fufilled the request in. Otherwise don't do any + # encoding (good change wide chars could be in HTML entity style llike the old + # days -JNAP + + # so, now that HTTP::Body prepared the body params, we gotta 'walk' the structure + # and do any needed decoding. + + # This only does something if the encoding is set via the encoding param. Remember + # this is assuming the client is not bad and responds with what you provided. In + # general you can just use utf8 and get away with it. + + if($c->encoding) { + my $current_parameters = $c->request->body_parameters; + $c->request->body_parameters($c->_handle_unicode_decoding($current_parameters)); + } } =head2 $c->prepare_connection @@ -2361,6 +2390,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); @@ -2546,37 +2579,6 @@ Prepares uploads. sub prepare_uploads { my $c = shift; $c->engine->prepare_uploads( $c, @_ ); - - my $enc = $c->encoding; - return unless $enc; - - # Uggg we hook prepare uploads to do the encoding crap on post and query - # parameters! 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. - # http://www.mail-archive.com/catalyst@lists.scsys.co.uk/msg02350.html - # this avoids exception if we have already decoded content, and is _not_ the - # same as not encoding on output which is bad news (as it does the wrong thing - # for latin1 chars for example).. - $value = $c->_handle_unicode_decoding($value); - } - } - for my $value ( values %{ $c->request->uploads } ) { - # skip if it fails for uploads, as we don't usually want uploads touched - # in any way - for my $inner_value ( ref($value) eq 'ARRAY' ? @{$value} : $value ) { - $inner_value->{filename} = try { - $enc->decode( $inner_value->{filename}, $c->_encode_check ) - } catch { - $c->handle_unicode_encoding_exception({ - param_value => $inner_value->{filename}, - error_msg => $_, - encoding_step => 'uploads', - }); - }; - } - } } =head2 $c->prepare_write @@ -3099,8 +3101,13 @@ sub _handle_unicode_decoding { return $value; } elsif ( ref $value eq 'HASH' ) { - foreach ( values %$value ) { - $_ = $self->_handle_unicode_decoding($_); + foreach (keys %$value) { + my $encoded_key = $self->_handle_param_unicode_decoding($_); + $value->{$encoded_key} = $self->_handle_unicode_decoding($value->{$_}); + + # If the key was encoded we now have two (the original and current so + # delete the original. + delete $value->{$_} if $_ ne $encoded_key; } return $value; }