5 use HTTP::Request::Common;
6 use HTTP::Message::PSGI ();
7 use Encode 2.21 'decode_utf8', 'encode_utf8', 'encode';
12 # Test cases for incoming utf8
15 package MyApp::Controller::Root;
16 $INC{'MyApp/Controller/Root.pm'} = __FILE__;
18 use base 'Catalyst::Controller';
20 sub heart :Path('♥') {
22 $c->response->content_type('text/html');
23 $c->response->body("<p>This is path-heart action ♥</p>");
24 # We let the content length middleware find the length...
29 $c->response->content_type('text/html');
30 $c->response->body("<p>This is path-hat action ^</p>");
33 sub uri_for :Path('uri_for') {
35 $c->response->content_type('text/html');
36 $c->response->body("${\$c->uri_for($c->controller('Root')->action_for('argend'), ['♥'], '♥#X♥X', {'♥'=>'♥♥'})}");
39 sub heart_with_arg :Path('a♥') Args(1) {
40 my ($self, $c, $arg) = @_;
41 $c->response->content_type('text/html');
42 $c->response->body("<p>This is path-heart-arg action $arg</p>");
43 Test::More::is $c->req->args->[0], '♥';
46 sub base :Chained('/') CaptureArgs(0) { }
47 sub link :Chained('base') PathPart('♥') Args(0) {
49 $c->response->content_type('text/html');
50 $c->response->body("<p>This is base-link action ♥</p>");
52 sub arg :Chained('base') PathPart('♥') Args(1) {
53 my ($self, $c, $arg) = @_;
54 $c->response->content_type('text/html');
55 $c->response->body("<p>This is base-link action ♥ $arg</p>");
57 sub capture :Chained('base') PathPart('♥') CaptureArgs(1) {
58 my ($self, $c, $arg) = @_;
59 $c->stash(capture=>$arg);
61 sub argend :Chained('capture') PathPart('♥') Args(1) {
62 my ($self, $c, $arg) = @_;
63 $c->response->content_type('text/html');
65 Test::More::is $c->req->args->[0], '♥';
66 Test::More::is $c->req->captures->[0], '♥';
67 Test::More::is $arg, '♥';
68 Test::More::is length($arg), 1, "got length of one";
70 $c->response->body("<p>This is base-link action ♥ ${\$c->req->args->[0]}</p>");
72 # Test to make sure redirect can now take an object (sorry don't have a better place for it
73 # but wanted test coverage.
74 my $location = $c->res->redirect( $c->uri_for($c->controller('Root')->action_for('uri_for')) );
75 Test::More::ok !ref $location;
78 sub stream_write :Local {
80 $c->response->content_type('text/html');
81 $c->response->write("<p>This is stream_write action ♥</p>");
84 sub stream_write_fh :Local {
86 $c->response->content_type('text/html');
88 my $writer = $c->res->write_fh;
89 $writer->write_encoded('<p>This is stream_write_fh action ♥</p>');
93 # Stream a file with utf8 chars directly, you don't need to decode
94 sub stream_body_fh :Local {
96 my $path = File::Spec->catfile('t', 'utf8.txt');
97 open(my $fh, '<', $path) || die "trouble: $!";
98 $c->response->content_type('text/html');
99 $c->response->body($fh);
102 # If you pull the file contents into a var, NOW you need to specify the
103 # IO encoding on the FH. Ultimately Plack at the end wants bytes...
104 sub stream_body_fh2 :Local {
106 my $path = File::Spec->catfile('t', 'utf8.txt');
107 open(my $fh, '<:encoding(UTF-8)', $path) || die "trouble: $!";
108 my $contents = do { local $/; <$fh> };
110 $c->response->content_type('text/html');
111 $c->response->body($contents);
114 sub write_then_body :Local {
117 $c->res->content_type('text/html');
118 $c->res->write("<p>This is early_write action ♥</p>");
119 $c->res->body("<p>This is body_write action ♥</p>");
122 sub file_upload :POST Consumes(Multipart) Local {
125 Test::More::is $c->req->body_parameters->{'♥'}, '♥♥';
126 Test::More::ok my $upload = $c->req->uploads->{file};
127 Test::More::is $upload->charset, 'UTF-8';
129 my $text = $upload->slurp;
130 Test::More::is Encode::decode_utf8($text), "<p>This is stream_body_fh action ♥</p>\n";
132 my $decoded_text = $upload->decoded_slurp;
133 Test::More::is $decoded_text, "<p>This is stream_body_fh action ♥</p>\n";
135 Test::More::is $upload->filename, '♥ttachment.txt';
136 Test::More::is $upload->raw_basename, '♥ttachment.txt';
138 $c->response->content_type('text/html');
139 $c->response->body($decoded_text);
142 sub file_upload_utf8_param :POST Consumes(Multipart) Local {
145 Test::More::is $c->req->body_parameters->{'♥'}, '♥♥';
146 Test::More::ok my $upload = $c->req->uploads->{'♥'};
147 Test::More::is $upload->charset, 'UTF-8';
149 my $text = $upload->slurp;
150 Test::More::is Encode::decode_utf8($text), "<p>This is stream_body_fh action ♥</p>\n";
152 my $decoded_text = $upload->decoded_slurp;
153 Test::More::is $decoded_text, "<p>This is stream_body_fh action ♥</p>\n";
155 Test::More::is $upload->filename, '♥ttachment.txt';
156 Test::More::is $upload->raw_basename, '♥ttachment.txt';
158 $c->response->content_type('text/html');
159 $c->response->body($decoded_text);
162 sub json :POST Consumes(JSON) Local {
164 my $post = $c->req->body_data;
166 Test::More::is $post->{'♥'}, '♥♥';
167 Test::More::is length($post->{'♥'}), 2;
168 $c->response->content_type('application/json');
170 # Encode JSON also encodes to a UTF-8 encoded, binary string. This is why we don't
171 # have application/json as one of the things we match, otherwise we get double
173 $c->response->body(JSON::MaybeXS::encode_json($post));
176 ## If someone clears encoding, they can do as they wish
177 sub manual_1 :Local {
180 $c->res->content_type('text/plain');
181 $c->res->content_type_charset('UTF-8');
182 $c->response->body( Encode::encode_utf8("manual_1 ♥"));
185 ## If you do like gzip, well handle that yourself! Basically if you do some sort
186 ## of content encoding like gzip, you must do on top of the encoding. We will fix
187 ## the encoding plugins (Catalyst::Plugin::Compress) to do this properly for you.
190 require Compress::Zlib;
192 $c->res->content_type('text/plain');
193 $c->res->content_type_charset('UTF-8');
194 $c->res->content_encoding('gzip');
195 $c->response->body(Compress::Zlib::memGzip(Encode::encode_utf8("manual_1 ♥")));
198 sub override_encoding :Local {
200 $c->res->content_type('text/plain');
201 $c->encoding(Encode::find_encoding('UTF-8'));
202 $c->encoding(Encode::find_encoding('Shift_JIS'));
203 $c->response->body("テスト");
206 sub stream_write_error :Local {
208 $c->response->content_type('text/html');
209 $c->response->write("<p>This is stream_write action ♥</p>");
210 $c->encoding(Encode::find_encoding('Shift_JIS'));
211 $c->response->write("<p>This is stream_write action ♥</p>");
214 sub from_external_psgi :Local {
216 my $env = HTTP::Message::PSGI::req_to_psgi( HTTP::Request::Common::GET '/root/♥');
217 $c->res->from_psgi_response( ref($c)->to_app->($env));
220 sub echo_arg :Local {
222 $c->response->content_type('text/plain');
223 $c->response->body($c->req->body_parameters->{arg});
229 Test::More::ok(MyApp->setup, 'setup app');
232 ok my $psgi = MyApp->psgi_app, 'build psgi app';
234 use Catalyst::Test 'MyApp';
237 my $res = request "/root/♥";
239 is $res->code, 200, 'OK';
240 is decode_utf8($res->content), '<p>This is path-heart action ♥</p>', 'correct body';
241 is $res->content_length, 36, 'correct length';
242 is $res->content_charset, 'UTF-8';
246 my $res = request "/root/a♥/♥";
248 is $res->code, 200, 'OK';
249 is decode_utf8($res->content), '<p>This is path-heart-arg action ♥</p>', 'correct body';
250 is $res->content_length, 40, 'correct length';
251 is $res->content_charset, 'UTF-8';
255 my $res = request "/root/^";
257 is $res->code, 200, 'OK';
258 is decode_utf8($res->content), '<p>This is path-hat action ^</p>', 'correct body';
259 is $res->content_length, 32, 'correct length';
260 is $res->content_charset, 'UTF-8';
264 my $res = request "/base/♥";
266 is $res->code, 200, 'OK';
267 is decode_utf8($res->content), '<p>This is base-link action ♥</p>', 'correct body';
268 is $res->content_length, 35, 'correct length';
269 is $res->content_charset, 'UTF-8';
273 my ($res, $c) = ctx_request POST "/base/♥?♥=♥&♥=♥♥", [a=>1, b=>'', '♥'=>'♥', '♥'=>'♥♥'];
275 is $res->code, 200, 'OK';
276 is decode_utf8($res->content), '<p>This is base-link action ♥</p>', 'correct body';
277 is $res->content_length, 35, 'correct length';
278 is $c->req->parameters->{'♥'}[0], '♥';
279 is $c->req->query_parameters->{'♥'}[0], '♥';
280 is $c->req->body_parameters->{'♥'}[0], '♥';
281 is $c->req->parameters->{'♥'}[0], '♥';
282 is $c->req->parameters->{a}, 1;
283 is $c->req->body_parameters->{a}, 1;
284 is $res->content_charset, 'UTF-8';
288 my ($res, $c) = ctx_request GET "/base/♥?♥♥♥";
290 is $res->code, 200, 'OK';
291 is decode_utf8($res->content), '<p>This is base-link action ♥</p>', 'correct body';
292 is $res->content_length, 35, 'correct length';
293 is $c->req->query_keywords, '♥♥♥';
294 is $res->content_charset, 'UTF-8';
298 my $res = request "/base/♥/♥";
300 is $res->code, 200, 'OK';
301 is decode_utf8($res->content), '<p>This is base-link action ♥ ♥</p>', 'correct body';
302 is $res->content_length, 39, 'correct length';
303 is $res->content_charset, 'UTF-8';
307 my $res = request "/base/♥/♥/♥/♥";
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, $c) = ctx_request POST "/base/♥/♥/♥/♥?♥=♥♥", [a=>1, b=>'2', '♥'=>'♥♥'];
317 ## Make sure that the urls we generate work the same
318 my $uri_for1 = $c->uri_for($c->controller('Root')->action_for('argend'), ['♥'], '♥', {'♥'=>'♥♥'});
319 my $uri_for2 = $c->uri_for($c->controller('Root')->action_for('argend'), ['♥', '♥'], {'♥'=>'♥♥'});
320 my $uri = $c->req->uri;
322 is "$uri_for1", "$uri_for2";
323 is "$uri", "$uri_for1";
326 my ($res, $c) = ctx_request POST "$uri_for1", [a=>1, b=>'2', '♥'=>'♥♥'];
327 is $c->req->query_parameters->{'♥'}, '♥♥';
328 is $c->req->body_parameters->{'♥'}, '♥♥';
329 is $c->req->parameters->{'♥'}[0], '♥♥'; #combined with query and body
330 is $c->req->args->[0], '♥';
331 is length($c->req->parameters->{'♥'}[0]), 2;
332 is length($c->req->query_parameters->{'♥'}), 2;
333 is length($c->req->body_parameters->{'♥'}), 2;
334 is length($c->req->args->[0]), 1;
335 is $res->content_charset, 'UTF-8';
340 my ($res, $c) = ctx_request "/root/uri_for";
341 my $url = $c->uri_for($c->controller('Root')->action_for('argend'), ['♥'], '♥#X♥X', {'♥'=>'♥♥'});
343 is $res->code, 200, 'OK';
344 is decode_utf8($res->content), "$url", 'correct body'; #should do nothing
345 is $res->content, "$url", 'correct body';
346 is $res->content_length, 104, 'correct length';
347 is $res->content_charset, 'UTF-8';
350 my $url = $c->uri_for($c->controller->action_for('heart_with_arg'), '♥');
351 is "$url", 'http://localhost/root/a%E2%99%A5/%E2%99%A5', "correct $url";
355 my $url = $c->uri_for($c->controller->action_for('heart_with_arg'), ['♥']);
356 is "$url", 'http://localhost/root/a%E2%99%A5/%E2%99%A5', "correct $url";
361 my $res = request "/root/stream_write";
363 is $res->code, 200, 'OK GET /root/stream_write';
364 is decode_utf8($res->content), '<p>This is stream_write action ♥</p>', 'correct body';
365 is $res->content_charset, 'UTF-8';
369 my $res = request "/root/stream_body_fh";
371 is $res->code, 200, 'OK';
372 is decode_utf8($res->content), "<p>This is stream_body_fh action ♥</p>\n", 'correct body';
373 is $res->content_charset, 'UTF-8';
374 # Not sure why there is a trailing newline above... its not in catalyst code I can see. Not sure
375 # if is a problem or just an artifact of the why the test stuff works - JNAP
379 my $res = request "/root/stream_write_fh";
381 is $res->code, 200, 'OK';
382 is decode_utf8($res->content), '<p>This is stream_write_fh action ♥</p>', 'correct body';
383 #is $res->content_length, 41, 'correct length';
384 is $res->content_charset, 'UTF-8';
388 my $res = request "/root/stream_body_fh2";
390 is $res->code, 200, 'OK';
391 is decode_utf8($res->content), "<p>This is stream_body_fh action ♥</p>\n", 'correct body';
392 is $res->content_length, 41, 'correct length';
393 is $res->content_charset, 'UTF-8';
397 my $res = request "/root/write_then_body";
399 is $res->code, 200, 'OK';
400 is decode_utf8($res->content), "<p>This is early_write action ♥</p><p>This is body_write action ♥</p>";
401 is $res->content_charset, 'UTF-8';
405 ok my $path = File::Spec->catfile('t', 'utf8.txt');
406 ok my $req = POST '/root/file_upload',
407 Content_Type => 'form-data',
408 Content => [encode_utf8('♥')=>encode_utf8('♥♥'), file=>["$path", encode_utf8('♥ttachment.txt'), 'Content-Type' =>'text/html; charset=UTF-8', ]];
410 ok my $res = request $req;
411 is decode_utf8($res->content), "<p>This is stream_body_fh action ♥</p>\n";
415 ok my $path = File::Spec->catfile('t', 'utf8.txt');
416 ok my $req = POST '/root/file_upload_utf8_param',
417 Content_Type => 'form-data',
418 Content => [encode_utf8('♥')=>encode_utf8('♥♥'), encode_utf8('♥')=>["$path", encode_utf8('♥ttachment.txt'), 'Content-Type' =>'text/html; charset=UTF-8', ]];
420 ok my $res = request $req;
421 is decode_utf8($res->content), "<p>This is stream_body_fh action ♥</p>\n";
425 ok my $req = POST '/root/json',
426 Content_Type => 'application/json',
427 Content => encode_json +{'♥'=>'♥♥'}; # Note: JSON does the UTF* encoding for us
429 ok my $res = request $req;
431 ## decode_json expect the binary utf8 string and does the decoded bit for us.
432 is_deeply decode_json(($res->content)), +{'♥'=>'♥♥'}, 'JSON was decoded correctly';
436 ok my $res = request "/root/override_encoding";
437 ok my $enc = Encode::find_encoding('SHIFT_JIS');
439 is $res->code, 200, 'OK';
440 is $enc->decode($res->content), "テスト", 'correct body';
441 is $res->content_length, 6, 'correct length'; # Bytes over the wire
442 is length($enc->decode($res->content)), 3;
443 is $res->content_charset, 'SHIFT_JIS', 'content charset is SHIFT_JIS as expected';
447 my $res = request "/root/manual_1";
449 is $res->code, 200, 'OK';
450 is decode_utf8($res->content), "manual_1 ♥", 'correct body';
451 is $res->content_length, 12, 'correct length';
452 is $res->content_charset, 'UTF-8';
456 eval { require Compress::Zlib; 1} || do {
457 skip "Compress::Zlib needed to test gzip encoding", 5 };
459 my $res = request "/root/gzipped";
460 ok my $raw_content = $res->content;
461 ok my $content = Compress::Zlib::memGunzip($raw_content), 'no gunzip error';
463 is $res->code, 200, 'OK';
464 is decode_utf8($content), "manual_1 ♥", 'correct body';
465 is $res->content_charset, 'UTF-8', 'zlib charset is set correctly';
469 my $res = request "/root/stream_write_error";
471 is $res->code, 200, 'OK';
472 like decode_utf8($res->content), qr[<p>This is stream_write action ♥</p><!DOCTYPE html], 'correct body';
476 my $res = request "/root/from_external_psgi";
478 is $res->code, 200, 'OK';
479 is decode_utf8($res->content), '<p>This is path-heart action ♥</p>', 'correct body';
480 is $res->content_length, 36, 'correct length';
481 is $res->content_charset, 'UTF-8', 'external PSGI app has expected charset';
486 my $shiftjs = 'test テスト';
488 ok my $req = POST '/root/echo_arg',
489 Content_Type => 'form-data',
491 arg0 => 'helloworld',
492 Encode::encode('UTF-8','♥') => Encode::encode('UTF-8','♥♥'), # Long form POST simple does not auto encode...
493 Encode::encode('UTF-8','♥♥♥') => [
495 'Content-Type' =>'text/plain; charset=SHIFT_JIS',
496 'Content' => Encode::encode('SHIFT_JIS', $shiftjs)],
499 'Content-Type' =>'text/plain; charset=UTF-8',
500 'Content' => Encode::encode('UTF-8', $utf8)],
503 'Content-Type' =>'text/plain; charset=SHIFT_JIS',
504 'Content' => Encode::encode('SHIFT_JIS', $shiftjs)],
507 'Content-Type' =>'text/plain; charset=SHIFT_JIS',
508 'Content' => Encode::encode('SHIFT_JIS', $shiftjs)],
511 my ($res, $c) = ctx_request $req;
513 is $c->req->body_parameters->{'arg0'}, 'helloworld', 'got helloworld value';
514 is $c->req->body_parameters->{'♥'}, '♥♥';
515 is $c->req->body_parameters->{'arg1'}, $utf8, 'decoded utf8 param';
516 is $c->req->body_parameters->{'arg2'}[0], $shiftjs, 'decoded shiftjs param';
517 is $c->req->body_parameters->{'arg2'}[1], $shiftjs, 'decoded shiftjs param';
518 is $c->req->body_parameters->{'♥♥♥'}, $shiftjs, 'decoded shiftjs param';
523 my $shiftjs = 'test テスト';
524 my $encoded = Encode::encode('UTF-8', $shiftjs);
526 ok my $req = GET "/root/echo_arg?a=$encoded";
527 my ($res, $c) = ctx_request $req;
529 is $c->req->query_parameters->{'a'}, $shiftjs, 'got expected value';
532 ## should we use binmode on filehandles to force the encoding...?
533 ## Not sure what else to do with multipart here, if docs are enough...