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