1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
|
use strictures 1;
use Test::More 0.88;
{
package t::Web::Simple::HTTPMethods;
use Web::Simple;
use Web::Dispatch::HTTPMethods;
sub as_text {
[200, ['Content-Type' => 'text/plain'],
[$_[0]->{REQUEST_METHOD}, $_[0]->{REQUEST_URI}] ]
}
sub dispatch_request {
sub (/get) {
GET { as_text(pop) }
},
sub (/get-head-options) {
GET { as_text(pop) }
HEAD { [204,[],[]] }
OPTIONS { [204,[],[]] },
},
sub (/get-post-put) {
GET { as_text(pop) }
POST { as_text(pop) }
PUT { as_text(pop) }
},
}
}
ok my $app = t::Web::Simple::HTTPMethods->new,
'made app';
for my $uri ('http://localhost/get-post-put') {
## Check allowed methods and responses
for(ok my $res = $app->run_test_request(GET => $uri)) {
is $res->content, 'GET/get-post-put';
}
for(ok my $res = $app->run_test_request(POST => $uri)) {
is $res->content, 'POST/get-post-put';
}
for(ok my $res = $app->run_test_request(PUT => $uri)) {
is $res->content, 'PUT/get-post-put';
}
## Since GET is allowed, check for implict HEAD
for(ok my $head = $app->run_test_request(HEAD => $uri)) {
is $head->code, 200;
is $head->content, '';
}
## Check the implicit support for OPTIONS
for(ok my $options = $app->run_test_request(OPTIONS => $uri)) {
is $options->code, 200;
is $options->content, '';
is $options->header('Allow'), 'GET,HEAD,POST,PUT,OPTIONS';
}
## Check implicitly added not allowed
for(ok my $not_allowed = $app->run_test_request(DELETE => $uri)) {
is $not_allowed->code, 405;
is $not_allowed->content, 'Method Not Allowed';
is $not_allowed->header('Allow'), 'GET,HEAD,POST,PUT,OPTIONS';
}
}
for my $uri ('http://localhost/get-head-options') {
## Check allowed methods and responses
for(ok my $res = $app->run_test_request(GET => $uri)) {
is $res->content, 'GET/get-head-options';
}
for(ok my $head = $app->run_test_request(HEAD => $uri)) {
is $head->code, 204;
is $head->content, '';
}
for(ok my $options = $app->run_test_request(OPTIONS => $uri)) {
is $options->code, 204;
is $options->content, '';
}
## Check implicitly added not allowed
for(ok my $not_allowed = $app->run_test_request(PUT => $uri)) {
is $not_allowed->code, 405;
is $not_allowed->content, 'Method Not Allowed';
is $not_allowed->header('Allow'), 'GET,HEAD,OPTIONS';
}
}
for my $uri ('http://localhost/get') {
## Check allowed methods and responses
for(ok my $res = $app->run_test_request(GET => $uri)) {
is $res->content, 'GET/get';
}
## Check implicitly added not allowed
for(ok my $not_allowed = $app->run_test_request(PUT => $uri)) {
is $not_allowed->code, 405;
is $not_allowed->content, 'Method Not Allowed';
is $not_allowed->header('Allow'), 'GET,HEAD,OPTIONS';
}
## Since GET is allowed, check for implict HEAD
for(ok my $head = $app->run_test_request(HEAD => $uri)) {
is $head->code, 200;
is $head->content, '';
}
}
done_testing;
|
