| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package Mason::Plugin::WithEncoding::t::UTF8; |
|
2
|
|
|
|
|
|
|
$Mason::Plugin::WithEncoding::t::UTF8::VERSION = '0.2'; |
|
3
|
1
|
|
|
1
|
|
1720
|
use utf8; |
|
|
1
|
|
|
|
|
10
|
|
|
|
1
|
|
|
|
|
4
|
|
|
4
|
|
|
|
|
|
|
|
|
5
|
1
|
|
|
1
|
|
1425
|
use Test::Class::Most parent => 'Mason::Plugin::WithEncoding::Test::Class'; |
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
use Guard; |
|
7
|
|
|
|
|
|
|
use Poet::Tools qw(dirname mkpath trim write_file); |
|
8
|
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
# Setup stolen from Poet::t::Run and Poet::t::PSGIHandler |
|
10
|
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
sub test_withencoding : Tests { |
|
12
|
|
|
|
|
|
|
my $self = shift; |
|
13
|
|
|
|
|
|
|
my $poet_conf = shift; |
|
14
|
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
my $conf_utf8 = { |
|
16
|
|
|
|
|
|
|
'layer' => 'production', |
|
17
|
|
|
|
|
|
|
'server.port' => 9999, |
|
18
|
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
'mason.extra_plugins' => [qw(WithEncoding)], |
|
20
|
|
|
|
|
|
|
'server.load_modules' => ['Mason::Plugin::WithEncoding'], |
|
21
|
|
|
|
|
|
|
'server.encoding.request' => 'UTF-8', |
|
22
|
|
|
|
|
|
|
'server.encoding.response' => 'UTF-8', |
|
23
|
|
|
|
|
|
|
'server.default_content_type' => 'text/html; charset=UTF-8', |
|
24
|
|
|
|
|
|
|
}; |
|
25
|
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
my $poet = $self->temp_env(conf => $conf_utf8); |
|
27
|
|
|
|
|
|
|
my $root_dir = $poet->root_dir; |
|
28
|
|
|
|
|
|
|
my $run_log = "$root_dir/logs/run.log"; |
|
29
|
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
if ( my $pid = fork() ) { |
|
31
|
|
|
|
|
|
|
# parent |
|
32
|
|
|
|
|
|
|
scope_guard { kill( 1, $pid ) }; |
|
33
|
|
|
|
|
|
|
sleep(2); |
|
34
|
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
my $mech = $self->mech($poet); |
|
36
|
|
|
|
|
|
|
$self->add_comps($poet); |
|
37
|
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
# |
|
39
|
|
|
|
|
|
|
# Unescaping the query string doesn't produce love hearts, which I don't |
|
40
|
|
|
|
|
|
|
# really understand, since this does: |
|
41
|
|
|
|
|
|
|
# |
|
42
|
|
|
|
|
|
|
# $ perl -MURI::Escape -e 'print uri_unescape("%E2%99%A5%E2%99%A5=%E2%99%A5%E2%99%A5%E2%99%A5%E2%99%A5%E2%99%A5%E2%99%A5%E2%99%A5")."\n"' |
|
43
|
|
|
|
|
|
|
# $ ♥♥=♥♥♥♥♥♥♥ |
|
44
|
|
|
|
|
|
|
# |
|
45
|
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
# utf8 config, utf8 content, utf8 url, utf8 query |
|
47
|
|
|
|
|
|
|
$mech->get_ok("http://127.0.0.1:9999/♥♥♥?♥♥=♥♥♥♥♥♥♥"); |
|
48
|
|
|
|
|
|
|
# query string goes over wires as encoded ascii, so clients use url encoding to preserve information |
|
49
|
|
|
|
|
|
|
$mech->content_unlike(qr/QUERY STRING FROM REQ: ♥♥=♥♥♥♥♥♥/); |
|
50
|
|
|
|
|
|
|
$mech->content_like(qr[QUERY STRING FROM REQ: \Q%E2%99%A5%E2%99%A5=%E2%99%A5%E2%99%A5%E2%99%A5%E2%99%A5%E2%99%A5%E2%99%A5%E2%99%A5\E]); |
|
51
|
|
|
|
|
|
|
$mech->content_unlike(qr/QUERY STRING UNESCAPED: ♥♥=♥♥♥♥♥♥♥/); |
|
52
|
|
|
|
|
|
|
#warn $mech->content; |
|
53
|
|
|
|
|
|
|
$mech->content_like(qr/A QUICK BROWN FOX JUMPS OVER THE LAZY DOG/); |
|
54
|
|
|
|
|
|
|
$mech->content_unlike(qr/a quick brown fox jumps over the lazy dog/); |
|
55
|
|
|
|
|
|
|
$mech->content_like(qr/ΔΙΑΦΥΛΆΞΤΕ ΓΕΝΙΚΆ ΤΗ ΖΩΉ ΣΑΣ ΑΠΌ ΒΑΘΕΙΆ ΨΥΧΙΚΆ ΤΡΑΎΜΑΤΑ/); |
|
56
|
|
|
|
|
|
|
$mech->content_unlike(qr/διαφυλάξτε γενικά τη ζωή σας από βαθειά ψυχικά τραύματα/); |
|
57
|
|
|
|
|
|
|
is($mech->content_type, 'text/html', 'Got correct content type'); |
|
58
|
|
|
|
|
|
|
is($mech->response->content_type_charset, 'UTF-8', 'Got correct content-type charset'); |
|
59
|
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
# utf8 config, utf8 content, utf8 url, no query |
|
61
|
|
|
|
|
|
|
$mech->get_ok("http://127.0.0.1:9999/♥♥♥"); |
|
62
|
|
|
|
|
|
|
$mech->content_like(qr/A QUICK BROWN FOX JUMPS OVER THE LAZY DOG/); |
|
63
|
|
|
|
|
|
|
$mech->content_unlike(qr/a quick brown fox jumps over the lazy dog/); |
|
64
|
|
|
|
|
|
|
$mech->content_like(qr/ΔΙΑΦΥΛΆΞΤΕ ΓΕΝΙΚΆ ΤΗ ΖΩΉ ΣΑΣ ΑΠΌ ΒΑΘΕΙΆ ΨΥΧΙΚΆ ΤΡΑΎΜΑΤΑ/); |
|
65
|
|
|
|
|
|
|
$mech->content_unlike(qr/διαφυλάξτε γενικά τη ζωή σας από βαθειά ψυχικά τραύματα/); |
|
66
|
|
|
|
|
|
|
is($mech->content_type, 'text/html', 'Got correct content type'); |
|
67
|
|
|
|
|
|
|
is($mech->response->content_type_charset, 'UTF-8', 'Got correct content-type charset'); |
|
68
|
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
# utf8 config, utf8 content, ascii url, utf8 query |
|
70
|
|
|
|
|
|
|
$mech->get_ok("http://127.0.0.1:9999/utf8?♥♥=♥♥♥♥♥♥♥"); |
|
71
|
|
|
|
|
|
|
# query string goes over wires as encoded ascii, so clients use url encoding to preserve information |
|
72
|
|
|
|
|
|
|
$mech->content_unlike(qr/QUERY STRING FROM REQ: ♥♥=♥♥♥♥♥♥/); |
|
73
|
|
|
|
|
|
|
$mech->content_like(qr[QUERY STRING FROM REQ: \Q%E2%99%A5%E2%99%A5=%E2%99%A5%E2%99%A5%E2%99%A5%E2%99%A5%E2%99%A5%E2%99%A5%E2%99%A5\E]); |
|
74
|
|
|
|
|
|
|
$mech->content_unlike(qr/QUERY STRING UNESCAPED: ♥♥=♥♥♥♥♥♥♥/); |
|
75
|
|
|
|
|
|
|
#warn $mech->content; |
|
76
|
|
|
|
|
|
|
$mech->content_like(qr/A QUICK BROWN FOX JUMPS OVER THE LAZY DOG/); |
|
77
|
|
|
|
|
|
|
$mech->content_unlike(qr/a quick brown fox jumps over the lazy dog/); |
|
78
|
|
|
|
|
|
|
$mech->content_like(qr/ΔΙΑΦΥΛΆΞΤΕ ΓΕΝΙΚΆ ΤΗ ΖΩΉ ΣΑΣ ΑΠΌ ΒΑΘΕΙΆ ΨΥΧΙΚΆ ΤΡΑΎΜΑΤΑ/); |
|
79
|
|
|
|
|
|
|
$mech->content_unlike(qr/διαφυλάξτε γενικά τη ζωή σας από βαθειά ψυχικά τραύματα/); |
|
80
|
|
|
|
|
|
|
is($mech->content_type, 'text/html', 'Got correct content type'); |
|
81
|
|
|
|
|
|
|
is($mech->response->content_type_charset, 'UTF-8', 'Got correct content-type charset'); |
|
82
|
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
# utf8 config, utf8 content, ascii url, no query |
|
84
|
|
|
|
|
|
|
$mech->get_ok("http://127.0.0.1:9999/utf8"); |
|
85
|
|
|
|
|
|
|
$mech->content_like(qr/A QUICK BROWN FOX JUMPS OVER THE LAZY DOG/); |
|
86
|
|
|
|
|
|
|
$mech->content_unlike(qr/a quick brown fox jumps over the lazy dog/); |
|
87
|
|
|
|
|
|
|
$mech->content_like(qr/ΔΙΑΦΥΛΆΞΤΕ ΓΕΝΙΚΆ ΤΗ ΖΩΉ ΣΑΣ ΑΠΌ ΒΑΘΕΙΆ ΨΥΧΙΚΆ ΤΡΑΎΜΑΤΑ/); |
|
88
|
|
|
|
|
|
|
$mech->content_unlike(qr/διαφυλάξτε γενικά τη ζωή σας από βαθειά ψυχικά τραύματα/); |
|
89
|
|
|
|
|
|
|
is($mech->content_type, 'text/html', 'Got correct content type'); |
|
90
|
|
|
|
|
|
|
is($mech->response->content_type_charset, 'UTF-8', 'Got correct content-type charset'); |
|
91
|
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
# utf8 config, plain content, plain url, no query |
|
93
|
|
|
|
|
|
|
$mech->get_ok("http://127.0.0.1:9999/plain"); |
|
94
|
|
|
|
|
|
|
$mech->content_like(qr/LOREM IPSUM DOLOR SIT AMET/); |
|
95
|
|
|
|
|
|
|
$mech->content_unlike(qr/Lorem ipsum dolor sit amet/); |
|
96
|
|
|
|
|
|
|
is($mech->content_type, 'text/html', 'Got correct content type'); |
|
97
|
|
|
|
|
|
|
is($mech->response->content_type_charset, 'UTF-8', 'Got correct content-type charset'); |
|
98
|
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
# utf8 config, chokes on $.args->{♥} in the page, looks like a bug |
|
100
|
|
|
|
|
|
|
$mech->get("http://127.0.0.1:9999/dies"); |
|
101
|
|
|
|
|
|
|
ok($mech->status == 500, 'UTF8 content bug'); |
|
102
|
|
|
|
|
|
|
is($mech->content_type, '', 'Got correct content type'); |
|
103
|
|
|
|
|
|
|
is($mech->response->content_type_charset, undef, 'Got correct content-type charset'); |
|
104
|
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
# utf8 config, json content |
|
106
|
|
|
|
|
|
|
$mech->get_ok("http://127.0.0.1:9999/json"); |
|
107
|
|
|
|
|
|
|
#warn $mech->content; |
|
108
|
|
|
|
|
|
|
my $expected_from_json = { |
|
109
|
|
|
|
|
|
|
foo => 'bar', |
|
110
|
|
|
|
|
|
|
baz => [qw(barp beep)], |
|
111
|
|
|
|
|
|
|
9 => { one => 1, ex => 'EKS' }, |
|
112
|
|
|
|
|
|
|
heart => '♥', |
|
113
|
|
|
|
|
|
|
}; |
|
114
|
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
cmp_deeply(JSON->new->utf8->decode($mech->content), $expected_from_json, 'Decoded and de-JSONified expected data from JSON'); |
|
116
|
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
# this doesn't work |
|
118
|
|
|
|
|
|
|
#my $expected_mangled_from_json = {%$expected_from_json, heart => '�'}; # � |
|
119
|
|
|
|
|
|
|
# I can't figure out how to get this test to work. The cmp_deeply fails if fed |
|
120
|
|
|
|
|
|
|
# the unmangled hashref as expected, I |
|
121
|
|
|
|
|
|
|
# just can't figure out how to mangle the expected hashref to match the mangled hashref |
|
122
|
|
|
|
|
|
|
# retrieved from the $mech content |
|
123
|
|
|
|
|
|
|
#cmp_deeply(JSON->new->decode($mech->content), $expected_mangled_from_json, 'Mangled data from JSON'); # fails '�' |
|
124
|
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
my $from_decoded_utf8 = JSON->new->utf8->decode($mech->content); # should work |
|
126
|
|
|
|
|
|
|
my $not_decoded = JSON->new->decode($mech->content); # should break |
|
127
|
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
ok($from_decoded_utf8->{heart}, 'My heart is true'); |
|
129
|
|
|
|
|
|
|
is($from_decoded_utf8->{heart}, '♥', 'Found my true ♥'); |
|
130
|
|
|
|
|
|
|
ok($not_decoded->{heart}, 'My heart is true'); |
|
131
|
|
|
|
|
|
|
ok($not_decoded->{heart} ne '♥', 'My heart has been mangled'); |
|
132
|
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
is($mech->content_type, 'application/json', 'Got correct content type'); |
|
134
|
|
|
|
|
|
|
is($mech->response->content_type_charset, 'UTF-8', 'Got correct content-type charset'); |
|
135
|
|
|
|
|
|
|
} |
|
136
|
|
|
|
|
|
|
else { |
|
137
|
|
|
|
|
|
|
# child |
|
138
|
|
|
|
|
|
|
close STDOUT; |
|
139
|
|
|
|
|
|
|
close STDERR; |
|
140
|
|
|
|
|
|
|
exec( $poet->bin_path("run.pl > $run_log 2>&1") ); |
|
141
|
|
|
|
|
|
|
} |
|
142
|
|
|
|
|
|
|
} |
|
143
|
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
1; |