1use strict;
2use warnings;
3use Test::More tests => 47;
4use Plack::Test;
5use Plack::Builder;
6use Plack::Util;
7use HTTP::Request::Common;
8
9test_psgi app => builder {
10    enable 'FixMissingBodyInRedirect';
11
12    mount '/empty_array' => sub {
13        [302,
14         [ "Location" => '/xyz',
15           ],
16         []];
17    };
18
19    mount '/empty_string' => sub {
20        [302,
21         [ "Location" => '/xyz',
22           ],
23         ['']];
24    };
25
26    mount '/array_with_one_undef' => sub {
27        [302,
28         [ "Location" => '/xyz',
29           ],
30           [undef]];
31    };
32
33    mount '/first_undef_rest_def' => sub {
34        [302,
35         [ "Location" => '/xyz',
36           "Content-Type" => 'text/html; charset=utf-8'],
37         [undef, "<html><body>Only first element was undef</body></html>"]];
38    };
39
40    mount '/already_set_body' => sub {
41        [302,
42         [ "Location" => '/xyz',
43           "Content-Type" => 'text/html; charset=utf-8'],
44         ["<html><body>Body is set</body></html>"]];
45    };
46
47    mount '/body_with_size_zero_file_handle' => sub {
48        open(my $fh, ">", "output.txt")
49            or die "cannot open > output.txt: $!";
50        close $fh;
51        open $fh, "<", "output.txt";
52        [302,
53         [ "Location" => '/xyz',
54           "Content-Type" => 'text/html; charset=utf-8'],
55         $fh];
56    };
57
58    mount '/body_with_good_file_handle' => sub {
59        open(my $fh, ">", "output.txt")
60            or die "cannot open > output.txt: $!";
61        my $text = "<html><body>I'm file's text</body></html>";
62        print $fh $text;
63        close $fh;
64        open $fh, "<", "output.txt";
65        [302,
66         [ "Location" => '/xyz',
67           "Content-Type" => 'text/html; charset=utf-8'],
68         $fh];
69    };
70
71    mount '/zeros_only' => sub {
72        [302,
73         [ "Location" => '/xyz',
74           "Content-Type" => 'text/html; charset=utf-8'],
75         [0000]];
76    };
77
78    mount '/empty_strings_body' => sub {
79        [302,
80         [ "Location" => '/xyz',
81           "Content-Type" => 'text/html; charset=utf-8'],
82         ['', '', '', '' ]];
83    };
84
85    # Case when one has a custom filehandle like object that does ->getline
86    mount '/filehandle_like' => sub {
87        [302,
88         [ "Location" => '/xyz',
89           "Content-Type" => 'text/html; charset=utf-8'],
90         ,do {
91            my @lines = ( "aaa\n", "bbb\n");
92            Plack::Util::inline_object(getline => sub { shift @lines }, close => sub {});
93         }];
94    };
95
96    # test for delayed style response
97    mount '/delayed_tuple' => sub {
98      my $env = shift;
99      return sub { shift->(
100          [302,
101            ['Location' => '/xyz',"Content-Type" => 'text/html; charset=utf-8'],
102              ['aaabbbccc']]) };
103    };
104
105    # test for delayed write
106    mount '/delayed_write' => sub {
107      my $env = shift;
108      return sub {
109        my $responder = shift;
110        my $writer = $responder->(
111          [302, ['Location' => '/xyz',"Content-Type" => 'text/html; charset=utf-8']]);
112        $writer->write('aaabbbccc');
113        $writer->close;
114      }
115    };
116
117    mount '/delayed_nowrite' => sub {
118      my $env = shift;
119      return sub {
120        my $responder = shift;
121        my $writer = $responder->(
122          [302, ['Location' => '/xyz']]);
123        $writer->close;
124      }
125    };
126
127    mount '/filehandle_like_empty' => sub {
128        [302,
129         [ "Location" => '/xyz' ],
130         ,do {
131            my @lines = ();
132            Plack::Util::inline_object(getline => sub { shift @lines }, close => sub {});
133         }];
134    };
135},
136client => sub {
137    my $cb = shift;
138
139    my @responses = (
140        [ '/empty_array',
141          qr/<body>/,
142          302,
143          'text/html; charset=utf-8' ],
144        [ '/empty_string',
145          qr/<body>/,
146          302,
147          'text/html; charset=utf-8' ],
148        [ '/array_with_one_undef',
149          qr/<body>/,
150          302,
151          'text/html; charset=utf-8' ],
152        [ '/first_undef_rest_def',
153          qr!<body>Only first element was undef</body>!,
154          302,
155          'text/html; charset=utf-8' ],
156        [ '/already_set_body',
157          qr!<html><body>Body is set</body></html>!,
158          302,
159          'text/html; charset=utf-8' ],
160        [ '/body_with_size_zero_file_handle',
161          qr!<body>!,
162          302,
163          'text/html; charset=utf-8' ],
164        [ '/body_with_good_file_handle',
165          qr!<html><body>I'm file's text</body></html>!,
166          302,
167          'text/html; charset=utf-8' ],
168        [ '/zeros_only',
169          qr!^0!,
170          302,
171          'text/html; charset=utf-8' ],
172        [ '/empty_strings_body',
173          qr/<body>/,
174          302,
175          'text/html; charset=utf-8' ],
176        [ '/filehandle_like',
177          qr!aaa\nbbb\n!,
178          302,
179          'text/html; charset=utf-8' ],
180        [ '/delayed_tuple',
181          qr!aaabbbccc!,
182          302,
183          'text/html; charset=utf-8' ],
184        [ '/delayed_write',
185          qr!aaabbbccc!,
186          302,
187          'text/html; charset=utf-8' ],
188        [ '/delayed_nowrite',
189          qr/<body>/,
190          302,
191          'text/html; charset=utf-8' ],
192        [ '/filehandle_like_empty',
193          qr/<body>/,
194          302,
195          'text/html; charset=utf-8' ],
196    );
197
198    foreach my $response ( @responses ) {
199        my @response_array = @$response;
200        my $route          = $response_array[0],
201        my $content        = $response_array[1];
202        my $response_code  = $response_array[2];
203        my $content_type   = $response_array[3];
204        my $res            = $cb->(GET $route);
205
206        like( $res->content,
207              $content,
208              "Content for $route matches $content");
209
210        is( $res->code,
211            $response_code,
212            "Response code for $route is $response_code" );
213
214        is( $res->header('Content-Type'),
215            $content_type,
216            "Content-Type for $route is $content_type");
217
218        next if !defined $res->header('Content-Length');
219        my $content_length = length( $res->content );
220        is( $res->header('Content-Length'),
221            $content_length,
222            "Content-Length for $route is correct (${content_length})");
223    }
224};
225
226unlink "output.txt";
227