| 1 | use Test::Base; |
|---|
| 2 | use IO::Scalar; |
|---|
| 3 | use HTTP::Engine::ResponseWriter; |
|---|
| 4 | use HTTP::Engine::Response; |
|---|
| 5 | use HTTP::Engine::Request; |
|---|
| 6 | use HTTP::Response; |
|---|
| 7 | use File::Temp qw/:seekable/; |
|---|
| 8 | |
|---|
| 9 | plan skip_all => 'File::Temp 0.20 required for this test' unless $File::Temp::VERSION >= 0.20; |
|---|
| 10 | |
|---|
| 11 | plan tests => 1*blocks; |
|---|
| 12 | |
|---|
| 13 | filters { |
|---|
| 14 | input => [qw/eval/], |
|---|
| 15 | expected => [qw/chomp crlf/], |
|---|
| 16 | }; |
|---|
| 17 | |
|---|
| 18 | run_is input => 'expected'; |
|---|
| 19 | |
|---|
| 20 | sub crlf { |
|---|
| 21 | my $x = shift; |
|---|
| 22 | $x =~ s/\n/\r\n/g; |
|---|
| 23 | $x; |
|---|
| 24 | } |
|---|
| 25 | |
|---|
| 26 | __END__ |
|---|
| 27 | |
|---|
| 28 | === |
|---|
| 29 | --- input |
|---|
| 30 | my $writer = HTTP::Engine::ResponseWriter->new( |
|---|
| 31 | should_write_response_line => 1, |
|---|
| 32 | ); |
|---|
| 33 | |
|---|
| 34 | my $tmp = File::Temp->new(); |
|---|
| 35 | $tmp->write("OK!"); |
|---|
| 36 | $tmp->flush(); |
|---|
| 37 | $tmp->seek(0, File::Temp::SEEK_SET); |
|---|
| 38 | |
|---|
| 39 | tie *STDOUT, 'IO::Scalar', \my $out; |
|---|
| 40 | |
|---|
| 41 | my $req = HTTP::Engine::Request->new( |
|---|
| 42 | protocol => 'HTTP/1.1', |
|---|
| 43 | method => 'GET', |
|---|
| 44 | ); |
|---|
| 45 | my $res = HTTP::Engine::Response->new(body => $tmp, status => 200); |
|---|
| 46 | HTTP::Engine::ResponseFinalizer->finalize( $req, $res ); |
|---|
| 47 | $writer->finalize($req, $res); |
|---|
| 48 | |
|---|
| 49 | untie *STDOUT; |
|---|
| 50 | |
|---|
| 51 | $out; |
|---|
| 52 | --- expected |
|---|
| 53 | HTTP/1.1 200 OK |
|---|
| 54 | Connection: close |
|---|
| 55 | Content-Length: 3 |
|---|
| 56 | Content-Type: text/html |
|---|
| 57 | Status: 200 |
|---|
| 58 | |
|---|
| 59 | OK! |
|---|
| 60 | |
|---|
| 61 | === |
|---|
| 62 | --- input |
|---|
| 63 | my $writer = HTTP::Engine::ResponseWriter->new( |
|---|
| 64 | should_write_response_line => 1, |
|---|
| 65 | ); |
|---|
| 66 | |
|---|
| 67 | tie *STDOUT, 'IO::Scalar', \my $out; |
|---|
| 68 | |
|---|
| 69 | my $req = HTTP::Engine::Request->new( |
|---|
| 70 | protocol => 'HTTP/1.1', |
|---|
| 71 | method => 'GET', |
|---|
| 72 | ); |
|---|
| 73 | my $res = HTTP::Engine::Response->new(body => 'OK!', status => 200); |
|---|
| 74 | $res->header( Connection => 'keepalive' ); |
|---|
| 75 | HTTP::Engine::ResponseFinalizer->finalize( $req, $res ); |
|---|
| 76 | $writer->finalize($req, $res); |
|---|
| 77 | |
|---|
| 78 | untie *STDOUT; |
|---|
| 79 | |
|---|
| 80 | $out; |
|---|
| 81 | --- expected |
|---|
| 82 | HTTP/1.1 200 OK |
|---|
| 83 | Connection: keepalive |
|---|
| 84 | Content-Length: 3 |
|---|
| 85 | Content-Type: text/html |
|---|
| 86 | Status: 200 |
|---|
| 87 | |
|---|
| 88 | OK! |
|---|