# This file documents the revision history for Perl extension Catalyst.
+5.90080_001 - TBD
+ - MyApp->to_app is now an alias for MyApp->psgi_app in order to better support
+ existing Plack conventions.
+ - Modify Catayst::Response->from_psgi_response to allow the first argument to
+ be an object that does ->as_psgi.
+ - Modified Catayst::Middleware::Stash to be a shallow copy in $env. Added some
+ docs. Added a test case to make sure stash keys added in a child application
+ don't bubble back up to the main application.
+ - We no longer use Encode::is_utf8 since it doesn't work the way we think it
+ does... This required some UTF-8 changes. If your application is UTF-8 aware
+ I highly suggest you test this release.
+ - We alway do utf8 decoding on incoming URLs (before we only did so if the server
+ encoding was utf8. I believe this is correct as per the w3c spec, but please
+ correct if incorrect :)
+ - Debug output now shows utf8 characters if those are incoming via Args or as
+ path or pathparts in your actions. query and body parameter keys are now also
+ subject to utf8 decoding (or as specificed via the encoding configuration value).
+ - lots of UTF8 changes. Again we think this is now more correct but please test.
+
5.90077 - 2014-11-18
- We store the PSGI $env in Catalyst::Engine for backcompat reasons. Changed
this so that the storage is a weak reference, so that it goes out of scope
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; }
__PACKAGE__->_encode_check(Encode::FB_CROAK | Encode::LEAVE_SRC);
# Remember to update this in Catalyst::Runtime as well!
-our $VERSION = '5.90077';
+our $VERSION = '5.90080_001';
+$VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
sub import {
my ( $class, @arguments ) = @_;
# 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<Catalyst::Middleware::Stash>. Since it's part of the C<$env> items in
+the stash can be accessed in sub applications mounted under your main
+L<Catalyst> application. For example if you delegate the response of an
+action to another L<Catalyst> 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 {
( 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);
$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!^/+!!;
# 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);
}
# 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
sub prepare_body_parameters {
my $c = shift;
- $c->engine->prepare_body_parameters( $c, @_ );
+ $c->request->prepare_body_parameters( $c, @_ );
}
=head2 $c->prepare_connection
$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);
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
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
=cut
+*to_app = \&psgi_app;
+
sub psgi_app {
my ($app) = @_;
my $psgi = $app->engine->build_psgi_app($app);
sub setup_encoding {
my $c = shift;
+ # This is where you'd set a default encoding
my $enc = delete $c->config->{encoding};
$c->encoding( $enc ) if defined $enc;
}
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;
}
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({
use Catalyst::Utils;
use URI;
use Scalar::Util ();
+use Encode 2.21 'decode_utf8';
has _endpoints => (
is => 'rw',
push(@rows, [ '', $name ]);
}
push(@rows, [ '', (@rows ? "=> " : '').($extra ? "$extra " : '')."/${endpoint}". ($consumes ? " :$consumes":"" ) ]);
- $rows[0][0] = join('/', '', @parts) || '/';
+ my @display_parts = map { $_ =~s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; decode_utf8 $_ } @parts;
+ $rows[0][0] = join('/', '', @display_parts) || '/';
$paths->row(@$_) for @rows;
}
);
}
- $action->attributes->{PathPart} = [ $part ];
+ my $encoded_part = URI->new($part)->canonical;
+ $encoded_part =~ s{(?<=[^/])/+\z}{};
- unshift(@{ $children->{$part} ||= [] }, $action);
+ $action->attributes->{PathPart} = [ $encoded_part ];
+
+ unshift(@{ $children->{$encoded_part} ||= [] }, $action);
$self->_actions->{'/'.$action->reverse} = $action;
use Text::SimpleTable;
use Catalyst::Utils;
use URI;
+use Encode 2.21 'decode_utf8';
has _paths => (
is => 'rw',
my $display_path = "/$path/$parts";
$display_path =~ s{/{1,}}{/}g;
-
+ $display_path =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; # deconvert urlencoded for pretty view
+ $display_path = decode_utf8 $display_path; # URI does encoding
$paths->row( $display_path, "/$action" );
}
}
use Tree::Simple;
use Tree::Simple::Visitor::FindByPath;
use Class::Load qw(load_class try_load_class);
+use Encode 2.21 'decode_utf8';
use namespace::clean -except => 'meta';
}
else {
my $path = $c->req->path;
+ $path =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
+ $path = decode_utf8($path);
+
my $error = $path
? qq/Unknown resource "$path"/
: "No default action defined";
s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg for grep { defined } @{$req->captures||[]};
- $c->log->debug( 'Path is "' . $req->match . '"' )
- if ( $c->debug && defined $req->match && length $req->match );
+ if($c->debug && defined $req->match && length $req->match) {
+ my $match = $req->match;
+ $match =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
+ $match = decode_utf8($match);
+ $c->log->debug( 'Path is "' . $match . '"' )
+ }
- $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' )
+ $c->log->debug( 'Arguments are "' . join( '/', map { decode_utf8 $_ } @args ) . '"' )
if ( $c->debug && @args );
}
use Data::Dump qw/dump/;
use Errno 'EWOULDBLOCK';
use HTML::Entities;
-use HTTP::Body;
use HTTP::Headers;
-use URI::QueryParam;
use Plack::Loader;
use Catalyst::EngineLoader;
-use Encode ();
+use Encode 2.21 'decode_utf8';
use Plack::Request::Upload;
use Hash::MultiValue;
-use utf8;
-
use namespace::clean -except => 'meta';
# Amount of data to read from input on each pass
# Check for keywords (no = signs)
# (yes, index() is faster than a regex :))
if ( index( $query_string, '=' ) < 0 ) {
- $c->request->query_keywords($self->unescape_uri($query_string));
+ my $keywords = $self->unescape_uri($query_string);
+ $keywords = decode_utf8 $keywords;
+ $c->request->query_keywords($keywords);
return;
}
for my $item ( @params ) {
my ($param, $value)
- = map { $self->unescape_uri($_) }
+ = map { decode_utf8($self->unescape_uri($_)) }
split( /=/, $item, 2 );
- $param = $self->unescape_uri($item) unless defined $param;
+ unless(defined $param) {
+ $param = $self->unescape_uri($item);
+ $param = decode_utf8 $param;
+ }
if ( exists $query{$param} ) {
if ( ref $query{$param} ) {
my $request = $c->request;
return unless $request->_body;
+ my $enc = $c->encoding;
my $uploads = $request->_body->upload;
my $parameters = $request->parameters;
foreach my $name (keys %$uploads) {
+ $name = $c->_handle_unicode_decoding($name) if $enc;
my $files = $uploads->{$name};
my @uploads;
for my $upload (ref $files eq 'ARRAY' ? @$files : ($files)) {
my $headers = HTTP::Headers->new( %{ $upload->{headers} } );
+ my $filename = $upload->{filename};
+ $filename = $c->_handle_unicode_decoding($filename) if $enc;
+
my $u = Catalyst::Request::Upload->new
(
size => $upload->{size},
type => scalar $headers->content_type,
headers => $headers,
tempname => $upload->{tempname},
- filename => $upload->{filename},
+ filename => $filename,
);
push @uploads, $u;
}
if ($self->can('_has_psgi_errors') and $self->_has_psgi_errors) {
$self->_psgi_errors->print(@_);
} else {
+ binmode STDERR, ":utf8";
print STDERR @_;
}
}
our @EXPORT_OK = qw(stash get_stash);
-sub PSGI_KEY { 'Catalyst.Stash.v1' };
+sub PSGI_KEY () { 'Catalyst.Stash.v1' }
sub get_stash {
my $env = shift;
- return $env->{&PSGI_KEY} ||
- _init_stash_in($env);
+ return $env->{+PSGI_KEY} ||
+ croak "You requested a stash, but one does not exist.";
}
sub stash {
};
}
-sub _init_stash_in {
- my ($env) = @_;
- return $env->{&PSGI_KEY} ||=
- _create_stash;
-}
-
sub call {
my ($self, $env) = @_;
- _init_stash_in($env);
- return $self->app->($env);
+ my $new_env = +{ %$env };
+ my %stash = %{ ($env->{+PSGI_KEY} || sub {})->() || +{} };
+
+ $new_env->{+PSGI_KEY} = _create_stash( \%stash );
+ return $self->app->($new_env);
}
=head1 TITLE
We store a coderef under the C<PSGI_KEY> which can be dereferenced with
key values or nothing to access the underly hashref.
+The stash middleware is designed so that you can 'nest' applications that
+use it. If for example you have a L<Catalyst> application that is called
+by a controller under a parent L<Catalyst> application, the child application
+will inherit the full stash of the parent BUT any new keys added by the child
+will NOT bubble back up to the parent. However, children of children will.
+
+For more information the current test case t/middleware-stash.t is the best
+documentation.
+
=head1 SUBROUTINES
This class defines the following subroutines.
["I found $stashed in the stash!"]];
};
-If the stash does not yet exist, we initialize one and return that.
+If the stash does not yet exist, an exception is thrown.
=head1 METHODS
use Stream::Buffered;
use Hash::MultiValue;
use Scalar::Util;
-
+use HTTP::Body;
use Moose;
use namespace::clean -except => 'meta';
}
sub prepare_body_parameters {
- my ( $self ) = @_;
+ my ( $self, $c ) = @_;
$self->prepare_body if ! $self->_has_body;
return $self->_use_hash_multivalue ? Hash::MultiValue->new : {};
}
+ my $params = $self->_body->param;
+
+ # 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.
+ #
+ # I need to see if $c is here since this also doubles as a builder for the object :(
+
+ if($c and $c->encoding) {
+ $params = $c->_handle_unicode_decoding($params);
+ }
+
return $self->_use_hash_multivalue ?
- Hash::MultiValue->from_mixed($self->_body->param) :
- $self->_body->param;
+ Hash::MultiValue->from_mixed($params) :
+ $params;
}
sub prepare_connection {
next unless defined $value;
for ( ref $value eq 'ARRAY' ? @$value : $value ) {
$_ = "$_";
- utf8::encode( $_ ) if utf8::is_utf8($_);
+ # utf8::encode($_);
}
};
use HTTP::Headers;
use Moose::Util::TypeConstraints;
use namespace::autoclean;
+use Scalar::Util 'blessed';
with 'MooseX::Emulate::Class::Accessor::Fast';
sub from_psgi_response {
my ($self, $psgi_res) = @_;
+ if(blessed($psgi_res) && $psgi_res->can('as_psgi')) {
+ $psgi_res = $psgi_res->as_psgi;
+ }
if(ref $psgi_res eq 'ARRAY') {
my ($status, $headers, $body) = @$psgi_res;
$self->status($status);
Properly supports streaming and delayed response and / or async IO if running
under an expected event loop.
+If passed an object, will expect that object to do a method C<as_psgi>.
+
Example:
package MyApp::Web::Controller::Test;
# Remember to update this in Catalyst as well!
-our $VERSION = '5.90077';
+our $VERSION = '5.90080_001';
+$VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
=head1 NAME
--- /dev/null
+use strict;
+use warnings;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use TestApp;
+use Test::More;
+
+ok(TestApp->can('to_app'));
+is(ref(TestApp->to_app), 'CODE');
+
+done_testing;
+use utf8;
use strict;
use warnings;
use FindBin;
my $action = $context->controller('Action::Chained')
->action_for('roundtrip_urifor_end');
-{
-use utf8;
-
is($context->uri_for($action, ['hütte'], 'hütte', {
test => 'hütte'
}),
'http://127.0.0.1/chained/roundtrip_urifor/h%C3%BCtte/h%C3%BCtte?test=h%C3%BCtte',
'uri_for with utf8 captures and args');
-}
+
+is(
+ $context->uri_for($action, ['♥'], '♥', { '♥' => '♥'}),
+ 'http://127.0.0.1/chained/roundtrip_urifor/' . '%E2%99%A5' . '/' . '%E2%99%A5' . '?' . '%E2%99%A5' . '=' . '%E2%99%A5',
+ 'uri_for with utf8 captures and args');
+
+# ^ the match string is purposefully broken up to aid viewing, please to 'fix' it.
done_testing;
--- /dev/null
+use warnings;
+use strict;
+
+{
+
+ package MyAppChild::Controller::User;
+ $INC{'MyAppChild/Controller/User.pm'} = __FILE__;
+
+ use base 'Catalyst::Controller';
+ use Test::More;
+
+ sub stash :Local {
+ my ($self, $c) = @_;
+ $c->stash->{inner} = "inner";
+ $c->res->body( "inner: ${\$c->stash->{inner}}, outer: ${\$c->stash->{outer}}");
+
+ is_deeply [sort {$a cmp $b} keys($c->stash)], ['inner','outer'], 'both keys in stash';
+ }
+
+ package MyAppChild;
+ $INC{'MyAppChild.pm'} = __FILE__;
+
+ use Catalyst;
+ MyAppChild->setup;
+
+ package MyAppParent::Controller::User;
+ $INC{'MyAppParent/Controller/User.pm'} = __FILE__;
+
+ use base 'Catalyst::Controller';
+ use Test::More;
+
+ sub stash :Local {
+ my ($self, $c) = @_;
+ $c->stash->{outer} = "outer";
+ $c->res->from_psgi_response( MyAppChild->to_app->($c->req->env) );
+
+ is_deeply [keys($c->stash)], ['outer'], 'only one key in stash';
+ }
+
+ package MyAppParent;
+ use Catalyst;
+ MyAppParent->setup;
+
+}
+
+use Test::More;
+use Catalyst::Test 'MyAppParent';
+
+my $res = request '/user/stash';
+is $res->content, 'inner: inner, outer: outer', 'got expected response';
+
+done_testing;
};
{
+ package MyApp::PSGIObject;
+
+ sub as_psgi {
+ return [200, ['Content-Type' => 'text/plain'], ['as_psgi']];
+ };
+
package MyApp::Controller::Docs;
$INC{'MyApp/Controller/Docs.pm'} = __FILE__;
use Plack::Request;
use Catalyst::Utils;
+ sub as_psgi :Local {
+ my ($self, $c) = @_;
+ my $as_psgi = bless +{}, 'MyApp::PSGIObject';
+ $c->res->from_psgi_response($as_psgi);
+ }
+
sub name :Local {
my ($self, $c) = @_;
my $env = $c->Catalyst::Utils::env_at_action;
use Catalyst::Test 'MyApp';
{
+ my ($res, $c) = ctx_request('/docs/as_psgi');
+ is $res->content, 'as_psgi';
+}
+
+{
my ($res, $c) = ctx_request('/user/mounted/111?path_prefix=1');
is $c->action, 'user/mounted';
is $res->content, 'http://localhost/user/user/local_example_args1/111';
}
done_testing();
-
-__END__
-
-
-use Plack::App::URLMap;
-use HTTP::Request::Common;
-use HTTP::Message::PSGI;
-
-my $urlmap = Plack::App::URLMap->new;
-
-my $app1 = sub {
- my $env = shift;
- return [200, [], [
- "REQUEST_URI: $env->{REQUEST_URI}, FROM: $env->{MAP_TO}, PATH_INFO: $env->{PATH_INFO}, SCRIPT_NAME $env->{SCRIPT_NAME}"]];
-};
-
-$urlmap->map("/" => sub { my $env = shift; $env->{MAP_TO} = '/'; $app1->($env)});
-$urlmap->map("/foo" => sub { my $env = shift; $env->{MAP_TO} = '/foo'; $app1->($env)});
-$urlmap->map("/bar/baz" => sub { my $env = shift; $env->{MAP_TO} = '/foo/bar'; $app1->($env)});
-
-my $app = $urlmap->to_app;
-
-warn $app->(req_to_psgi(GET '/'))->[2]->[0];
-warn $app->(req_to_psgi(GET '/111'))->[2]->[0];
-warn $app->(req_to_psgi(GET '/foo'))->[2]->[0];
-warn $app->(req_to_psgi(GET '/foo/222'))->[2]->[0];
-warn $app->(req_to_psgi(GET '/bar/baz'))->[2]->[0];
-warn $app->(req_to_psgi(GET '/bar/baz/333'))->[2]->[0];
-
my $decode_str = Encode::decode('utf-8' => $encode_str);
my $escape_str = uri_escape_utf8($decode_str);
-check_parameter(GET "/?myparam=$escape_str");
+# JNAP - I am removing this test case because I think its not correct. I think
+# we do not check the server encoding to determine if the parts of a request URL
+# both paths and query should be decoded. I think its always safe to assume utf8
+# encoded urlencoded bits. That is my reading of the spec. Please correct me if
+# I am wrong
+#check_parameter(GET "/?myparam=$escape_str");
check_parameter(POST '/',
Content_Type => 'form-data',
Content => [
my ( undef, $c ) = ctx_request(shift);
my $myparam = $c->req->param('myparam');
- ok !utf8::is_utf8($myparam);
unless ( $c->request->method eq 'POST' ) {
is $c->res->output => $encode_str;
is $myparam => $encode_str;
use strict;
use warnings;
-use Test::More tests => 5 * 5;
+use Test::More;
use utf8;
# setup library path
my $decode_str = Encode::decode('utf-8' => $encode_str);
my $escape_str = uri_escape_utf8($decode_str);
-check_parameter(GET "/?foo=$escape_str");
-check_parameter(POST '/', ['foo' => $encode_str]);
-check_parameter(POST '/',
- Content_Type => 'form-data',
- Content => [
- 'foo' => [
- "$Bin/unicode_plugin_request_decode.t",
- $encode_str,
- ]
- ],
-);
-
-check_argument(GET "/$escape_str");
-check_capture(GET "/capture/$escape_str");
-
-# sending non-utf8 data
-my $non_utf8_data = "%C3%E6%CB%AA";
-check_fallback(GET "/?q=${non_utf8_data}");
-check_fallback(GET "/${non_utf8_data}");
-check_fallback(GET "/capture/${non_utf8_data}");
-check_fallback(POST '/', ['foo' => $non_utf8_data]);
-
sub check_parameter {
my ( undef, $c ) = ctx_request(shift);
is $c->res->output => '<h1>It works</h1>';
my $foo = $c->req->param('foo');
- ok utf8::is_utf8($foo);
- is $foo => $decode_str;
+ is $foo, $decode_str;
my $other_foo = $c->req->method eq 'POST'
? $c->req->upload('foo')
? $c->req->upload('foo')->filename
: $c->req->body_parameters->{foo}
: $c->req->query_parameters->{foo};
- ok utf8::is_utf8($other_foo);
+
is $other_foo => $decode_str;
}
is $c->res->output => '<h1>It works</h1>';
my $foo = $c->req->args->[0];
- ok utf8::is_utf8($foo);
is $foo => $decode_str;
}
is $c->res->output => '<h1>It works</h1>';
my $foo = $c->req->captures->[0];
- ok utf8::is_utf8($foo);
is $foo => $decode_str;
}
my ( $res, $c ) = ctx_request(shift);
ok(!is_server_error($res->code)) or diag('Response code is: ' . $res->code);
}
+
+check_parameter(GET "/?foo=$escape_str");
+check_parameter(POST '/', ['foo' => $encode_str]);
+check_parameter(POST '/',
+ Content_Type => 'form-data',
+ Content => [
+ 'foo' => [
+ "$Bin/unicode_plugin_request_decode.t",
+ $encode_str,
+ ]
+ ],
+);
+
+check_argument(GET "/$escape_str");
+check_capture(GET "/capture/$escape_str");
+
+# sending non-utf8 data
+my $non_utf8_data = "%C3%E6%CB%AA";
+check_fallback(GET "/?q=${non_utf8_data}");
+check_fallback(GET "/${non_utf8_data}");
+check_fallback(GET "/capture/${non_utf8_data}");
+check_fallback(POST '/', ['foo' => $non_utf8_data]);
+
+done_testing;
--- /dev/null
+use utf8;
+use warnings;
+use strict;
+use Test::More;
+use HTTP::Request::Common;
+
+# Test cases for incoming utf8
+
+{
+ package MyApp::Controller::Root;
+ $INC{'MyApp/Controller/Root.pm'} = __FILE__;
+
+ use base 'Catalyst::Controller';
+
+ sub heart :Path('♥') {
+ my ($self, $c) = @_;
+ $c->response->content_type('text/html');
+ $c->response->body("<p>This is path-heart action ♥</p>");
+ # We let the content length middleware find the length...
+ }
+
+ sub hat :Path('^') {
+ my ($self, $c) = @_;
+ $c->response->content_type('text/html');
+ $c->response->body("<p>This is path-hat action ^</p>");
+ }
+
+ sub uri_for :Path('uri_for') {
+ my ($self, $c) = @_;
+ $c->response->content_type('text/html');
+ $c->response->body("${\$c->uri_for($c->controller('Root')->action_for('argend'), ['♥'], '♥', {'♥'=>'♥♥'})}");
+ }
+
+ sub heart_with_arg :Path('a♥') Args(1) {
+ my ($self, $c, $arg) = @_;
+ $c->response->content_type('text/html');
+ $c->response->body("<p>This is path-heart-arg action $arg</p>");
+ Test::More::is $c->req->args->[0], '♥';
+ }
+
+ sub base :Chained('/') CaptureArgs(0) { }
+ sub link :Chained('base') PathPart('♥') Args(0) {
+ my ($self, $c) = @_;
+ $c->response->content_type('text/html');
+ $c->response->body("<p>This is base-link action ♥</p>");
+ }
+ sub arg :Chained('base') PathPart('♥') Args(1) {
+ my ($self, $c, $arg) = @_;
+ $c->response->content_type('text/html');
+ $c->response->body("<p>This is base-link action ♥ $arg</p>");
+ }
+ sub capture :Chained('base') PathPart('♥') CaptureArgs(1) {
+ my ($self, $c, $arg) = @_;
+ $c->stash(capture=>$arg);
+ }
+ sub argend :Chained('capture') PathPart('♥') Args(1) {
+ my ($self, $c, $arg) = @_;
+ $c->response->content_type('text/html');
+
+ Test::More::is $c->req->args->[0], '♥';
+ Test::More::is $c->req->captures->[0], '♥';
+
+ $c->response->body("<p>This is base-link action ♥ ${\$c->req->args->[0]}</p>");
+ }
+
+ package MyApp;
+ use Catalyst;
+
+ MyApp->config(encoding=>'UTF-8');
+
+ Test::More::ok(MyApp->setup, 'setup app');
+}
+
+ok my $psgi = MyApp->psgi_app, 'build psgi app';
+
+use Catalyst::Test 'MyApp';
+use Encode 2.21 'decode_utf8', 'encode_utf8';
+
+{
+ my $res = request "/root/♥";
+
+ is $res->code, 200, 'OK';
+ is decode_utf8($res->content), '<p>This is path-heart action ♥</p>', 'correct body';
+ is $res->content_length, 36, 'correct length';
+}
+
+{
+ my $res = request "/root/a♥/♥";
+
+ is $res->code, 200, 'OK';
+ is decode_utf8($res->content), '<p>This is path-heart-arg action ♥</p>', 'correct body';
+ is $res->content_length, 40, 'correct length';
+}
+
+{
+ my $res = request "/root/^";
+
+ is $res->code, 200, 'OK';
+ is decode_utf8($res->content), '<p>This is path-hat action ^</p>', 'correct body';
+ is $res->content_length, 32, 'correct length';
+}
+
+{
+ my $res = request "/base/♥";
+
+ is $res->code, 200, 'OK';
+ is decode_utf8($res->content), '<p>This is base-link action ♥</p>', 'correct body';
+ is $res->content_length, 35, 'correct length';
+}
+
+{
+ my ($res, $c) = ctx_request POST "/base/♥?♥=♥&♥=♥♥", [a=>1, b=>'', '♥'=>'♥', '♥'=>'♥♥'];
+
+ is $res->code, 200, 'OK';
+ is decode_utf8($res->content), '<p>This is base-link action ♥</p>', 'correct body';
+ is $res->content_length, 35, 'correct length';
+ is $c->req->parameters->{'♥'}[0], '♥';
+ is $c->req->query_parameters->{'♥'}[0], '♥';
+ is $c->req->body_parameters->{'♥'}[0], '♥';
+ is $c->req->parameters->{'♥'}[0], '♥';
+ is $c->req->parameters->{a}, 1;
+ is $c->req->body_parameters->{a}, 1;
+}
+
+{
+ my ($res, $c) = ctx_request GET "/base/♥?♥♥♥";
+
+ is $res->code, 200, 'OK';
+ is decode_utf8($res->content), '<p>This is base-link action ♥</p>', 'correct body';
+ is $res->content_length, 35, 'correct length';
+ is $c->req->query_keywords, '♥♥♥';
+}
+
+{
+ my $res = request "/base/♥/♥";
+
+ is $res->code, 200, 'OK';
+ is decode_utf8($res->content), '<p>This is base-link action ♥ ♥</p>', 'correct body';
+ is $res->content_length, 39, 'correct length';
+}
+
+{
+ my $res = request "/base/♥/♥/♥/♥";
+
+ is $res->code, 200, 'OK';
+ is decode_utf8($res->content), '<p>This is base-link action ♥ ♥</p>', 'correct body';
+ is $res->content_length, 39, 'correct length';
+}
+
+{
+ my ($res, $c) = ctx_request POST "/base/♥/♥/♥/♥?♥=♥♥", [a=>1, b=>'2', '♥'=>'♥♥'];
+
+ ## Make sure that the urls we generate work the same
+ my $uri_for = $c->uri_for($c->controller('Root')->action_for('argend'), ['♥'], '♥', {'♥'=>'♥♥'});
+ my $uri = $c->req->uri;
+
+ is "$uri", "$uri_for";
+
+ {
+ my ($res, $c) = ctx_request POST "$uri_for", [a=>1, b=>'2', '♥'=>'♥♥'];
+ is $c->req->query_parameters->{'♥'}, '♥♥';
+ is $c->req->body_parameters->{'♥'}, '♥♥';
+ is $c->req->parameters->{'♥'}[0], '♥♥'; #combined with query and body
+ }
+}
+
+{
+ my ($res, $c) = ctx_request "/root/uri_for";
+ my $url = $c->uri_for($c->controller('Root')->action_for('argend'), ['♥'], '♥', {'♥'=>'♥♥'});
+
+ is $res->code, 200, 'OK';
+ is decode_utf8($res->content), "$url", 'correct body'; #should do nothing
+ is $res->content, "$url", 'correct body';
+ is $res->content_length, 90, 'correct length';
+}
+
+done_testing;
projects / catagits/Catalyst-Runtime.git / commitdiff