5 use HTTP::Request::Common;
6 use HTTP::Message::PSGI ();
7 use Encode 2.21 'decode_utf8', 'encode_utf8', 'encode';
13 # Test cases for incoming utf8
16 package MyApp::Controller::Root;
17 $INC{'MyApp/Controller/Root.pm'} = __FILE__;
19 use base 'Catalyst::Controller';
21 sub heart :Path('♥') {
23 $c->response->content_type('text/html');
24 $c->response->body("<p>This is path-heart action ♥</p>");
25 # We let the content length middleware find the length...
30 $c->response->content_type('text/html');
31 $c->response->body("<p>This is path-hat action ^</p>");
34 sub uri_for :Path('uri_for') {
36 $c->response->content_type('text/html');
37 $c->response->body("${\$c->uri_for($c->controller('Root')->action_for('argend'), ['♥'], '♥#X♥X', {'♥'=>'♥♥'})}");
40 sub heart_with_arg :Path('a♥') Args(1) {
41 my ($self, $c, $arg) = @_;
42 $c->response->content_type('text/html');
43 $c->response->body("<p>This is path-heart-arg action $arg</p>");
44 Test::More::is $c->req->args->[0], '♥';
47 sub base :Chained('/') CaptureArgs(0) { }
48 sub link :Chained('base') PathPart('♥') Args(0) {
50 $c->response->content_type('text/html');
51 $c->response->body("<p>This is base-link action ♥</p>");
53 sub arg :Chained('base') PathPart('♥') Args(1) {
54 my ($self, $c, $arg) = @_;
55 $c->response->content_type('text/html');
56 $c->response->body("<p>This is base-link action ♥ $arg</p>");
58 sub capture :Chained('base') PathPart('♥') CaptureArgs(1) {
59 my ($self, $c, $arg) = @_;
60 $c->stash(capture=>$arg);
62 sub argend :Chained('capture') PathPart('♥') Args(1) {
63 my ($self, $c, $arg) = @_;
64 $c->response->content_type('text/html');
66 Test::More::is $c->req->args->[0], '♥';
67 Test::More::is $c->req->captures->[0], '♥';
68 Test::More::is $arg, '♥';
69 Test::More::is length($arg), 1, "got length of one";
71 $c->response->body("<p>This is base-link action ♥ ${\$c->req->args->[0]}</p>");
73 # Test to make sure redirect can now take an object (sorry don't have a better place for it
74 # but wanted test coverage.
75 my $location = $c->res->redirect( $c->uri_for($c->controller('Root')->action_for('uri_for')) );
76 Test::More::ok !ref $location;
79 sub stream_write :Local {
81 $c->response->content_type('text/html');
82 $c->response->write("<p>This is stream_write action ♥</p>");
85 sub stream_write_fh :Local {
87 $c->response->content_type('text/html');
89 my $writer = $c->res->write_fh;
90 $writer->write_encoded('<p>This is stream_write_fh action ♥</p>');
94 # Stream a file with utf8 chars directly, you don't need to decode
95 sub stream_body_fh :Local {
97 my $path = File::Spec->catfile('t', 'utf8.txt');
98 open(my $fh, '<', $path) || die "trouble: $!";
99 $c->response->content_type('text/html');
100 $c->response->body($fh);
103 # If you pull the file contents into a var, NOW you need to specify the
104 # IO encoding on the FH. Ultimately Plack at the end wants bytes...
105 sub stream_body_fh2 :Local {
107 my $path = File::Spec->catfile('t', 'utf8.txt');
108 open(my $fh, '<:encoding(UTF-8)', $path) || die "trouble: $!";
109 my $contents = do { local $/; <$fh> };
111 $c->response->content_type('text/html');
112 $c->response->body($contents);
115 sub write_then_body :Local {
118 $c->res->content_type('text/html');
119 $c->res->write("<p>This is early_write action ♥</p>");
120 $c->res->body("<p>This is body_write action ♥</p>");
123 sub file_upload :POST Consumes(Multipart) Local {
126 Test::More::is $c->req->body_parameters->{'♥'}, '♥♥';
127 Test::More::ok my $upload = $c->req->uploads->{file};
128 Test::More::is $upload->charset, 'UTF-8';
130 my $text = $upload->slurp;
131 Test::More::is Encode::decode_utf8($text), "<p>This is stream_body_fh action ♥</p>\n";
133 my $decoded_text = $upload->decoded_slurp;
134 Test::More::is $decoded_text, "<p>This is stream_body_fh action ♥</p>\n";
136 Test::More::is $upload->filename, '♥ttachment.txt';
137 Test::More::is $upload->raw_basename, '♥ttachment.txt';
139 $c->response->content_type('text/html');
140 $c->response->body($decoded_text);
143 sub file_upload_utf8_param :POST Consumes(Multipart) Local {
146 Test::More::is $c->req->body_parameters->{'♥'}, '♥♥';
147 Test::More::ok my $upload = $c->req->uploads->{'♥'};
148 Test::More::is $upload->charset, 'UTF-8';
150 my $text = $upload->slurp;
151 Test::More::is Encode::decode_utf8($text), "<p>This is stream_body_fh action ♥</p>\n";
153 my $decoded_text = $upload->decoded_slurp;
154 Test::More::is $decoded_text, "<p>This is stream_body_fh action ♥</p>\n";
156 Test::More::is $upload->filename, '♥ttachment.txt';
157 Test::More::is $upload->raw_basename, '♥ttachment.txt';
159 $c->response->content_type('text/html');
160 $c->response->body($decoded_text);
163 sub json :POST Consumes(JSON) Local {
165 my $post = $c->req->body_data;
167 Test::More::is $post->{'♥'}, '♥♥';
168 Test::More::is length($post->{'♥'}), 2;
169 $c->response->content_type('application/json');
171 # Encode JSON also encodes to a UTF-8 encoded, binary string. This is why we don't
172 # have application/json as one of the things we match, otherwise we get double
174 $c->response->body(JSON::MaybeXS::encode_json($post));
177 ## If someone clears encoding, they can do as they wish
178 sub manual_1 :Local {
181 $c->res->content_type('text/plain');
182 $c->res->content_type_charset('UTF-8');
183 $c->response->body( Encode::encode_utf8("manual_1 ♥"));
186 ## If you do like gzip, well handle that yourself! Basically if you do some sort
187 ## of content encoding like gzip, you must do on top of the encoding. We will fix
188 ## the encoding plugins (Catalyst::Plugin::Compress) to do this properly for you.
191 require Compress::Zlib;
193 $c->res->content_type('text/plain');
194 $c->res->content_type_charset('UTF-8');
195 $c->res->content_encoding('gzip');
196 $c->response->body(Compress::Zlib::memGzip(Encode::encode_utf8("manual_1 ♥")));
199 sub override_encoding :Local {
201 $c->res->content_type('text/plain');
202 $c->encoding(Encode::find_encoding('UTF-8'));
203 $c->encoding(Encode::find_encoding('Shift_JIS'));
204 $c->response->body("テスト");
207 sub stream_write_error :Local {
209 $c->response->content_type('text/html');
210 $c->response->write("<p>This is stream_write action ♥</p>");
211 $c->encoding(Encode::find_encoding('Shift_JIS'));
212 $c->response->write("<p>This is stream_write action ♥</p>");
215 sub from_external_psgi :Local {
217 my $env = HTTP::Message::PSGI::req_to_psgi( HTTP::Request::Common::GET '/root/♥');
218 $c->res->from_psgi_response( ref($c)->to_app->($env));
221 sub echo_arg :Local {
223 $c->response->content_type('text/plain');
224 $c->response->body($c->req->body_parameters->{arg});
227 sub echo_param :Local {
229 $c->response->content_type('text/plain');
230 $c->response->body($c->req->query_parameters->{arg});
237 Test::More::ok(MyApp->setup('-Log=fatal'), 'setup app');
240 ok my $psgi = MyApp->psgi_app, 'build psgi app';
242 use Catalyst::Test 'MyApp';
245 my $res = request "/root/♥";
247 is $res->code, 200, 'OK';
248 is decode_utf8($res->content), '<p>This is path-heart action ♥</p>', 'correct body';
249 is $res->content_length, 36, 'correct length';
250 is $res->content_charset, 'UTF-8';
254 my $res = request "/root/a♥/♥";
256 is $res->code, 200, 'OK';
257 is decode_utf8($res->content), '<p>This is path-heart-arg action ♥</p>', 'correct body';
258 is $res->content_length, 40, 'correct length';
259 is $res->content_charset, 'UTF-8';
263 my $res = request "/root/^";
265 is $res->code, 200, 'OK';
266 is decode_utf8($res->content), '<p>This is path-hat action ^</p>', 'correct body';
267 is $res->content_length, 32, 'correct length';
268 is $res->content_charset, 'UTF-8';
272 my $res = request "/base/♥";
274 is $res->code, 200, 'OK';
275 is decode_utf8($res->content), '<p>This is base-link action ♥</p>', 'correct body';
276 is $res->content_length, 35, 'correct length';
277 is $res->content_charset, 'UTF-8';
281 my ($res, $c) = ctx_request POST "/base/♥?♥=♥&♥=♥♥", [a=>1, b=>'', '♥'=>'♥', '♥'=>'♥♥'];
283 is $res->code, 200, 'OK';
284 is decode_utf8($res->content), '<p>This is base-link action ♥</p>', 'correct body';
285 is $res->content_length, 35, 'correct length';
286 is $c->req->parameters->{'♥'}[0], '♥';
287 is $c->req->query_parameters->{'♥'}[0], '♥';
288 is $c->req->body_parameters->{'♥'}[0], '♥';
289 is $c->req->parameters->{'♥'}[0], '♥';
290 is $c->req->parameters->{a}, 1;
291 is $c->req->body_parameters->{a}, 1;
292 is $res->content_charset, 'UTF-8';
296 my ($res, $c) = ctx_request GET "/base/♥?♥♥♥";
298 is $res->code, 200, 'OK';
299 is decode_utf8($res->content), '<p>This is base-link action ♥</p>', 'correct body';
300 is $res->content_length, 35, 'correct length';
301 is $c->req->query_keywords, '♥♥♥';
302 is $res->content_charset, 'UTF-8';
306 my $res = request "/base/♥/♥";
308 is $res->code, 200, 'OK';
309 is decode_utf8($res->content), '<p>This is base-link action ♥ ♥</p>', 'correct body';
310 is $res->content_length, 39, 'correct length';
311 is $res->content_charset, 'UTF-8';
315 my $res = request "/base/♥/♥/♥/♥";
317 is decode_utf8($res->content), '<p>This is base-link action ♥ ♥</p>', 'correct body';
318 is $res->content_length, 39, 'correct length';
319 is $res->content_charset, 'UTF-8';
323 my ($res, $c) = ctx_request POST "/base/♥/♥/♥/♥?♥=♥♥", [a=>1, b=>'2', '♥'=>'♥♥'];
325 ## Make sure that the urls we generate work the same
326 my $uri_for1 = $c->uri_for($c->controller('Root')->action_for('argend'), ['♥'], '♥', {'♥'=>'♥♥'});
327 my $uri_for2 = $c->uri_for($c->controller('Root')->action_for('argend'), ['♥', '♥'], {'♥'=>'♥♥'});
328 my $uri = $c->req->uri;
330 is "$uri_for1", "$uri_for2";
331 is "$uri", "$uri_for1";
334 my ($res, $c) = ctx_request POST "$uri_for1", [a=>1, b=>'2', '♥'=>'♥♥'];
335 is $c->req->query_parameters->{'♥'}, '♥♥';
336 is $c->req->body_parameters->{'♥'}, '♥♥';
337 is $c->req->parameters->{'♥'}[0], '♥♥'; #combined with query and body
338 is $c->req->args->[0], '♥';
339 is length($c->req->parameters->{'♥'}[0]), 2;
340 is length($c->req->query_parameters->{'♥'}), 2;
341 is length($c->req->body_parameters->{'♥'}), 2;
342 is length($c->req->args->[0]), 1;
343 is $res->content_charset, 'UTF-8';
348 my ($res, $c) = ctx_request "/root/uri_for";
349 my $url = $c->uri_for($c->controller('Root')->action_for('argend'), ['♥'], '♥#X♥X', {'♥'=>'♥♥'});
351 is $res->code, 200, 'OK';
352 is decode_utf8($res->content), "$url", 'correct body'; #should do nothing
353 is $res->content, "$url", 'correct body';
354 is $res->content_length, 104, 'correct length';
355 is $res->content_charset, 'UTF-8';
358 my $url = $c->uri_for($c->controller->action_for('heart_with_arg'), '♥');
359 is "$url", 'http://localhost/root/a%E2%99%A5/%E2%99%A5', "correct $url";
363 my $url = $c->uri_for($c->controller->action_for('heart_with_arg'), ['♥']);
364 is "$url", 'http://localhost/root/a%E2%99%A5/%E2%99%A5', "correct $url";
369 my $res = request "/root/stream_write";
371 is $res->code, 200, 'OK GET /root/stream_write';
372 is decode_utf8($res->content), '<p>This is stream_write action ♥</p>', 'correct body';
373 is $res->content_charset, 'UTF-8';
377 my $res = request "/root/stream_body_fh";
379 is $res->code, 200, 'OK';
380 is decode_utf8($res->content), "<p>This is stream_body_fh action ♥</p>\n", 'correct body';
381 is $res->content_charset, 'UTF-8';
382 # Not sure why there is a trailing newline above... its not in catalyst code I can see. Not sure
383 # if is a problem or just an artifact of the why the test stuff works - JNAP
387 my $res = request "/root/stream_write_fh";
389 is $res->code, 200, 'OK';
390 is decode_utf8($res->content), '<p>This is stream_write_fh action ♥</p>', 'correct body';
391 #is $res->content_length, 41, 'correct length';
392 is $res->content_charset, 'UTF-8';
396 my $res = request "/root/stream_body_fh2";
398 is $res->code, 200, 'OK';
399 is decode_utf8($res->content), "<p>This is stream_body_fh action ♥</p>\n", 'correct body';
400 is $res->content_length, 41, 'correct length';
401 is $res->content_charset, 'UTF-8';
405 my $res = request "/root/write_then_body";
407 is $res->code, 200, 'OK';
408 is decode_utf8($res->content), "<p>This is early_write action ♥</p><p>This is body_write action ♥</p>";
409 is $res->content_charset, 'UTF-8';
413 ok my $path = File::Spec->catfile('t', 'utf8.txt');
414 ok my $req = POST '/root/file_upload',
415 Content_Type => 'form-data',
416 Content => [encode_utf8('♥')=>encode_utf8('♥♥'), file=>["$path", encode_utf8('♥ttachment.txt'), 'Content-Type' =>'text/html; charset=UTF-8', ]];
418 ok my $res = request $req;
419 is decode_utf8($res->content), "<p>This is stream_body_fh action ♥</p>\n";
423 ok my $path = File::Spec->catfile('t', 'utf8.txt');
424 ok my $req = POST '/root/file_upload_utf8_param',
425 Content_Type => 'form-data',
426 Content => [encode_utf8('♥')=>encode_utf8('♥♥'), encode_utf8('♥')=>["$path", encode_utf8('♥ttachment.txt'), 'Content-Type' =>'text/html; charset=UTF-8', ]];
428 ok my $res = request $req;
429 is decode_utf8($res->content), "<p>This is stream_body_fh action ♥</p>\n";
433 ok my $req = POST '/root/json',
434 Content_Type => 'application/json',
435 Content => encode_json +{'♥'=>'♥♥'}; # Note: JSON does the UTF* encoding for us
437 ok my $res = request $req;
439 ## decode_json expect the binary utf8 string and does the decoded bit for us.
440 is_deeply decode_json(($res->content)), +{'♥'=>'♥♥'}, 'JSON was decoded correctly';
444 ok my $res = request "/root/override_encoding";
445 ok my $enc = Encode::find_encoding('SHIFT_JIS');
447 is $res->code, 200, 'OK';
448 is $enc->decode($res->content), "テスト", 'correct body';
449 is $res->content_length, 6, 'correct length'; # Bytes over the wire
450 is length($enc->decode($res->content)), 3;
451 is $res->content_charset, 'SHIFT_JIS', 'content charset is SHIFT_JIS as expected';
455 my $res = request "/root/manual_1";
457 is $res->code, 200, 'OK';
458 is decode_utf8($res->content), "manual_1 ♥", 'correct body';
459 is $res->content_length, 12, 'correct length';
460 is $res->content_charset, 'UTF-8';
464 eval { require Compress::Zlib; 1} || do {
465 skip "Compress::Zlib needed to test gzip encoding", 5 };
467 my $res = request "/root/gzipped";
468 ok my $raw_content = $res->content;
469 ok my $content = Compress::Zlib::memGunzip($raw_content), 'no gunzip error';
471 is $res->code, 200, 'OK';
472 is decode_utf8($content), "manual_1 ♥", 'correct body';
473 is $res->content_charset, 'UTF-8', 'zlib charset is set correctly';
477 my $res = request "/root/stream_write_error";
479 is $res->code, 200, 'OK';
480 like decode_utf8($res->content), qr[<p>This is stream_write action ♥</p><!DOCTYPE html], 'correct body';
484 my $res = request "/root/from_external_psgi";
486 is $res->code, 200, 'OK';
487 is decode_utf8($res->content), '<p>This is path-heart action ♥</p>', 'correct body';
488 is $res->content_length, 36, 'correct length';
489 is $res->content_charset, 'UTF-8', 'external PSGI app has expected charset';
494 my $shiftjs = 'test テスト';
496 ok my $req = POST '/root/echo_arg',
497 Content_Type => 'form-data',
499 arg0 => 'helloworld',
500 Encode::encode('UTF-8','♥') => Encode::encode('UTF-8','♥♥'), # Long form POST simple does not auto encode...
501 Encode::encode('UTF-8','♥♥♥') => [
503 'Content-Type' =>'text/plain; charset=SHIFT_JIS',
504 'Content' => Encode::encode('SHIFT_JIS', $shiftjs)],
507 'Content-Type' =>'text/plain; charset=UTF-8',
508 'Content' => Encode::encode('UTF-8', $utf8)],
511 'Content-Type' =>'text/plain; charset=SHIFT_JIS',
512 'Content' => Encode::encode('SHIFT_JIS', $shiftjs)],
515 'Content-Type' =>'text/plain; charset=SHIFT_JIS',
516 'Content' => Encode::encode('SHIFT_JIS', $shiftjs)],
519 my ($res, $c) = ctx_request $req;
521 is $c->req->body_parameters->{'arg0'}, 'helloworld', 'got helloworld value';
522 is $c->req->body_parameters->{'♥'}, '♥♥';
523 is $c->req->body_parameters->{'arg1'}, $utf8, 'decoded utf8 param';
524 is $c->req->body_parameters->{'arg2'}[0], $shiftjs, 'decoded shiftjs param';
525 is $c->req->body_parameters->{'arg2'}[1], $shiftjs, 'decoded shiftjs param';
526 is $c->req->body_parameters->{'♥♥♥'}, $shiftjs, 'decoded shiftjs param';
531 my $shiftjs = 'test テスト';
532 my $encoded = Encode::encode('UTF-8', $shiftjs);
534 ok my $req = GET "/root/echo_arg?a=$encoded";
535 my ($res, $c) = ctx_request $req;
537 is $c->req->query_parameters->{'a'}, $shiftjs, 'got expected value';
544 my $req = GET "/$invalid";
545 my $res = request $req;
546 is ($res->code, '400', "Invalid url param is 400");
550 my $req = POST "/root/echo_arg", Content => "arg0=$invalid";
551 my $res = request $req;
552 is ($res->code, '400', "Invalid post param is 400");
556 # failing since 5.90080
557 my $req = GET "/root/echo_param?arg=$invalid";
558 my $res = request $req;
559 is ($res->code, '400', "Invalid get param is 400") or diag Dumper($res->decoded_content);
563 ## should we use binmode on filehandles to force the encoding...?
564 ## Not sure what else to do with multipart here, if docs are enough...