1#!/usr/bin/perl
2
3use strict;
4use warnings;
5use FindBin;
6
7use Test::More;
8use Test::Fatal;
9
10use Plack::Test;
11use Plack::Util;
12
13use HTTP::Request::Common qw[ GET HEAD PUT POST DELETE ];
14
15BEGIN {
16    if (!eval { require JSON::XS; 1 }) {
17        plan skip_all => "JSON::XS is required for this test";
18    }
19}
20
21test_psgi
22    Plack::Util::load_psgi( "$FindBin::Bin/../examples/env-resource/app.psgi" ),
23    sub {
24        my $cb   = shift;
25        my $JSON = JSON::XS->new->allow_nonref;
26
27        # NOTE:
28        # we won't test Content-Length in here
29        # because that will change based on the
30        # contents of ENV, which are not static.
31        # - SL
32
33        {
34            my $res = $cb->(GET "/");
35            is($res->code, 200, '... got the expected status');
36            is($res->header('Content-Type'), 'application/json', '... got the expected Content-Type header');
37            is_deeply(
38                $JSON->decode( $res->content ),
39                \%ENV,
40                '... got the expected content'
41            );
42        }
43
44        # test affecting the ENV
45
46        {
47            my $res = $cb->(GET "/WEB_MACHINE_TESTING");
48            is($res->code, 404, '... got the expected status');
49            is($res->header('Content-Type'), 'text/plain', '... got the expected Content-Type header');
50            is($res->content, 'Not Found', '... got the expected content');
51        }
52
53        $ENV{'WEB_MACHINE_TESTING'} = __FILE__;
54
55        {
56            my $res = $cb->(GET "/WEB_MACHINE_TESTING");
57            is($res->code, 200, '... got the expected status');
58            is($res->header('Content-Type'), 'application/json', '... got the expected Content-Type header');
59            is_deeply(
60                $JSON->decode( $res->content ),
61                __FILE__,
62                '... got the expected content'
63            );
64        }
65
66        {
67            my $res = $cb->(DELETE "/WEB_MACHINE_TESTING");
68            is($res->code, 204, '... got the expected status');
69            is($res->header('Content-Type'), 'application/json', '... got the expected Content-Type header');
70            is($res->content, '', '... got the expected content');
71        }
72
73        {
74            my $res = $cb->(GET "/WEB_MACHINE_TESTING");
75            is($res->code, 404, '... got the expected status');
76            is($res->header('Content-Type'), 'text/plain', '... got the expected Content-Type header');
77            is($res->content, 'Not Found', '... got the expected content');
78        }
79
80        # now through the web-service
81
82        {
83            my $res = $cb->(GET "/WEB_MACHINE_AUTOMATED_TESTING");
84            is($res->code, 404, '... got the expected status');
85            is($res->header('Content-Type'), 'text/plain', '... got the expected Content-Type header');
86            is($res->content, 'Not Found', '... got the expected content');
87        }
88
89        {
90            my $res = $cb->(PUT "/WEB_MACHINE_AUTOMATED_TESTING", (
91                'Content-Type' => 'application/json', 'Content' => '"FOOBAR"'
92            ));
93            is($res->code, 204, '... got the expected status');
94            is($res->header('Content-Type'), 'application/json', '... got the expected Content-Type header');
95            is($res->content, '', '... got the expected content');
96        }
97
98        ok(exists $ENV{'WEB_MACHINE_AUTOMATED_TESTING'}, '... the variable exists now');
99        is($ENV{'WEB_MACHINE_AUTOMATED_TESTING'}, 'FOOBAR', '... the variable has the value we want');
100
101        {
102            my $res = $cb->(GET "/WEB_MACHINE_AUTOMATED_TESTING");
103            is($res->code, 200, '... got the expected status');
104            is($res->header('Content-Type'), 'application/json', '... got the expected Content-Type header');
105            is_deeply(
106                $JSON->decode( $res->content ),
107                "FOOBAR",
108                '... got the expected content'
109            );
110        }
111
112        {
113            my $res = $cb->(DELETE "/WEB_MACHINE_AUTOMATED_TESTING");
114            is($res->code, 204, '... got the expected status');
115            is($res->header('Content-Type'), 'application/json', '... got the expected Content-Type header');
116            is($res->content, '', '... got the expected content');
117        }
118
119        {
120            my $res = $cb->(GET "/WEB_MACHINE_AUTOMATED_TESTING");
121            is($res->code, 404, '... got the expected status');
122            is($res->header('Content-Type'), 'text/plain', '... got the expected Content-Type header');
123            is($res->content, 'Not Found', '... got the expected content');
124        }
125
126        # test loading multiples
127
128        {
129            my $res = $cb->(GET "/WEB_MACHINE_AUTOMATED_TESTING_BULK_FOO");
130            is($res->code, 404, '... got the expected status');
131            is($res->header('Content-Type'), 'text/plain', '... got the expected Content-Type header');
132            is($res->content, 'Not Found', '... got the expected content');
133        }
134
135        {
136            my $res = $cb->(GET "/WEB_MACHINE_AUTOMATED_TESTING_BULK_BAR");
137            is($res->code, 404, '... got the expected status');
138            is($res->header('Content-Type'), 'text/plain', '... got the expected Content-Type header');
139            is($res->content, 'Not Found', '... got the expected content');
140        }
141
142        {
143            my $res = $cb->(PUT "/", (
144                'Content-Type' => 'application/json',
145                'Content' => $JSON->encode({
146                    WEB_MACHINE_AUTOMATED_TESTING_BULK_FOO => 'FOO',
147                    WEB_MACHINE_AUTOMATED_TESTING_BULK_BAR => 'BAR',
148                })
149            ));
150            is($res->code, 204, '... got the expected status');
151            is($res->header('Content-Type'), 'application/json', '... got the expected Content-Type header');
152            is($res->content, '', '... got the expected content');
153        }
154
155        ok(exists $ENV{'WEB_MACHINE_AUTOMATED_TESTING_BULK_FOO'}, '... the variable exists now');
156        is($ENV{'WEB_MACHINE_AUTOMATED_TESTING_BULK_FOO'}, 'FOO', '... the variable has the value we want');
157
158        ok(exists $ENV{'WEB_MACHINE_AUTOMATED_TESTING_BULK_BAR'}, '... the variable exists now');
159        is($ENV{'WEB_MACHINE_AUTOMATED_TESTING_BULK_BAR'}, 'BAR', '... the variable has the value we want');
160
161        {
162            my $res = $cb->(GET "/WEB_MACHINE_AUTOMATED_TESTING_BULK_FOO");
163            is($res->code, 200, '... got the expected status');
164            is($res->header('Content-Type'), 'application/json', '... got the expected Content-Type header');
165            is_deeply(
166                $JSON->decode( $res->content ),
167                "FOO",
168                '... got the expected content'
169            );
170        }
171
172        {
173            my $res = $cb->(GET "/WEB_MACHINE_AUTOMATED_TESTING_BULK_BAR");
174            is($res->code, 200, '... got the expected status');
175            is($res->header('Content-Type'), 'application/json', '... got the expected Content-Type header');
176            is_deeply(
177                $JSON->decode( $res->content ),
178                "BAR",
179                '... got the expected content'
180            );
181        }
182
183        {
184            my $res = $cb->(DELETE "/WEB_MACHINE_AUTOMATED_TESTING_BULK_FOO");
185            is($res->code, 204, '... got the expected status');
186            is($res->header('Content-Type'), 'application/json', '... got the expected Content-Type header');
187            is($res->content, '', '... got the expected content');
188        }
189
190        {
191            my $res = $cb->(DELETE "/WEB_MACHINE_AUTOMATED_TESTING_BULK_BAR");
192            is($res->code, 204, '... got the expected status');
193            is($res->header('Content-Type'), 'application/json', '... got the expected Content-Type header');
194            is($res->content, '', '... got the expected content');
195        }
196
197        {
198            my $res = $cb->(GET "/WEB_MACHINE_AUTOMATED_TESTING_BULK_FOO");
199            is($res->code, 404, '... got the expected status');
200            is($res->header('Content-Type'), 'text/plain', '... got the expected Content-Type header');
201            is($res->content, 'Not Found', '... got the expected content');
202        }
203
204        {
205            my $res = $cb->(GET "/WEB_MACHINE_AUTOMATED_TESTING_BULK_BAR");
206            is($res->code, 404, '... got the expected status');
207            is($res->header('Content-Type'), 'text/plain', '... got the expected Content-Type header');
208            is($res->content, 'Not Found', '... got the expected content');
209        }
210
211        ## check some of the expected errors ...
212
213        {
214            my $res = $cb->(POST "/");
215            is($res->code, 405, '... got the expected status');
216            is($res->header('Allow'), 'GET, HEAD, PUT', '... got the expected Allow header');
217            is($res->content, 'Method Not Allowed', '... got the expected content');
218        }
219
220        {
221            my $res = $cb->(DELETE "/");
222            is($res->code, 405, '... got the expected status');
223            is($res->header('Allow'), 'GET, HEAD, PUT', '... got the expected Allow header');
224            is($res->content, 'Method Not Allowed', '... got the expected content');
225        }
226
227        {
228            my $res = $cb->(POST "/FOO");
229            is($res->code, 405, '... got the expected status');
230            is($res->header('Allow'), 'GET, HEAD, PUT, DELETE', '... got the expected Allow header');
231            is($res->content, 'Method Not Allowed', '... got the expected content');
232        }
233
234        {
235            my $res = $cb->(PUT "/WEB_MACHINE_AUTOMATED_TESTING", (
236                'Content-Type' => 'application/xml', 'Content' => '<FOOBAR/>'
237            ));
238            is($res->code, 415, '... got the expected status');
239            is($res->header('Content-Type'), 'text/plain', '... got the expected Content-Type header');
240            is($res->content, 'Unsupported Media Type', '... got the expected content');
241        }
242
243        {
244            my $res = $cb->(GET "/", 'Accept' => 'text/html');
245            is($res->code, 406, '... got the expected status');
246            is($res->content, 'Not Acceptable', '... got the expected content');
247        }
248
249    };
250
251done_testing;
252