Commit | Line | Data |
f6ddb2f2 |
1 | use strict; |
2 | use warnings; |
3 | use Test::More; |
4 | use HTTP::Request::Common; |
5 | |
6 | BEGIN { |
7 | package TestApp::Controller::Root; |
8 | $INC{'TestApp/Controller/Root.pm'} = __FILE__; |
9 | |
10 | use Moose; |
11 | use MooseX::MethodAttributes; |
12 | extends 'Catalyst::Controller'; |
13 | |
14 | sub main :Path('') :Args(1) { |
15 | my ($self, $c, $arg) = @_; |
16 | my $body = $arg . "\n"; |
17 | my $query_params = $c->request->query_params; |
18 | my $body_params = $c->request->body_params; |
19 | foreach my $key (sort keys %$query_params) { |
20 | $body .= "Q $key => " . $query_params->{$key} . "\n"; |
21 | } |
22 | foreach my $key (sort keys %$body_params) { |
23 | $body .= "B $key => " . $body_params->{$key} . "\n"; |
24 | } |
25 | $c->res->body($body); |
26 | $c->res->content_type('text/plain'); |
27 | } |
28 | TestApp::Controller::Root->config(namespace => ''); |
29 | } |
30 | |
31 | { |
32 | package TestApp; |
33 | $INC{'TestApp.pm'} = __FILE__; |
88e5a8b0 |
34 | |
f6ddb2f2 |
35 | use Catalyst; |
36 | |
37 | sub handle_unicode_encoding_exception { |
38 | my ( $self, $param_value, $error_msg ) = @_; |
39 | # totally dummy: we return any invalid string with a fixed |
40 | # value. a more clever thing would be try to decode it from |
41 | # latin1 or latin2. |
42 | return "INVALID-UNICODE"; |
43 | } |
44 | |
45 | __PACKAGE__->setup; |
46 | } |
88e5a8b0 |
47 | |
48 | |
f6ddb2f2 |
49 | use Catalyst::Test 'TestApp'; |
50 | |
51 | { |
52 | my $res = request('/ok'); |
53 | is ($res->content, "ok\n", "app is echoing arguments"); |
54 | } |
88e5a8b0 |
55 | |
f6ddb2f2 |
56 | { |
57 | my $res = request('/%E2%C3%83%C6%92%C3%8'); |
58 | is ($res->content, "INVALID-UNICODE\n", |
59 | "replacement ok in arguments"); |
60 | } |
61 | { |
62 | my $res = request('/p?valid_key=%e2'); |
63 | is ($res->content, "p\nQ valid_key => INVALID-UNICODE\n", |
64 | "replacement ok in query"); |
65 | } |
66 | { |
67 | my $res = request('/p?%e2=%e2'); |
68 | is ($res->content, "p\nQ INVALID-UNICODE => INVALID-UNICODE\n", |
69 | "replacement ok in query"); |
70 | } |
71 | { |
72 | my $req = POST "/p", Content => "%e2=%e2"; |
73 | my $res = request($req); |
74 | is ($res->content, "p\nB INVALID-UNICODE => INVALID-UNICODE\n", "replacement ok in body"); |
75 | } |
76 | { |
77 | my $req = POST "/p", Content => "valid_key=%e2"; |
78 | my $res = request($req); |
79 | is ($res->content, "p\nB valid_key => INVALID-UNICODE\n", "replacement ok in body"); |
80 | } |
81 | { |
82 | # and a superset of problems: |
83 | my $req = POST "/%e5?%e3=%e3", Content => "%e4=%e4"; |
84 | my $res = request($req); |
85 | my $expected = <<'BODY'; |
86 | INVALID-UNICODE |
87 | Q INVALID-UNICODE => INVALID-UNICODE |
88 | B INVALID-UNICODE => INVALID-UNICODE |
89 | BODY |
90 | is ($res->content, $expected, "Found the replacement strings everywhere"); |
91 | } |
92 | |
93 | |
94 | done_testing; |
95 | |
96 | #TestApp->to_app; |