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; |