Commit | Line | Data |
55046410 |
1 | #!/usr/bin/env perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | use Test::More tests => 5 * 5; |
6 | use utf8; |
7 | |
8 | # setup library path |
9 | use FindBin qw($Bin); |
10 | use lib "$Bin/lib"; |
11 | |
12 | use Catalyst::Test 'TestAppUnicode'; |
13 | use Encode; |
14 | use HTTP::Request::Common; |
15 | use URI::Escape qw/uri_escape_utf8/; |
16 | use HTTP::Status 'is_server_error'; |
17 | |
18 | my $encode_str = "\x{e3}\x{81}\x{82}"; # e38182 is japanese 'あ' |
19 | my $decode_str = Encode::decode('utf-8' => $encode_str); |
20 | my $escape_str = uri_escape_utf8($decode_str); |
21 | |
22 | check_parameter(GET "/?foo=$escape_str"); |
23 | check_parameter(POST '/', ['foo' => $encode_str]); |
24 | check_parameter(POST '/', |
25 | Content_Type => 'form-data', |
26 | Content => [ |
27 | 'foo' => [ |
28 | "$Bin/unicode_plugin_request_decode.t", |
29 | $encode_str, |
30 | ] |
31 | ], |
32 | ); |
33 | |
34 | check_argument(GET "/$escape_str"); |
35 | check_capture(GET "/capture/$escape_str"); |
36 | |
37 | # sending non-utf8 data |
38 | my $non_utf8_data = "%C3%E6%CB%AA"; |
39 | check_fallback(GET "/?q=${non_utf8_data}"); |
40 | check_fallback(GET "/${non_utf8_data}"); |
41 | check_fallback(GET "/capture/${non_utf8_data}"); |
42 | check_fallback(POST '/', ['foo' => $non_utf8_data]); |
43 | |
44 | sub check_parameter { |
45 | my ( undef, $c ) = ctx_request(shift); |
46 | is $c->res->output => '<h1>It works</h1>'; |
47 | |
48 | my $foo = $c->req->param('foo'); |
49 | ok utf8::is_utf8($foo); |
50 | is $foo => $decode_str; |
51 | |
52 | my $other_foo = $c->req->method eq 'POST' |
53 | ? $c->req->upload('foo') |
54 | ? $c->req->upload('foo')->filename |
55 | : $c->req->body_parameters->{foo} |
56 | : $c->req->query_parameters->{foo}; |
57 | ok utf8::is_utf8($other_foo); |
58 | is $other_foo => $decode_str; |
59 | } |
60 | |
61 | sub check_argument { |
62 | my ( undef, $c ) = ctx_request(shift); |
63 | is $c->res->output => '<h1>It works</h1>'; |
64 | |
65 | my $foo = $c->req->args->[0]; |
66 | ok utf8::is_utf8($foo); |
67 | is $foo => $decode_str; |
68 | } |
69 | |
70 | sub check_capture { |
71 | my ( undef, $c ) = ctx_request(shift); |
72 | is $c->res->output => '<h1>It works</h1>'; |
73 | |
74 | my $foo = $c->req->captures->[0]; |
75 | ok utf8::is_utf8($foo); |
76 | is $foo => $decode_str; |
77 | } |
78 | |
79 | sub check_fallback { |
80 | my ( $res, $c ) = ctx_request(shift); |
81 | ok(!is_server_error($res->code)) or diag('Response code is: ' . $res->code); |
82 | } |