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'), ['♥'], '♥', {'♥'=>'♥♥'})}");
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/plain');
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 {
124 Test::More::is $c->req->body_parameters->{'♥'}, '♥♥';
125 Test::More::ok my $upload = $c->req->uploads->{file};
126 Test::More::is $upload->charset, 'UTF-8';
128 my $text = $upload->slurp;
129 Test::More::is Encode::decode_utf8($text), "<p>This is stream_body_fh action ♥</p>\n";
131 my $decoded_text = $upload->decoded_slurp;
132 Test::More::is $decoded_text, "<p>This is stream_body_fh action ♥</p>\n";
134 Test::More::is $upload->filename, '♥ttachment.txt';
135 Test::More::is $upload->raw_basename, '♥ttachment.txt';
137 $c->response->content_type('text/html');
138 $c->response->body($decoded_text);
141 sub json :POST Consumes(JSON) Local {
143 my $post = $c->req->body_data;
145 Test::More::is $post->{'♥'}, '♥♥';
146 Test::More::is length($post->{'♥'}), 2;
147 $c->response->content_type('application/json');
149 # Encode JSON also encodes to a UTF-8 encoded, binary string. This is why we don't
150 # have application/json as one of the things we match, otherwise we get double
152 $c->response->body(JSON::MaybeXS::encode_json($post));
155 ## If someone clears encoding, they can do as they wish
156 sub manual_1 :Local {
159 $c->res->content_type('text/plain');
160 $c->res->content_type_charset('UTF-8');
161 $c->response->body( Encode::encode_utf8("manual_1 ♥"));
164 ## If you do like gzip, well handle that yourself! Basically if you do some sort
165 ## of content encoding like gzip, you must do on top of the encoding. We will fix
166 ## the encoding plugins (Catalyst::Plugin::Compress) to do this properly for you.
169 require Compress::Zlib;
171 $c->res->content_type('text/plain');
172 $c->res->content_type_charset('UTF-8');
173 $c->res->content_encoding('gzip');
174 $c->response->body(Compress::Zlib::memGzip(Encode::encode_utf8("manual_1 ♥")));
177 sub override_encoding :Local {
179 $c->res->content_type('text/plain');
180 $c->encoding(Encode::find_encoding('UTF-8'));
181 $c->encoding(Encode::find_encoding('Shift_JIS'));
182 $c->response->body("テスト");
185 sub stream_write_error :Local {
187 $c->response->content_type('text/html');
188 $c->response->write("<p>This is stream_write action ♥</p>");
189 $c->encoding(Encode::find_encoding('Shift_JIS'));
190 $c->response->write("<p>This is stream_write action ♥</p>");
193 sub from_external_psgi :Local {
195 my $env = HTTP::Message::PSGI::req_to_psgi( HTTP::Request::Common::GET '/root/♥');
196 $c->res->from_psgi_response( ref($c)->to_app->($env));
199 sub echo_arg :Local {
201 $c->response->content_type('text/plain');
202 $c->response->body($c->req->body_parameters->{arg});
208 Test::More::ok(MyApp->setup, 'setup app');
211 ok my $psgi = MyApp->psgi_app, 'build psgi app';
213 use Catalyst::Test 'MyApp';
216 my $res = request "/root/♥";
218 is $res->code, 200, 'OK';
219 is decode_utf8($res->content), '<p>This is path-heart action ♥</p>', 'correct body';
220 is $res->content_length, 36, 'correct length';
221 is $res->content_charset, 'UTF-8';
225 my $res = request "/root/a♥/♥";
227 is $res->code, 200, 'OK';
228 is decode_utf8($res->content), '<p>This is path-heart-arg action ♥</p>', 'correct body';
229 is $res->content_length, 40, 'correct length';
230 is $res->content_charset, 'UTF-8';
234 my $res = request "/root/^";
236 is $res->code, 200, 'OK';
237 is decode_utf8($res->content), '<p>This is path-hat action ^</p>', 'correct body';
238 is $res->content_length, 32, 'correct length';
239 is $res->content_charset, 'UTF-8';
243 my $res = request "/base/♥";
245 is $res->code, 200, 'OK';
246 is decode_utf8($res->content), '<p>This is base-link action ♥</p>', 'correct body';
247 is $res->content_length, 35, 'correct length';
248 is $res->content_charset, 'UTF-8';
252 my ($res, $c) = ctx_request POST "/base/♥?♥=♥&♥=♥♥", [a=>1, b=>'', '♥'=>'♥', '♥'=>'♥♥'];
254 is $res->code, 200, 'OK';
255 is decode_utf8($res->content), '<p>This is base-link action ♥</p>', 'correct body';
256 is $res->content_length, 35, 'correct length';
257 is $c->req->parameters->{'♥'}[0], '♥';
258 is $c->req->query_parameters->{'♥'}[0], '♥';
259 is $c->req->body_parameters->{'♥'}[0], '♥';
260 is $c->req->parameters->{'♥'}[0], '♥';
261 is $c->req->parameters->{a}, 1;
262 is $c->req->body_parameters->{a}, 1;
263 is $res->content_charset, 'UTF-8';
267 my ($res, $c) = ctx_request GET "/base/♥?♥♥♥";
269 is $res->code, 200, 'OK';
270 is decode_utf8($res->content), '<p>This is base-link action ♥</p>', 'correct body';
271 is $res->content_length, 35, 'correct length';
272 is $c->req->query_keywords, '♥♥♥';
273 is $res->content_charset, 'UTF-8';
277 my $res = request "/base/♥/♥";
279 is $res->code, 200, 'OK';
280 is decode_utf8($res->content), '<p>This is base-link action ♥ ♥</p>', 'correct body';
281 is $res->content_length, 39, 'correct length';
282 is $res->content_charset, 'UTF-8';
286 my $res = request "/base/♥/♥/♥/♥";
288 is decode_utf8($res->content), '<p>This is base-link action ♥ ♥</p>', 'correct body';
289 is $res->content_length, 39, 'correct length';
290 is $res->content_charset, 'UTF-8';
294 my ($res, $c) = ctx_request POST "/base/♥/♥/♥/♥?♥=♥♥", [a=>1, b=>'2', '♥'=>'♥♥'];
296 ## Make sure that the urls we generate work the same
297 my $uri_for1 = $c->uri_for($c->controller('Root')->action_for('argend'), ['♥'], '♥', {'♥'=>'♥♥'});
298 my $uri_for2 = $c->uri_for($c->controller('Root')->action_for('argend'), ['♥', '♥'], {'♥'=>'♥♥'});
299 my $uri = $c->req->uri;
301 is "$uri_for1", "$uri_for2";
302 is "$uri", "$uri_for1";
305 my ($res, $c) = ctx_request POST "$uri_for1", [a=>1, b=>'2', '♥'=>'♥♥'];
306 is $c->req->query_parameters->{'♥'}, '♥♥';
307 is $c->req->body_parameters->{'♥'}, '♥♥';
308 is $c->req->parameters->{'♥'}[0], '♥♥'; #combined with query and body
309 is $c->req->args->[0], '♥';
310 is length($c->req->parameters->{'♥'}[0]), 2;
311 is length($c->req->query_parameters->{'♥'}), 2;
312 is length($c->req->body_parameters->{'♥'}), 2;
313 is length($c->req->args->[0]), 1;
314 is $res->content_charset, 'UTF-8';
319 my ($res, $c) = ctx_request "/root/uri_for";
320 my $url = $c->uri_for($c->controller('Root')->action_for('argend'), ['♥'], '♥', {'♥'=>'♥♥'});
322 is $res->code, 200, 'OK';
323 is decode_utf8($res->content), "$url", 'correct body'; #should do nothing
324 is $res->content, "$url", 'correct body';
325 is $res->content_length, 90, 'correct length';
326 is $res->content_charset, 'UTF-8';
329 my $url = $c->uri_for($c->controller->action_for('heart_with_arg'), '♥');
330 is "$url", 'http://localhost/root/a%E2%99%A5/%E2%99%A5', "correct $url";
334 my $url = $c->uri_for($c->controller->action_for('heart_with_arg'), ['♥']);
335 is "$url", 'http://localhost/root/a%E2%99%A5/%E2%99%A5', "correct $url";
340 my $res = request "/root/stream_write";
342 is $res->code, 200, 'OK GET /root/stream_write';
343 is decode_utf8($res->content), '<p>This is stream_write action ♥</p>', 'correct body';
344 is $res->content_charset, 'UTF-8';
348 my $res = request "/root/stream_body_fh";
350 is $res->code, 200, 'OK';
351 is decode_utf8($res->content), "<p>This is stream_body_fh action ♥</p>\n", 'correct body';
352 is $res->content_charset, 'UTF-8';
353 # Not sure why there is a trailing newline above... its not in catalyst code I can see. Not sure
354 # if is a problem or just an artifact of the why the test stuff works - JNAP
358 my $res = request "/root/stream_write_fh";
360 is $res->code, 200, 'OK';
361 is decode_utf8($res->content), '<p>This is stream_write_fh action ♥</p>', 'correct body';
362 #is $res->content_length, 41, 'correct length';
363 is $res->content_charset, 'UTF-8';
367 my $res = request "/root/stream_body_fh2";
369 is $res->code, 200, 'OK';
370 is decode_utf8($res->content), "<p>This is stream_body_fh action ♥</p>\n", 'correct body';
371 is $res->content_length, 41, 'correct length';
372 is $res->content_charset, 'UTF-8';
376 my $res = request "/root/write_then_body";
378 is $res->code, 200, 'OK';
379 is decode_utf8($res->content), "<p>This is early_write action ♥</p><p>This is body_write action ♥</p>";
380 is $res->content_charset, 'UTF-8';
384 ok my $path = File::Spec->catfile('t', 'utf8.txt');
385 ok my $req = POST '/root/file_upload',
386 Content_Type => 'form-data',
387 Content => [encode_utf8('♥')=>encode_utf8('♥♥'), file=>["$path", encode_utf8('♥ttachment.txt'), 'Content-Type' =>'text/html; charset=UTF-8', ]];
389 ok my $res = request $req;
390 is decode_utf8($res->content), "<p>This is stream_body_fh action ♥</p>\n";
394 ok my $req = POST '/root/json',
395 Content_Type => 'application/json',
396 Content => encode_json +{'♥'=>'♥♥'}; # Note: JSON does the UTF* encoding for us
398 ok my $res = request $req;
400 ## decode_json expect the binary utf8 string and does the decoded bit for us.
401 is_deeply decode_json(($res->content)), +{'♥'=>'♥♥'}, 'JSON was decoded correctly';
405 ok my $res = request "/root/override_encoding";
406 ok my $enc = Encode::find_encoding('SHIFT_JIS');
408 is $res->code, 200, 'OK';
409 is $enc->decode($res->content), "テスト", 'correct body';
410 is $res->content_length, 6, 'correct length'; # Bytes over the wire
411 is length($enc->decode($res->content)), 3;
412 is $res->content_charset, 'SHIFT_JIS', 'content charset is SHIFT_JIS as expected';
416 my $res = request "/root/manual_1";
418 is $res->code, 200, 'OK';
419 is decode_utf8($res->content), "manual_1 ♥", 'correct body';
420 is $res->content_length, 12, 'correct length';
421 is $res->content_charset, 'UTF-8';
425 eval { require Compress::Zlib; 1} || do {
426 skip "Compress::Zlib needed to test gzip encoding", 5 };
428 my $res = request "/root/gzipped";
429 ok my $raw_content = $res->content;
430 ok my $content = Compress::Zlib::memGunzip($raw_content), 'no gunzip error';
432 is $res->code, 200, 'OK';
433 is decode_utf8($content), "manual_1 ♥", 'correct body';
434 is $res->content_charset, 'UTF-8', 'zlib charset is set correctly';
438 my $res = request "/root/stream_write_error";
440 is $res->code, 200, 'OK';
441 like decode_utf8($res->content), qr[<p>This is stream_write action ♥</p><!DOCTYPE html], 'correct body';
445 my $res = request "/root/from_external_psgi";
447 is $res->code, 200, 'OK';
448 is decode_utf8($res->content), '<p>This is path-heart action ♥</p>', 'correct body';
449 is $res->content_length, 36, 'correct length';
450 is $res->content_charset, 'UTF-8', 'external PSGI app has expected charset';
455 my $shiftjs = 'test テスト';
457 ok my $req = POST '/root/echo_arg',
458 Content_Type => 'form-data',
460 arg0 => 'helloworld',
461 Encode::encode('UTF-8','♥') => Encode::encode('UTF-8','♥♥'), # Long form POST simple does not auto encode...
462 Encode::encode('UTF-8','♥♥♥') => [
464 'Content-Type' =>'text/plain; charset=SHIFT_JIS',
465 'Content' => Encode::encode('SHIFT_JIS', $shiftjs)],
468 'Content-Type' =>'text/plain; charset=UTF-8',
469 'Content' => Encode::encode('UTF-8', $utf8)],
472 'Content-Type' =>'text/plain; charset=SHIFT_JIS',
473 'Content' => Encode::encode('SHIFT_JIS', $shiftjs)],
476 'Content-Type' =>'text/plain; charset=SHIFT_JIS',
477 'Content' => Encode::encode('SHIFT_JIS', $shiftjs)],
480 my ($res, $c) = ctx_request $req;
482 is $c->req->body_parameters->{'arg0'}, 'helloworld', 'got helloworld value';
483 is $c->req->body_parameters->{'♥'}, '♥♥';
485 ok Scalar::Util::blessed($c->req->body_parameters->{'arg1'});
486 ok Scalar::Util::blessed($c->req->body_parameters->{'arg2'}[0]);
487 ok Scalar::Util::blessed($c->req->body_parameters->{'arg2'}[1]);
488 ok Scalar::Util::blessed($c->req->body_parameters->{'♥♥♥'});
490 # Since the form post is COMPLEX you are expected to decode it yourself.
491 is Encode::decode('UTF-8', $c->req->body_parameters->{'arg1'}->raw_data), $utf8, 'decoded utf8 param';
492 is Encode::decode('SHIFT_JIS', $c->req->body_parameters->{'arg2'}[0]->raw_data), $shiftjs, 'decoded shiftjis param';
493 is Encode::decode('SHIFT_JIS', $c->req->body_parameters->{'arg2'}[1]->raw_data), $shiftjs, 'decoded shiftjis param';
494 is Encode::decode('SHIFT_JIS', $c->req->body_parameters->{'♥♥♥'}->raw_data), $shiftjs, 'decoded shiftjis param';
499 my $shiftjs = 'test テスト';
500 my $encoded = Encode::encode('UTF-8', $shiftjs);
502 ok my $req = GET "/root/echo_arg?a=$encoded";
503 my ($res, $c) = ctx_request $req;
505 is $c->req->query_parameters->{'a'}, $shiftjs, 'got expected value';
508 ## should we use binmode on filehandles to force the encoding...?
509 ## Not sure what else to do with multipart here, if docs are enough...