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 file_upload :POST Consumes(Multipart) Local {
116 Test::More::is $c->req->body_parameters->{'♥'}, '♥♥';
117 Test::More::ok my $upload = $c->req->uploads->{file};
118 Test::More::is $upload->charset, 'UTF-8';
120 my $text = $upload->slurp;
121 Test::More::is Encode::decode_utf8($text), "<p>This is stream_body_fh action ♥</p>\n";
123 my $decoded_text = $upload->decoded_slurp;
124 Test::More::is $decoded_text, "<p>This is stream_body_fh action ♥</p>\n";
126 Test::More::is $upload->filename, '♥ttachment.txt';
127 Test::More::is $upload->raw_basename, '♥ttachment.txt';
129 $c->response->content_type('text/html');
130 $c->response->body($decoded_text);
133 sub json :POST Consumes(JSON) Local {
135 my $post = $c->req->body_data;
137 Test::More::is $post->{'♥'}, '♥♥';
138 Test::More::is length($post->{'♥'}), 2;
139 $c->response->content_type('application/json');
141 # Encode JSON also encodes to a UTF-8 encoded, binary string. This is why we don't
142 # have application/json as one of the things we match, otherwise we get double
144 $c->response->body(JSON::MaybeXS::encode_json($post));
147 ## If someone clears encoding, they can do as they wish
148 sub manual_1 :Local {
151 $c->res->content_type('text/plain');
152 $c->res->content_type_charset('UTF-8');
153 $c->response->body( Encode::encode_utf8("manual_1 ♥"));
156 ## If you do like gzip, well handle that yourself! Basically if you do some sort
157 ## of content encoding like gzip, you must do on top of the encoding. We will fix
158 ## the encoding plugins (Catalyst::Plugin::Compress) to do this properly for you.
161 require Compress::Zlib;
163 $c->res->content_type('text/plain');
164 $c->res->content_type_charset('UTF-8');
165 $c->res->content_encoding('gzip');
166 $c->response->body(Compress::Zlib::memGzip(Encode::encode_utf8("manual_1 ♥")));
169 sub override_encoding :Local {
171 $c->res->content_type('text/plain');
172 $c->encoding(Encode::find_encoding('UTF-8'));
173 $c->encoding(Encode::find_encoding('Shift_JIS'));
174 $c->response->body("テスト");
177 sub stream_write_error :Local {
179 $c->response->content_type('text/html');
180 $c->response->write("<p>This is stream_write action ♥</p>");
181 $c->encoding(Encode::find_encoding('Shift_JIS'));
182 $c->response->write("<p>This is stream_write action ♥</p>");
185 sub from_external_psgi :Local {
187 my $env = HTTP::Message::PSGI::req_to_psgi( HTTP::Request::Common::GET '/root/♥');
188 $c->res->from_psgi_response( ref($c)->to_app->($env));
191 sub echo_arg :Local {
193 $c->response->content_type('text/plain');
194 $c->response->body($c->req->body_parameters->{arg});
200 Test::More::ok(MyApp->setup, 'setup app');
203 ok my $psgi = MyApp->psgi_app, 'build psgi app';
205 use Catalyst::Test 'MyApp';
208 my $res = request "/root/♥";
210 is $res->code, 200, 'OK';
211 is decode_utf8($res->content), '<p>This is path-heart action ♥</p>', 'correct body';
212 is $res->content_length, 36, 'correct length';
213 is $res->content_charset, 'UTF-8';
217 my $res = request "/root/a♥/♥";
219 is $res->code, 200, 'OK';
220 is decode_utf8($res->content), '<p>This is path-heart-arg action ♥</p>', 'correct body';
221 is $res->content_length, 40, 'correct length';
222 is $res->content_charset, 'UTF-8';
226 my $res = request "/root/^";
228 is $res->code, 200, 'OK';
229 is decode_utf8($res->content), '<p>This is path-hat action ^</p>', 'correct body';
230 is $res->content_length, 32, 'correct length';
231 is $res->content_charset, 'UTF-8';
235 my $res = request "/base/♥";
237 is $res->code, 200, 'OK';
238 is decode_utf8($res->content), '<p>This is base-link action ♥</p>', 'correct body';
239 is $res->content_length, 35, 'correct length';
240 is $res->content_charset, 'UTF-8';
244 my ($res, $c) = ctx_request POST "/base/♥?♥=♥&♥=♥♥", [a=>1, b=>'', '♥'=>'♥', '♥'=>'♥♥'];
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 $c->req->parameters->{'♥'}[0], '♥';
250 is $c->req->query_parameters->{'♥'}[0], '♥';
251 is $c->req->body_parameters->{'♥'}[0], '♥';
252 is $c->req->parameters->{'♥'}[0], '♥';
253 is $c->req->parameters->{a}, 1;
254 is $c->req->body_parameters->{a}, 1;
255 is $res->content_charset, 'UTF-8';
259 my ($res, $c) = ctx_request GET "/base/♥?♥♥♥";
261 is $res->code, 200, 'OK';
262 is decode_utf8($res->content), '<p>This is base-link action ♥</p>', 'correct body';
263 is $res->content_length, 35, 'correct length';
264 is $c->req->query_keywords, '♥♥♥';
265 is $res->content_charset, 'UTF-8';
269 my $res = request "/base/♥/♥";
271 is $res->code, 200, 'OK';
272 is decode_utf8($res->content), '<p>This is base-link action ♥ ♥</p>', 'correct body';
273 is $res->content_length, 39, 'correct length';
274 is $res->content_charset, 'UTF-8';
278 my $res = request "/base/♥/♥/♥/♥";
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, $c) = ctx_request POST "/base/♥/♥/♥/♥?♥=♥♥", [a=>1, b=>'2', '♥'=>'♥♥'];
288 ## Make sure that the urls we generate work the same
289 my $uri_for1 = $c->uri_for($c->controller('Root')->action_for('argend'), ['♥'], '♥', {'♥'=>'♥♥'});
290 my $uri_for2 = $c->uri_for($c->controller('Root')->action_for('argend'), ['♥', '♥'], {'♥'=>'♥♥'});
291 my $uri = $c->req->uri;
293 is "$uri_for1", "$uri_for2";
294 is "$uri", "$uri_for1";
297 my ($res, $c) = ctx_request POST "$uri_for1", [a=>1, b=>'2', '♥'=>'♥♥'];
298 is $c->req->query_parameters->{'♥'}, '♥♥';
299 is $c->req->body_parameters->{'♥'}, '♥♥';
300 is $c->req->parameters->{'♥'}[0], '♥♥'; #combined with query and body
301 is $c->req->args->[0], '♥';
302 is length($c->req->parameters->{'♥'}[0]), 2;
303 is length($c->req->query_parameters->{'♥'}), 2;
304 is length($c->req->body_parameters->{'♥'}), 2;
305 is length($c->req->args->[0]), 1;
306 is $res->content_charset, 'UTF-8';
311 my ($res, $c) = ctx_request "/root/uri_for";
312 my $url = $c->uri_for($c->controller('Root')->action_for('argend'), ['♥'], '♥', {'♥'=>'♥♥'});
314 is $res->code, 200, 'OK';
315 is decode_utf8($res->content), "$url", 'correct body'; #should do nothing
316 is $res->content, "$url", 'correct body';
317 is $res->content_length, 90, 'correct length';
318 is $res->content_charset, 'UTF-8';
321 my $url = $c->uri_for($c->controller->action_for('heart_with_arg'), '♥');
322 is "$url", 'http://localhost/root/a%E2%99%A5/%E2%99%A5', "correct $url";
326 my $url = $c->uri_for($c->controller->action_for('heart_with_arg'), ['♥']);
327 is "$url", 'http://localhost/root/a%E2%99%A5/%E2%99%A5', "correct $url";
332 my $res = request "/root/stream_write";
334 is $res->code, 200, 'OK GET /root/stream_write';
335 is decode_utf8($res->content), '<p>This is stream_write action ♥</p>', 'correct body';
336 is $res->content_charset, 'UTF-8';
340 my $res = request "/root/stream_body_fh";
342 is $res->code, 200, 'OK';
343 is decode_utf8($res->content), "<p>This is stream_body_fh action ♥</p>\n", 'correct body';
344 is $res->content_charset, 'UTF-8';
345 # Not sure why there is a trailing newline above... its not in catalyst code I can see. Not sure
346 # if is a problem or just an artifact of the why the test stuff works - JNAP
350 my $res = request "/root/stream_write_fh";
352 is $res->code, 200, 'OK';
353 is decode_utf8($res->content), '<p>This is stream_write_fh action ♥</p>', 'correct body';
354 #is $res->content_length, 41, 'correct length';
355 is $res->content_charset, 'UTF-8';
359 my $res = request "/root/stream_body_fh2";
361 is $res->code, 200, 'OK';
362 is decode_utf8($res->content), "<p>This is stream_body_fh action ♥</p>\n", 'correct body';
363 is $res->content_length, 41, 'correct length';
364 is $res->content_charset, 'UTF-8';
368 ok my $path = File::Spec->catfile('t', 'utf8.txt');
369 ok my $req = POST '/root/file_upload',
370 Content_Type => 'form-data',
371 Content => [encode_utf8('♥')=>encode_utf8('♥♥'), file=>["$path", encode_utf8('♥ttachment.txt'), 'Content-Type' =>'text/html; charset=UTF-8', ]];
373 ok my $res = request $req;
374 is decode_utf8($res->content), "<p>This is stream_body_fh action ♥</p>\n";
378 ok my $req = POST '/root/json',
379 Content_Type => 'application/json',
380 Content => encode_json +{'♥'=>'♥♥'}; # Note: JSON does the UTF* encoding for us
382 ok my $res = request $req;
384 ## decode_json expect the binary utf8 string and does the decoded bit for us.
385 is_deeply decode_json(($res->content)), +{'♥'=>'♥♥'}, 'JSON was decoded correctly';
389 ok my $res = request "/root/override_encoding";
390 ok my $enc = Encode::find_encoding('SHIFT_JIS');
392 is $res->code, 200, 'OK';
393 is $enc->decode($res->content), "テスト", 'correct body';
394 is $res->content_length, 6, 'correct length'; # Bytes over the wire
395 is length($enc->decode($res->content)), 3;
396 is $res->content_charset, 'SHIFT_JIS', 'content charset is SHIFT_JIS as expected';
400 my $res = request "/root/manual_1";
402 is $res->code, 200, 'OK';
403 is decode_utf8($res->content), "manual_1 ♥", 'correct body';
404 is $res->content_length, 12, 'correct length';
405 is $res->content_charset, 'UTF-8';
409 eval { require Compress::Zlib; 1} || do {
410 skip "Compress::Zlib needed to test gzip encoding", 5 };
412 my $res = request "/root/gzipped";
413 ok my $raw_content = $res->content;
414 ok my $content = Compress::Zlib::memGunzip($raw_content), 'no gunzip error';
416 is $res->code, 200, 'OK';
417 is decode_utf8($content), "manual_1 ♥", 'correct body';
418 is $res->content_charset, 'UTF-8', 'zlib charset is set correctly';
422 my $res = request "/root/stream_write_error";
424 is $res->code, 200, 'OK';
425 like decode_utf8($res->content), qr[<p>This is stream_write action ♥</p><!DOCTYPE html], 'correct body';
429 my $res = request "/root/from_external_psgi";
431 is $res->code, 200, 'OK';
432 is decode_utf8($res->content), '<p>This is path-heart action ♥</p>', 'correct body';
433 is $res->content_length, 36, 'correct length';
434 is $res->content_charset, 'UTF-8', 'external PSGI app has expected charset';
439 my $shiftjs = 'test テスト';
441 ok my $req = POST '/root/echo_arg',
442 Content_Type => 'form-data',
444 arg0 => 'helloworld',
445 Encode::encode('UTF-8','♥') => Encode::encode('UTF-8','♥♥'), # Long form POST simple does not auto encode...
446 Encode::encode('UTF-8','♥♥♥') => [
448 'Content-Type' =>'text/plain; charset=SHIFT_JIS',
449 'Content' => Encode::encode('SHIFT_JIS', $shiftjs)],
452 'Content-Type' =>'text/plain; charset=UTF-8',
453 'Content' => Encode::encode('UTF-8', $utf8)],
456 'Content-Type' =>'text/plain; charset=SHIFT_JIS',
457 'Content' => Encode::encode('SHIFT_JIS', $shiftjs)],
460 'Content-Type' =>'text/plain; charset=SHIFT_JIS',
461 'Content' => Encode::encode('SHIFT_JIS', $shiftjs)],
464 my ($res, $c) = ctx_request $req;
466 is $c->req->body_parameters->{'arg0'}, 'helloworld', 'got helloworld value';
467 is $c->req->body_parameters->{'♥'}, '♥♥';
469 ok Scalar::Util::blessed($c->req->body_parameters->{'arg1'});
470 ok Scalar::Util::blessed($c->req->body_parameters->{'arg2'}[0]);
471 ok Scalar::Util::blessed($c->req->body_parameters->{'arg2'}[1]);
472 ok Scalar::Util::blessed($c->req->body_parameters->{'♥♥♥'});
474 # Since the form post is COMPLEX you are expected to decode it yourself.
475 is Encode::decode('UTF-8', $c->req->body_parameters->{'arg1'}->raw_data), $utf8, 'decoded utf8 param';
476 is Encode::decode('SHIFT_JIS', $c->req->body_parameters->{'arg2'}[0]->raw_data), $shiftjs, 'decoded shiftjis param';
477 is Encode::decode('SHIFT_JIS', $c->req->body_parameters->{'arg2'}[1]->raw_data), $shiftjs, 'decoded shiftjis param';
478 is Encode::decode('SHIFT_JIS', $c->req->body_parameters->{'♥♥♥'}->raw_data), $shiftjs, 'decoded shiftjis param';
482 ## should we use binmode on filehandles to force the encoding...?
483 ## Not sure what else to do with multipart here, if docs are enough...