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/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 json :POST Consumes(JSON) Local {
144 my $post = $c->req->body_data;
146 Test::More::is $post->{'♥'}, '♥♥';
147 Test::More::is length($post->{'♥'}), 2;
148 $c->response->content_type('application/json');
150 # Encode JSON also encodes to a UTF-8 encoded, binary string. This is why we don't
151 # have application/json as one of the things we match, otherwise we get double
153 $c->response->body(JSON::MaybeXS::encode_json($post));
156 ## If someone clears encoding, they can do as they wish
157 sub manual_1 :Local {
160 $c->res->content_type('text/plain');
161 $c->res->content_type_charset('UTF-8');
162 $c->response->body( Encode::encode_utf8("manual_1 ♥"));
165 ## If you do like gzip, well handle that yourself! Basically if you do some sort
166 ## of content encoding like gzip, you must do on top of the encoding. We will fix
167 ## the encoding plugins (Catalyst::Plugin::Compress) to do this properly for you.
170 require Compress::Zlib;
172 $c->res->content_type('text/plain');
173 $c->res->content_type_charset('UTF-8');
174 $c->res->content_encoding('gzip');
175 $c->response->body(Compress::Zlib::memGzip(Encode::encode_utf8("manual_1 ♥")));
178 sub override_encoding :Local {
180 $c->res->content_type('text/plain');
181 $c->encoding(Encode::find_encoding('UTF-8'));
182 $c->encoding(Encode::find_encoding('Shift_JIS'));
183 $c->response->body("テスト");
186 sub stream_write_error :Local {
188 $c->response->content_type('text/html');
189 $c->response->write("<p>This is stream_write action ♥</p>");
190 $c->encoding(Encode::find_encoding('Shift_JIS'));
191 $c->response->write("<p>This is stream_write action ♥</p>");
194 sub from_external_psgi :Local {
196 my $env = HTTP::Message::PSGI::req_to_psgi( HTTP::Request::Common::GET '/root/♥');
197 $c->res->from_psgi_response( ref($c)->to_app->($env));
200 sub echo_arg :Local {
202 $c->response->content_type('text/plain');
203 $c->response->body($c->req->body_parameters->{arg});
209 Test::More::ok(MyApp->setup, 'setup app');
212 ok my $psgi = MyApp->psgi_app, 'build psgi app';
214 use Catalyst::Test 'MyApp';
217 my $res = request "/root/♥";
219 is $res->code, 200, 'OK';
220 is decode_utf8($res->content), '<p>This is path-heart action ♥</p>', 'correct body';
221 is $res->content_length, 36, 'correct length';
222 is $res->content_charset, 'UTF-8';
226 my $res = request "/root/a♥/♥";
228 is $res->code, 200, 'OK';
229 is decode_utf8($res->content), '<p>This is path-heart-arg action ♥</p>', 'correct body';
230 is $res->content_length, 40, 'correct length';
231 is $res->content_charset, 'UTF-8';
235 my $res = request "/root/^";
237 is $res->code, 200, 'OK';
238 is decode_utf8($res->content), '<p>This is path-hat action ^</p>', 'correct body';
239 is $res->content_length, 32, 'correct length';
240 is $res->content_charset, 'UTF-8';
244 my $res = request "/base/♥";
246 is $res->code, 200, 'OK';
247 is decode_utf8($res->content), '<p>This is base-link action ♥</p>', 'correct body';
248 is $res->content_length, 35, 'correct length';
249 is $res->content_charset, 'UTF-8';
253 my ($res, $c) = ctx_request POST "/base/♥?♥=♥&♥=♥♥", [a=>1, b=>'', '♥'=>'♥', '♥'=>'♥♥'];
255 is $res->code, 200, 'OK';
256 is decode_utf8($res->content), '<p>This is base-link action ♥</p>', 'correct body';
257 is $res->content_length, 35, 'correct length';
258 is $c->req->parameters->{'♥'}[0], '♥';
259 is $c->req->query_parameters->{'♥'}[0], '♥';
260 is $c->req->body_parameters->{'♥'}[0], '♥';
261 is $c->req->parameters->{'♥'}[0], '♥';
262 is $c->req->parameters->{a}, 1;
263 is $c->req->body_parameters->{a}, 1;
264 is $res->content_charset, 'UTF-8';
268 my ($res, $c) = ctx_request GET "/base/♥?♥♥♥";
270 is $res->code, 200, 'OK';
271 is decode_utf8($res->content), '<p>This is base-link action ♥</p>', 'correct body';
272 is $res->content_length, 35, 'correct length';
273 is $c->req->query_keywords, '♥♥♥';
274 is $res->content_charset, 'UTF-8';
278 my $res = request "/base/♥/♥";
280 is $res->code, 200, 'OK';
281 is decode_utf8($res->content), '<p>This is base-link action ♥ ♥</p>', 'correct body';
282 is $res->content_length, 39, 'correct length';
283 is $res->content_charset, 'UTF-8';
287 my $res = request "/base/♥/♥/♥/♥";
289 is decode_utf8($res->content), '<p>This is base-link action ♥ ♥</p>', 'correct body';
290 is $res->content_length, 39, 'correct length';
291 is $res->content_charset, 'UTF-8';
295 my ($res, $c) = ctx_request POST "/base/♥/♥/♥/♥?♥=♥♥", [a=>1, b=>'2', '♥'=>'♥♥'];
297 ## Make sure that the urls we generate work the same
298 my $uri_for1 = $c->uri_for($c->controller('Root')->action_for('argend'), ['♥'], '♥', {'♥'=>'♥♥'});
299 my $uri_for2 = $c->uri_for($c->controller('Root')->action_for('argend'), ['♥', '♥'], {'♥'=>'♥♥'});
300 my $uri = $c->req->uri;
302 is "$uri_for1", "$uri_for2";
303 is "$uri", "$uri_for1";
306 my ($res, $c) = ctx_request POST "$uri_for1", [a=>1, b=>'2', '♥'=>'♥♥'];
307 is $c->req->query_parameters->{'♥'}, '♥♥';
308 is $c->req->body_parameters->{'♥'}, '♥♥';
309 is $c->req->parameters->{'♥'}[0], '♥♥'; #combined with query and body
310 is $c->req->args->[0], '♥';
311 is length($c->req->parameters->{'♥'}[0]), 2;
312 is length($c->req->query_parameters->{'♥'}), 2;
313 is length($c->req->body_parameters->{'♥'}), 2;
314 is length($c->req->args->[0]), 1;
315 is $res->content_charset, 'UTF-8';
320 my ($res, $c) = ctx_request "/root/uri_for";
321 my $url = $c->uri_for($c->controller('Root')->action_for('argend'), ['♥'], '♥', {'♥'=>'♥♥'});
323 is $res->code, 200, 'OK';
324 is decode_utf8($res->content), "$url", 'correct body'; #should do nothing
325 is $res->content, "$url", 'correct body';
326 is $res->content_length, 90, 'correct length';
327 is $res->content_charset, 'UTF-8';
330 my $url = $c->uri_for($c->controller->action_for('heart_with_arg'), '♥');
331 is "$url", 'http://localhost/root/a%E2%99%A5/%E2%99%A5', "correct $url";
335 my $url = $c->uri_for($c->controller->action_for('heart_with_arg'), ['♥']);
336 is "$url", 'http://localhost/root/a%E2%99%A5/%E2%99%A5', "correct $url";
341 my $res = request "/root/stream_write";
343 is $res->code, 200, 'OK GET /root/stream_write';
344 is decode_utf8($res->content), '<p>This is stream_write action ♥</p>', 'correct body';
345 is $res->content_charset, 'UTF-8';
349 my $res = request "/root/stream_body_fh";
351 is $res->code, 200, 'OK';
352 is decode_utf8($res->content), "<p>This is stream_body_fh action ♥</p>\n", 'correct body';
353 is $res->content_charset, 'UTF-8';
354 # Not sure why there is a trailing newline above... its not in catalyst code I can see. Not sure
355 # if is a problem or just an artifact of the why the test stuff works - JNAP
359 my $res = request "/root/stream_write_fh";
361 is $res->code, 200, 'OK';
362 is decode_utf8($res->content), '<p>This is stream_write_fh action ♥</p>', 'correct body';
363 #is $res->content_length, 41, 'correct length';
364 is $res->content_charset, 'UTF-8';
368 my $res = request "/root/stream_body_fh2";
370 is $res->code, 200, 'OK';
371 is decode_utf8($res->content), "<p>This is stream_body_fh action ♥</p>\n", 'correct body';
372 is $res->content_length, 41, 'correct length';
373 is $res->content_charset, 'UTF-8';
377 my $res = request "/root/write_then_body";
379 is $res->code, 200, 'OK';
380 is decode_utf8($res->content), "<p>This is early_write action ♥</p><p>This is body_write action ♥</p>";
381 is $res->content_charset, 'UTF-8';
385 ok my $path = File::Spec->catfile('t', 'utf8.txt');
386 ok my $req = POST '/root/file_upload',
387 Content_Type => 'form-data',
388 Content => [encode_utf8('♥')=>encode_utf8('♥♥'), file=>["$path", encode_utf8('♥ttachment.txt'), 'Content-Type' =>'text/html; charset=UTF-8', ]];
390 ok my $res = request $req;
391 is decode_utf8($res->content), "<p>This is stream_body_fh action ♥</p>\n";
395 ok my $req = POST '/root/json',
396 Content_Type => 'application/json',
397 Content => encode_json +{'♥'=>'♥♥'}; # Note: JSON does the UTF* encoding for us
399 ok my $res = request $req;
401 ## decode_json expect the binary utf8 string and does the decoded bit for us.
402 is_deeply decode_json(($res->content)), +{'♥'=>'♥♥'}, 'JSON was decoded correctly';
406 ok my $res = request "/root/override_encoding";
407 ok my $enc = Encode::find_encoding('SHIFT_JIS');
409 is $res->code, 200, 'OK';
410 is $enc->decode($res->content), "テスト", 'correct body';
411 is $res->content_length, 6, 'correct length'; # Bytes over the wire
412 is length($enc->decode($res->content)), 3;
413 is $res->content_charset, 'SHIFT_JIS', 'content charset is SHIFT_JIS as expected';
417 my $res = request "/root/manual_1";
419 is $res->code, 200, 'OK';
420 is decode_utf8($res->content), "manual_1 ♥", 'correct body';
421 is $res->content_length, 12, 'correct length';
422 is $res->content_charset, 'UTF-8';
426 eval { require Compress::Zlib; 1} || do {
427 skip "Compress::Zlib needed to test gzip encoding", 5 };
429 my $res = request "/root/gzipped";
430 ok my $raw_content = $res->content;
431 ok my $content = Compress::Zlib::memGunzip($raw_content), 'no gunzip error';
433 is $res->code, 200, 'OK';
434 is decode_utf8($content), "manual_1 ♥", 'correct body';
435 is $res->content_charset, 'UTF-8', 'zlib charset is set correctly';
439 my $res = request "/root/stream_write_error";
441 is $res->code, 200, 'OK';
442 like decode_utf8($res->content), qr[<p>This is stream_write action ♥</p><!DOCTYPE html], 'correct body';
446 my $res = request "/root/from_external_psgi";
448 is $res->code, 200, 'OK';
449 is decode_utf8($res->content), '<p>This is path-heart action ♥</p>', 'correct body';
450 is $res->content_length, 36, 'correct length';
451 is $res->content_charset, 'UTF-8', 'external PSGI app has expected charset';
456 my $shiftjs = 'test テスト';
458 ok my $req = POST '/root/echo_arg',
459 Content_Type => 'form-data',
461 arg0 => 'helloworld',
462 Encode::encode('UTF-8','♥') => Encode::encode('UTF-8','♥♥'), # Long form POST simple does not auto encode...
463 Encode::encode('UTF-8','♥♥♥') => [
465 'Content-Type' =>'text/plain; charset=SHIFT_JIS',
466 'Content' => Encode::encode('SHIFT_JIS', $shiftjs)],
469 'Content-Type' =>'text/plain; charset=UTF-8',
470 'Content' => Encode::encode('UTF-8', $utf8)],
473 'Content-Type' =>'text/plain; charset=SHIFT_JIS',
474 'Content' => Encode::encode('SHIFT_JIS', $shiftjs)],
477 'Content-Type' =>'text/plain; charset=SHIFT_JIS',
478 'Content' => Encode::encode('SHIFT_JIS', $shiftjs)],
481 my ($res, $c) = ctx_request $req;
483 is $c->req->body_parameters->{'arg0'}, 'helloworld', 'got helloworld value';
484 is $c->req->body_parameters->{'♥'}, '♥♥';
485 is $c->req->body_parameters->{'arg1'}, $utf8, 'decoded utf8 param';
486 is $c->req->body_parameters->{'arg2'}[0], $shiftjs, 'decoded shiftjs param';
487 is $c->req->body_parameters->{'arg2'}[1], $shiftjs, 'decoded shiftjs param';
488 is $c->req->body_parameters->{'♥♥♥'}, $shiftjs, 'decoded shiftjs param';
493 my $shiftjs = 'test テスト';
494 my $encoded = Encode::encode('UTF-8', $shiftjs);
496 ok my $req = GET "/root/echo_arg?a=$encoded";
497 my ($res, $c) = ctx_request $req;
499 is $c->req->query_parameters->{'a'}, $shiftjs, 'got expected value';
502 ## should we use binmode on filehandles to force the encoding...?
503 ## Not sure what else to do with multipart here, if docs are enough...