Commit | Line | Data |
ca38286c |
1 | #!perl |
2 | |
292e2b64 |
3 | use Test::More tests => 16; |
ca38286c |
4 | |
5 | use strict; |
6 | use warnings; |
7 | |
8 | use IO::File; |
9 | use HTTP::Request; |
10 | use HTTP::Request::AsCGI; |
11 | |
12 | my $response; |
13 | |
14 | { |
15 | my $r = HTTP::Request->new( GET => 'http://www.host.com/' ); |
b332ee65 |
16 | my $c = HTTP::Request::AsCGI->new($r); |
ca38286c |
17 | |
18 | $c->setup; |
292e2b64 |
19 | |
ca38286c |
20 | print "Content-Type: text/plain\n"; |
4e0afe7d |
21 | print "Status: 200 Yay\n"; |
22 | print "Date: Thu, 19 Jan 2006 14:08:18 GMT\n"; |
ca38286c |
23 | print "X-Field: 1\n"; |
24 | print "X-Field: 2\n"; |
25 | print "\n"; |
26 | print "Hello!"; |
27 | |
28 | $response = $c->restore->response; |
29 | } |
30 | |
31 | isa_ok( $response, 'HTTP::Response' ); |
32 | is( $response->code, 200, 'Response Code' ); |
4e0afe7d |
33 | is( $response->message, 'Yay', 'Response Message' ); |
34 | is( $response->protocol, 'HTTP/1.1', 'Response Protocol' ); |
ca38286c |
35 | is( $response->content, 'Hello!', 'Response Content' ); |
36 | is( $response->content_length, 6, 'Response Content-Length' ); |
37 | is( $response->content_type, 'text/plain', 'Response Content-Type' ); |
4e0afe7d |
38 | is( $response->header('Date'), 'Thu, 19 Jan 2006 14:08:18 GMT', 'Response Date' ); |
ca38286c |
39 | is_deeply( [ $response->header('X-Field') ], [ 1, 2 ], 'Response Header X-Field' ); |
292e2b64 |
40 | |
41 | |
42 | # test with a crappy cgi that doesn't actually print any headers. actually works |
43 | { |
44 | my $r = HTTP::Request->new( GET => 'http://www.host.com/' ); |
45 | my $c = HTTP::Request::AsCGI->new($r); |
46 | |
47 | $c->setup; |
48 | |
49 | print "Look at me I am crappy and don't have any headers."; |
50 | |
51 | $response = $c->restore->response; |
52 | } |
53 | |
54 | isa_ok( $response, 'HTTP::Response' ); |
55 | is( $response->code, 200, 'Response Code' ); |
56 | is( $response->message, 'OK', 'Response Message' ); |
57 | is( $response->protocol, 'HTTP/1.1', 'Response Protocol' ); |
58 | is( $response->content, "Look at me I am crappy and don't have any headers.", 'Response Content' ); |
59 | is( $response->content_length, 50, 'Response Content-Length is right!' ); |
60 | is( $response->content_type, '', 'Response Content-Type is blank' ); |