1use strict;
2use warnings;
3
4use Test::More;
5plan tests => 71;
6
7use File::Spec;
8use File::Temp qw(tempfile);
9use HTTP::Request::Common;
10
11my $r = GET 'http://www.sn.no/';
12note $r->as_string;
13
14is($r->method, "GET");
15is($r->uri, "http://www.sn.no/");
16
17$r = HEAD "http://www.sn.no/",
18     If_Match => 'abc',
19     From => 'aas@sn.no';
20note $r->as_string;
21
22is($r->method, "HEAD");
23ok($r->uri->eq("http://www.sn.no"));
24
25is($r->header('If-Match'), "abc");
26is($r->header("from"), "aas\@sn.no");
27
28$r = HEAD "http://www.sn.no/",
29	Content => 'foo';
30is($r->content, 'foo');
31
32$r = HEAD "http://www.sn.no/",
33	Content => 'foo',
34	'Content-Length' => 50;
35is($r->content, 'foo');
36is($r->content_length, 50);
37
38$r = PUT "http://www.sn.no",
39     Content => 'foo';
40note $r->as_string, "\n";
41
42is($r->method, "PUT");
43is($r->uri->host, "www.sn.no");
44
45ok(!defined($r->header("Content")));
46
47is(${$r->content_ref}, "foo");
48is($r->content, "foo");
49is($r->content_length, 3);
50
51$r = PUT "http://www.sn.no",
52     { foo => "bar" };
53is($r->content, "foo=bar");
54
55$r = OPTIONS "http://www.sn.no",
56     Content => 'foo';
57note $r->as_string, "\n";
58
59is($r->method, "OPTIONS");
60is($r->uri->host, "www.sn.no");
61
62ok(!defined($r->header("Content")));
63
64is(${$r->content_ref}, "foo");
65is($r->content, "foo");
66is($r->content_length, 3);
67
68$r = OPTIONS "http://www.sn.no",
69     { foo => "bar" };
70is($r->content, "foo=bar");
71
72$r = PATCH "http://www.sn.no",
73     { foo => "bar" };
74is($r->content, "foo=bar");
75
76#--- Test POST requests ---
77
78$r = POST "http://www.sn.no", [foo => 'bar;baz',
79                               baz => [qw(a b c)],
80                               foo => 'zoo=&',
81                               "space " => " + ",
82			       "nl" => "a\nb\r\nc\n",
83                              ],
84                              bar => 'foo';
85note $r->as_string, "\n";
86
87is($r->method, "POST");
88is($r->content_type, "application/x-www-form-urlencoded");
89is($r->content_length, 83);
90is($r->header("bar"), "foo");
91is($r->content, "foo=bar%3Bbaz&baz=a&baz=b&baz=c&foo=zoo%3D%26&space+=+%2B+&nl=a%0D%0Ab%0D%0Ac%0D%0A");
92
93$r = POST "http://example.com";
94is($r->content_length, 0);
95is($r->content, "");
96
97$r = POST "http://example.com", [];
98is($r->content_length, 0);
99is($r->content, "");
100
101$r = POST "mailto:gisle\@aas.no",
102     Subject => "Heisan",
103     Content_Type => "text/plain",
104     Content => "Howdy\n";
105#note $r->as_string;
106
107is($r->method, "POST");
108is($r->header("Subject"), "Heisan");
109is($r->content, "Howdy\n");
110is($r->content_type, "text/plain");
111
112{
113    my @warnings;
114    local $SIG{__WARN__} = sub { push @warnings, @_ };
115    $r = POST 'http://unf.ug/', [];
116    is( "@warnings", '', 'empty POST' );
117}
118
119#
120# POST for File upload
121#
122my (undef, $file) = tempfile();
123my $form_file = (File::Spec->splitpath($file))[-1];
124open(FILE, ">$file") or die "Can't create $file: $!";
125print FILE "foo\nbar\nbaz\n";
126close(FILE);
127
128$r = POST 'http://www.perl.org/survey.cgi',
129       Content_Type => 'form-data',
130       Content      => [ name  => 'Gisle Aas',
131                         email => 'gisle@aas.no',
132                         gender => 'm',
133                         born   => '1964',
134                         file   => [$file],
135                       ];
136#note $r->as_string;
137
138unlink($file) or warn "Can't unlink $file: $!";
139
140is($r->method, "POST");
141is($r->uri->path, "/survey.cgi");
142is($r->content_type, "multipart/form-data");
143ok($r->header('Content_type') =~ /boundary="?([^"]+)"?/);
144my $boundary = $1;
145
146my $c = $r->content;
147$c =~ s/\r//g;
148my @c = split(/--\Q$boundary/, $c);
149note "$c[5]\n";
150
151is(@c, 7);
152like($c[6], qr/^--\n/);  # 5 parts + header & trailer
153
154ok($c[2] =~ /^Content-Disposition:\s*form-data;\s*name="email"/m);
155ok($c[2] =~ /^gisle\@aas.no$/m);
156
157ok($c[5] =~ /^Content-Disposition:\s*form-data;\s*name="file";\s*filename="$form_file"/m);
158ok($c[5] =~ /^Content-Type:\s*text\/plain$/m);
159ok($c[5] =~ /^foo\nbar\nbaz/m);
160
161$r = POST 'http://www.perl.org/survey.cgi',
162      [ file => [ undef, "xxy\"", Content_type => "text/html", Content => "<h1>Hello, world!</h1>" ]],
163      Content_type => 'multipart/form-data';
164#note $r->as_string;
165
166ok($r->content =~ /^--\S+\015\012Content-Disposition:\s*form-data;\s*name="file";\s*filename="xxy\\"/m);
167ok($r->content =~ /^Content-Type: text\/html/m);
168ok($r->content =~ /^<h1>Hello, world/m);
169
170$r = POST 'http://www.perl.org/survey.cgi',
171      Content_type => 'multipart/form-data',
172      Content => [ file => [ undef, undef, Content => "foo"]];
173#note $r->as_string;
174
175unlike($r->content, qr/filename=/);
176
177
178# The POST routine can now also take a hash reference.
179my %hash = (foo => 42, bar => 24);
180$r = POST 'http://www.perl.org/survey.cgi', \%hash;
181#note $r->as_string, "\n";
182like($r->content, qr/foo=42/);
183like($r->content, qr/bar=24/);
184is($r->content_type, "application/x-www-form-urlencoded");
185is($r->content_length, 13);
186
187
188#
189# POST for File upload
190#
191use HTTP::Request::Common qw($DYNAMIC_FILE_UPLOAD);
192
193(undef, $file) = tempfile();
194open(FILE, ">$file") or die "Can't create $file: $!";
195for (1..1000) {
196   print FILE "a" .. "z";
197}
198close(FILE);
199
200$DYNAMIC_FILE_UPLOAD++;
201$r = POST 'http://www.perl.org/survey.cgi',
202       Content_Type => 'form-data',
203       Content      => [ name  => 'Gisle Aas',
204                         email => 'gisle@aas.no',
205                         gender => 'm',
206                         born   => '1964',
207                         file   => [$file],
208                       ];
209#note $r->as_string, "\n";
210
211is($r->method, "POST");
212is($r->uri->path, "/survey.cgi");
213is($r->content_type, "multipart/form-data");
214ok($r->header('Content_type') =~ qr/boundary="?([^"]+)"?/);
215$boundary = $1;
216is(ref($r->content), "CODE");
217
218cmp_ok(length($boundary), '>', 10);
219
220my $code = $r->content;
221my $chunk;
222my @chunks;
223while (defined($chunk = &$code) && length $chunk) {
224   push(@chunks, $chunk);
225}
226
227unlink($file) or warn "Can't unlink $file: $!";
228
229$_ = join("", @chunks);
230
231#note int(@chunks), " chunks, total size is ", length($_), " bytes\n";
232
233# should be close to expected size and number of chunks
234cmp_ok(abs(@chunks - 15), '<', 3);
235cmp_ok(abs(length($_) - 26589), '<', 20);
236
237$r = POST 'http://www.example.com';
238is($r->as_string, <<EOT);
239POST http://www.example.com
240Content-Length: 0
241Content-Type: application/x-www-form-urlencoded
242
243EOT
244
245$r = POST 'http://www.example.com', Content_Type => 'form-data', Content => [];
246is($r->as_string, <<EOT);
247POST http://www.example.com
248Content-Length: 0
249Content-Type: multipart/form-data; boundary=none
250
251EOT
252
253$r = POST 'http://www.example.com', Content_Type => 'form-data';
254#note $r->as_string;
255is($r->as_string, <<EOT);
256POST http://www.example.com
257Content-Length: 0
258Content-Type: multipart/form-data
259
260EOT
261
262$r = HTTP::Request::Common::DELETE 'http://www.example.com';
263is($r->method, "DELETE");
264
265$r = HTTP::Request::Common::PUT 'http://www.example.com',
266    'Content-Type' => 'application/octet-steam',
267    'Content' => 'foobarbaz',
268    'Content-Length' => 12;   # a slight lie
269is($r->header('Content-Length'), 9);
270
271$r = HTTP::Request::Common::PATCH 'http://www.example.com',
272    'Content-Type' => 'application/octet-steam',
273    'Content' => 'foobarbaz',
274    'Content-Length' => 12;   # a slight lie
275is($r->header('Content-Length'), 9);
276