Commit | Line | Data |
0ca510f0 |
1 | use utf8; |
2 | use warnings; |
3 | use strict; |
4 | use Test::More; |
b9d96e27 |
5 | use HTTP::Request::Common; |
d2000928 |
6 | use HTTP::Message::PSGI (); |
be634ffb |
7 | use Encode 2.21 'decode_utf8', 'encode_utf8', 'encode'; |
59e11cd7 |
8 | use File::Spec; |
12982f86 |
9 | use JSON::MaybeXS; |
0ca510f0 |
10 | |
11 | # Test cases for incoming utf8 |
12 | |
13 | { |
14 | package MyApp::Controller::Root; |
15 | $INC{'MyApp/Controller/Root.pm'} = __FILE__; |
16 | |
17 | use base 'Catalyst::Controller'; |
18 | |
19 | sub heart :Path('♥') { |
20 | my ($self, $c) = @_; |
21 | $c->response->content_type('text/html'); |
22 | $c->response->body("<p>This is path-heart action ♥</p>"); |
23 | # We let the content length middleware find the length... |
24 | } |
25 | |
26 | sub hat :Path('^') { |
27 | my ($self, $c) = @_; |
28 | $c->response->content_type('text/html'); |
29 | $c->response->body("<p>This is path-hat action ^</p>"); |
30 | } |
31 | |
e5a5e80b |
32 | sub uri_for :Path('uri_for') { |
33 | my ($self, $c) = @_; |
34 | $c->response->content_type('text/html'); |
35 | $c->response->body("${\$c->uri_for($c->controller('Root')->action_for('argend'), ['♥'], '♥', {'♥'=>'♥♥'})}"); |
36 | } |
37 | |
38 | sub heart_with_arg :Path('a♥') Args(1) { |
39 | my ($self, $c, $arg) = @_; |
40 | $c->response->content_type('text/html'); |
41 | $c->response->body("<p>This is path-heart-arg action $arg</p>"); |
42 | Test::More::is $c->req->args->[0], '♥'; |
43 | } |
44 | |
0ca510f0 |
45 | sub base :Chained('/') CaptureArgs(0) { } |
46 | sub link :Chained('base') PathPart('♥') Args(0) { |
47 | my ($self, $c) = @_; |
48 | $c->response->content_type('text/html'); |
49 | $c->response->body("<p>This is base-link action ♥</p>"); |
50 | } |
e5a5e80b |
51 | sub arg :Chained('base') PathPart('♥') Args(1) { |
52 | my ($self, $c, $arg) = @_; |
53 | $c->response->content_type('text/html'); |
54 | $c->response->body("<p>This is base-link action ♥ $arg</p>"); |
55 | } |
56 | sub capture :Chained('base') PathPart('♥') CaptureArgs(1) { |
57 | my ($self, $c, $arg) = @_; |
58 | $c->stash(capture=>$arg); |
59 | } |
60 | sub argend :Chained('capture') PathPart('♥') Args(1) { |
61 | my ($self, $c, $arg) = @_; |
62 | $c->response->content_type('text/html'); |
63 | |
64 | Test::More::is $c->req->args->[0], '♥'; |
65 | Test::More::is $c->req->captures->[0], '♥'; |
69fa672d |
66 | Test::More::is $arg, '♥'; |
67 | Test::More::is length($arg), 1, "got length of one"; |
e5a5e80b |
68 | |
69 | $c->response->body("<p>This is base-link action ♥ ${\$c->req->args->[0]}</p>"); |
dd096a3a |
70 | |
71 | # Test to make sure redirect can now take an object (sorry don't have a better place for it |
72 | # but wanted test coverage. |
73 | my $location = $c->res->redirect( $c->uri_for($c->controller('Root')->action_for('uri_for')) ); |
74 | Test::More::ok !ref $location; |
e5a5e80b |
75 | } |
0ca510f0 |
76 | |
dd096a3a |
77 | sub stream_write :Local { |
78 | my ($self, $c) = @_; |
79 | $c->response->content_type('text/html'); |
80 | $c->response->write("<p>This is stream_write action ♥</p>"); |
81 | } |
82 | |
fe1dfeaf |
83 | sub stream_write_fh :Local { |
84 | my ($self, $c) = @_; |
85 | $c->response->content_type('text/html'); |
86 | |
87 | my $writer = $c->res->write_fh; |
e8361cf8 |
88 | $writer->write_encoded('<p>This is stream_write_fh action ♥</p>'); |
59e11cd7 |
89 | $writer->close; |
90 | } |
91 | |
e8361cf8 |
92 | # Stream a file with utf8 chars directly, you don't need to decode |
59e11cd7 |
93 | sub stream_body_fh :Local { |
94 | my ($self, $c) = @_; |
59e11cd7 |
95 | my $path = File::Spec->catfile('t', 'utf8.txt'); |
96 | open(my $fh, '<', $path) || die "trouble: $!"; |
97 | $c->response->content_type('text/html'); |
98 | $c->response->body($fh); |
fe1dfeaf |
99 | } |
100 | |
e8361cf8 |
101 | # If you pull the file contents into a var, NOW you need to specify the |
102 | # IO encoding on the FH. Ultimately Plack at the end wants bytes... |
103 | sub stream_body_fh2 :Local { |
104 | my ($self, $c) = @_; |
105 | my $path = File::Spec->catfile('t', 'utf8.txt'); |
106 | open(my $fh, '<:encoding(UTF-8)', $path) || die "trouble: $!"; |
107 | my $contents = do { local $/; <$fh> }; |
108 | |
109 | $c->response->content_type('text/html'); |
110 | $c->response->body($contents); |
111 | } |
112 | |
12982f86 |
113 | sub file_upload :POST Consumes(Multipart) Local { |
114 | my ($self, $c) = @_; |
115 | Test::More::is $c->req->body_parameters->{'♥'}, '♥♥'; |
116 | Test::More::ok my $upload = $c->req->uploads->{file}; |
6adc45cf |
117 | Test::More::is $upload->charset, 'UTF-8'; |
12982f86 |
118 | |
119 | my $text = $upload->slurp; |
120 | Test::More::is Encode::decode_utf8($text), "<p>This is stream_body_fh action ♥</p>\n"; |
121 | |
6adc45cf |
122 | my $decoded_text = $upload->decoded_slurp; |
123 | Test::More::is $decoded_text, "<p>This is stream_body_fh action ♥</p>\n"; |
124 | |
125 | Test::More::is $upload->filename, '♥ttachment.txt'; |
126 | Test::More::is $upload->raw_basename, '♥ttachment.txt'; |
127 | |
12982f86 |
128 | $c->response->content_type('text/html'); |
6adc45cf |
129 | $c->response->body($decoded_text); |
12982f86 |
130 | } |
131 | |
132 | sub json :POST Consumes(JSON) Local { |
133 | my ($self, $c) = @_; |
134 | my $post = $c->req->body_data; |
135 | |
136 | Test::More::is $post->{'♥'}, '♥♥'; |
69fa672d |
137 | Test::More::is length($post->{'♥'}), 2; |
12982f86 |
138 | $c->response->content_type('application/json'); |
139 | |
140 | # Encode JSON also encodes to a UTF-8 encoded, binary string. This is why we don't |
141 | # have application/json as one of the things we match, otherwise we get double |
142 | # encoding. |
143 | $c->response->body(JSON::MaybeXS::encode_json($post)); |
144 | } |
e8361cf8 |
145 | |
6adc45cf |
146 | ## If someone clears encoding, they can do as they wish |
147 | sub manual_1 :Local { |
148 | my ($self, $c) = @_; |
c5661910 |
149 | $c->clear_encoding; |
6adc45cf |
150 | $c->res->content_type('text/plain'); |
151 | $c->res->content_type_charset('UTF-8'); |
152 | $c->response->body( Encode::encode_utf8("manual_1 ♥")); |
153 | } |
154 | |
155 | ## If you do like gzip, well handle that yourself! Basically if you do some sort |
156 | ## of content encoding like gzip, you must do on top of the encoding. We will fix |
157 | ## the encoding plugins (Catalyst::Plugin::Compress) to do this properly for you. |
158 | # |
159 | sub gzipped :Local { |
160 | require Compress::Zlib; |
161 | my ($self, $c) = @_; |
162 | $c->res->content_type('text/plain'); |
163 | $c->res->content_type_charset('UTF-8'); |
164 | $c->res->content_encoding('gzip'); |
165 | $c->response->body(Compress::Zlib::memGzip(Encode::encode_utf8("manual_1 ♥"))); |
166 | } |
167 | |
69fa672d |
168 | sub override_encoding :Local { |
169 | my ($self, $c) = @_; |
170 | $c->res->content_type('text/plain'); |
70005e98 |
171 | $c->encoding(Encode::find_encoding('UTF-8')); |
69fa672d |
172 | $c->encoding(Encode::find_encoding('Shift_JIS')); |
173 | $c->response->body("テスト"); |
174 | } |
175 | |
70005e98 |
176 | sub stream_write_error :Local { |
177 | my ($self, $c) = @_; |
178 | $c->response->content_type('text/html'); |
179 | $c->response->write("<p>This is stream_write action ♥</p>"); |
180 | $c->encoding(Encode::find_encoding('Shift_JIS')); |
181 | $c->response->write("<p>This is stream_write action ♥</p>"); |
182 | } |
183 | |
d2000928 |
184 | sub from_external_psgi :Local { |
185 | my ($self, $c) = @_; |
186 | my $env = HTTP::Message::PSGI::req_to_psgi( HTTP::Request::Common::GET '/root/♥'); |
187 | $c->res->from_psgi_response( ref($c)->to_app->($env)); |
188 | } |
189 | |
be634ffb |
190 | sub echo_arg :Local { |
191 | my ($self, $c) = @_; |
192 | $c->response->content_type('text/plain'); |
193 | $c->response->body($c->req->body_parameters->{arg}); |
194 | } |
195 | |
0ca510f0 |
196 | package MyApp; |
197 | use Catalyst; |
198 | |
0ca510f0 |
199 | Test::More::ok(MyApp->setup, 'setup app'); |
200 | } |
201 | |
202 | ok my $psgi = MyApp->psgi_app, 'build psgi app'; |
203 | |
204 | use Catalyst::Test 'MyApp'; |
0ca510f0 |
205 | |
206 | { |
207 | my $res = request "/root/♥"; |
208 | |
209 | is $res->code, 200, 'OK'; |
210 | is decode_utf8($res->content), '<p>This is path-heart action ♥</p>', 'correct body'; |
211 | is $res->content_length, 36, 'correct length'; |
4a64c27b |
212 | is $res->content_charset, 'UTF-8'; |
0ca510f0 |
213 | } |
214 | |
215 | { |
e5a5e80b |
216 | my $res = request "/root/a♥/♥"; |
217 | |
218 | is $res->code, 200, 'OK'; |
219 | is decode_utf8($res->content), '<p>This is path-heart-arg action ♥</p>', 'correct body'; |
220 | is $res->content_length, 40, 'correct length'; |
4a64c27b |
221 | is $res->content_charset, 'UTF-8'; |
e5a5e80b |
222 | } |
223 | |
224 | { |
0ca510f0 |
225 | my $res = request "/root/^"; |
226 | |
227 | is $res->code, 200, 'OK'; |
228 | is decode_utf8($res->content), '<p>This is path-hat action ^</p>', 'correct body'; |
229 | is $res->content_length, 32, 'correct length'; |
4a64c27b |
230 | is $res->content_charset, 'UTF-8'; |
0ca510f0 |
231 | } |
232 | |
233 | { |
234 | my $res = request "/base/♥"; |
235 | |
236 | is $res->code, 200, 'OK'; |
237 | is decode_utf8($res->content), '<p>This is base-link action ♥</p>', 'correct body'; |
238 | is $res->content_length, 35, 'correct length'; |
4a64c27b |
239 | is $res->content_charset, 'UTF-8'; |
0ca510f0 |
240 | } |
241 | |
242 | { |
b9d96e27 |
243 | my ($res, $c) = ctx_request POST "/base/♥?♥=♥&♥=♥♥", [a=>1, b=>'', '♥'=>'♥', '♥'=>'♥♥']; |
0ca510f0 |
244 | |
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'; |
b9d96e27 |
248 | is $c->req->parameters->{'♥'}[0], '♥'; |
249 | is $c->req->query_parameters->{'♥'}[0], '♥'; |
250 | is $c->req->body_parameters->{'♥'}[0], '♥'; |
251 | is $c->req->parameters->{'♥'}[0], '♥'; |
4a62800d |
252 | is $c->req->parameters->{a}, 1; |
253 | is $c->req->body_parameters->{a}, 1; |
4a64c27b |
254 | is $res->content_charset, 'UTF-8'; |
e5a5e80b |
255 | } |
4a62800d |
256 | |
e5a5e80b |
257 | { |
258 | my ($res, $c) = ctx_request GET "/base/♥?♥♥♥"; |
4a62800d |
259 | |
e5a5e80b |
260 | is $res->code, 200, 'OK'; |
261 | is decode_utf8($res->content), '<p>This is base-link action ♥</p>', 'correct body'; |
262 | is $res->content_length, 35, 'correct length'; |
263 | is $c->req->query_keywords, '♥♥♥'; |
4a64c27b |
264 | is $res->content_charset, 'UTF-8'; |
0ca510f0 |
265 | } |
266 | |
e5a5e80b |
267 | { |
268 | my $res = request "/base/♥/♥"; |
269 | |
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, 39, 'correct length'; |
4a64c27b |
273 | is $res->content_charset, 'UTF-8'; |
e5a5e80b |
274 | } |
b9d96e27 |
275 | |
e5a5e80b |
276 | { |
277 | my $res = request "/base/♥/♥/♥/♥"; |
278 | |
e5a5e80b |
279 | is decode_utf8($res->content), '<p>This is base-link action ♥ ♥</p>', 'correct body'; |
280 | is $res->content_length, 39, 'correct length'; |
4a64c27b |
281 | is $res->content_charset, 'UTF-8'; |
e5a5e80b |
282 | } |
283 | |
284 | { |
285 | my ($res, $c) = ctx_request POST "/base/♥/♥/♥/♥?♥=♥♥", [a=>1, b=>'2', '♥'=>'♥♥']; |
286 | |
287 | ## Make sure that the urls we generate work the same |
b063a165 |
288 | my $uri_for1 = $c->uri_for($c->controller('Root')->action_for('argend'), ['♥'], '♥', {'♥'=>'♥♥'}); |
289 | my $uri_for2 = $c->uri_for($c->controller('Root')->action_for('argend'), ['♥', '♥'], {'♥'=>'♥♥'}); |
e5a5e80b |
290 | my $uri = $c->req->uri; |
291 | |
b063a165 |
292 | is "$uri_for1", "$uri_for2"; |
293 | is "$uri", "$uri_for1"; |
e5a5e80b |
294 | |
295 | { |
b063a165 |
296 | my ($res, $c) = ctx_request POST "$uri_for1", [a=>1, b=>'2', '♥'=>'♥♥']; |
e5a5e80b |
297 | is $c->req->query_parameters->{'♥'}, '♥♥'; |
298 | is $c->req->body_parameters->{'♥'}, '♥♥'; |
299 | is $c->req->parameters->{'♥'}[0], '♥♥'; #combined with query and body |
69fa672d |
300 | is $c->req->args->[0], '♥'; |
301 | is length($c->req->parameters->{'♥'}[0]), 2; |
302 | is length($c->req->query_parameters->{'♥'}), 2; |
303 | is length($c->req->body_parameters->{'♥'}), 2; |
304 | is length($c->req->args->[0]), 1; |
4a64c27b |
305 | is $res->content_charset, 'UTF-8'; |
e5a5e80b |
306 | } |
307 | } |
308 | |
309 | { |
310 | my ($res, $c) = ctx_request "/root/uri_for"; |
311 | my $url = $c->uri_for($c->controller('Root')->action_for('argend'), ['♥'], '♥', {'♥'=>'♥♥'}); |
312 | |
313 | is $res->code, 200, 'OK'; |
314 | is decode_utf8($res->content), "$url", 'correct body'; #should do nothing |
315 | is $res->content, "$url", 'correct body'; |
316 | is $res->content_length, 90, 'correct length'; |
4a64c27b |
317 | is $res->content_charset, 'UTF-8'; |
b063a165 |
318 | |
319 | { |
320 | my $url = $c->uri_for($c->controller->action_for('heart_with_arg'), '♥'); |
6adc45cf |
321 | is "$url", 'http://localhost/root/a%E2%99%A5/%E2%99%A5', "correct $url"; |
b063a165 |
322 | } |
323 | |
324 | { |
325 | my $url = $c->uri_for($c->controller->action_for('heart_with_arg'), ['♥']); |
6adc45cf |
326 | is "$url", 'http://localhost/root/a%E2%99%A5/%E2%99%A5', "correct $url"; |
b063a165 |
327 | } |
dd096a3a |
328 | } |
329 | |
330 | { |
331 | my $res = request "/root/stream_write"; |
00038a21 |
332 | |
6adc45cf |
333 | is $res->code, 200, 'OK GET /root/stream_write'; |
dd096a3a |
334 | is decode_utf8($res->content), '<p>This is stream_write action ♥</p>', 'correct body'; |
4a64c27b |
335 | is $res->content_charset, 'UTF-8'; |
e5a5e80b |
336 | } |
0ca510f0 |
337 | |
fe1dfeaf |
338 | { |
59e11cd7 |
339 | my $res = request "/root/stream_body_fh"; |
340 | |
341 | is $res->code, 200, 'OK'; |
342 | is decode_utf8($res->content), "<p>This is stream_body_fh action ♥</p>\n", 'correct body'; |
4a64c27b |
343 | is $res->content_charset, 'UTF-8'; |
59e11cd7 |
344 | # Not sure why there is a trailing newline above... its not in catalyst code I can see. Not sure |
345 | # if is a problem or just an artifact of the why the test stuff works - JNAP |
346 | } |
347 | |
348 | { |
7b39dea1 |
349 | my $res = request "/root/stream_write_fh"; |
fe1dfeaf |
350 | |
351 | is $res->code, 200, 'OK'; |
352 | is decode_utf8($res->content), '<p>This is stream_write_fh action ♥</p>', 'correct body'; |
8a79126d |
353 | #is $res->content_length, 41, 'correct length'; |
4a64c27b |
354 | is $res->content_charset, 'UTF-8'; |
fe1dfeaf |
355 | } |
dd096a3a |
356 | |
e8361cf8 |
357 | { |
358 | my $res = request "/root/stream_body_fh2"; |
359 | |
360 | is $res->code, 200, 'OK'; |
361 | is decode_utf8($res->content), "<p>This is stream_body_fh action ♥</p>\n", 'correct body'; |
362 | is $res->content_length, 41, 'correct length'; |
363 | is $res->content_charset, 'UTF-8'; |
364 | } |
365 | |
12982f86 |
366 | { |
367 | ok my $path = File::Spec->catfile('t', 'utf8.txt'); |
368 | ok my $req = POST '/root/file_upload', |
369 | Content_Type => 'form-data', |
6adc45cf |
370 | Content => [encode_utf8('♥')=>encode_utf8('♥♥'), file=>["$path", encode_utf8('♥ttachment.txt'), 'Content-Type' =>'text/html; charset=UTF-8', ]]; |
12982f86 |
371 | |
372 | ok my $res = request $req; |
373 | is decode_utf8($res->content), "<p>This is stream_body_fh action ♥</p>\n"; |
374 | } |
375 | |
376 | { |
377 | ok my $req = POST '/root/json', |
378 | Content_Type => 'application/json', |
379 | Content => encode_json +{'♥'=>'♥♥'}; # Note: JSON does the UTF* encoding for us |
380 | |
381 | ok my $res = request $req; |
382 | |
383 | ## decode_json expect the binary utf8 string and does the decoded bit for us. |
384 | is_deeply decode_json(($res->content)), +{'♥'=>'♥♥'}; |
385 | } |
386 | |
6adc45cf |
387 | { |
69fa672d |
388 | ok my $res = request "/root/override_encoding"; |
389 | ok my $enc = Encode::find_encoding('SHIFT_JIS'); |
390 | |
391 | is $res->code, 200, 'OK'; |
392 | is $enc->decode($res->content), "テスト", 'correct body'; |
393 | is $res->content_length, 6, 'correct length'; # Bytes over the wire |
394 | is length($enc->decode($res->content)), 3; |
395 | is $res->content_charset, 'SHIFT_JIS'; |
396 | } |
397 | |
398 | { |
6adc45cf |
399 | my $res = request "/root/manual_1"; |
400 | |
401 | is $res->code, 200, 'OK'; |
402 | is decode_utf8($res->content), "manual_1 ♥", 'correct body'; |
403 | is $res->content_length, 12, 'correct length'; |
404 | is $res->content_charset, 'UTF-8'; |
405 | } |
406 | |
407 | SKIP: { |
408 | eval { require Compress::Zlib; 1} || do { |
409 | skip "Compress::Zlib needed to test gzip encoding", 5 }; |
410 | |
411 | my $res = request "/root/gzipped"; |
412 | ok my $raw_content = $res->content; |
413 | ok my $content = Compress::Zlib::memGunzip($raw_content), 'no gunzip error'; |
414 | |
415 | is $res->code, 200, 'OK'; |
416 | is decode_utf8($content), "manual_1 ♥", 'correct body'; |
417 | is $res->content_charset, 'UTF-8'; |
418 | } |
419 | |
70005e98 |
420 | { |
421 | my $res = request "/root/stream_write_error"; |
422 | |
423 | is $res->code, 200, 'OK'; |
424 | like decode_utf8($res->content), qr[<p>This is stream_write action ♥</p><!DOCTYPE html], 'correct body'; |
425 | } |
426 | |
d2000928 |
427 | { |
428 | my $res = request "/root/from_external_psgi"; |
429 | |
430 | is $res->code, 200, 'OK'; |
431 | is decode_utf8($res->content), '<p>This is path-heart action ♥</p>', 'correct body'; |
432 | is $res->content_length, 36, 'correct length'; |
433 | is $res->content_charset, 'UTF-8'; |
434 | } |
70005e98 |
435 | |
05585938 |
436 | SKIP: { |
437 | skip 4; |
be634ffb |
438 | my $utf8 = 'test ♥'; |
439 | my $shiftjs = 'test テスト'; |
440 | |
441 | ok my $req = POST '/root/echo_arg', |
442 | Content_Type => 'form-data', |
443 | Content => [ |
444 | arg0 => 'helloworld', |
445 | arg1 => [ |
446 | undef, '', |
447 | 'Content-Type' =>'text/plain; charset=UTF-8', |
448 | 'Content' => Encode::encode('UTF-8', $utf8)], |
449 | arg2 => [ |
450 | undef, '', |
451 | 'Content-Type' =>'text/plain; charset=SHIFT_JIS', |
452 | 'Content' => Encode::encode('SHIFT_JIS', $shiftjs)], |
453 | arg2 => [ |
454 | undef, '', |
455 | 'Content-Type' =>'text/plain; charset=SHIFT_JIS', |
456 | 'Content' => Encode::encode('SHIFT_JIS', $shiftjs)], |
457 | ]; |
458 | |
459 | my ($res, $c) = ctx_request $req; |
460 | |
461 | is $c->req->body_parameters->{'arg0'}, 'helloworld'; |
462 | is Encode::decode('UTF-8', $c->req->body_parameters->{'arg1'}), $utf8; |
463 | is Encode::decode('SHIFT_JIS', $c->req->body_parameters->{'arg2'}[0]), $shiftjs; |
464 | |
465 | } |
466 | |
12982f86 |
467 | ## should we use binmode on filehandles to force the encoding...? |
468 | ## Not sure what else to do with multipart here, if docs are enough... |
469 | |
0ca510f0 |
470 | done_testing; |