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