X-Git-Url: http://git.maemo.org/git/?p=dh-make-perl;a=blobdiff_plain;f=dev%2Fi386%2Flibwww-perl%2Flibwww-perl-5.813%2Ft%2Fbase%2Fcommon-req.t;fp=dev%2Fi386%2Flibwww-perl%2Flibwww-perl-5.813%2Ft%2Fbase%2Fcommon-req.t;h=5c4ba0dc12937437c95cb9316e3f39fd6bc5d11b;hp=0000000000000000000000000000000000000000;hb=8977e561d8a9eae6959218b0306c9df2056a38a9;hpb=df794b845212301ea0d267c919232538bfef356a

diff --git a/dev/i386/libwww-perl/libwww-perl-5.813/t/base/common-req.t b/dev/i386/libwww-perl/libwww-perl-5.813/t/base/common-req.t
new file mode 100644
index 0000000..5c4ba0d
--- /dev/null
+++ b/dev/i386/libwww-perl/libwww-perl-5.813/t/base/common-req.t
@@ -0,0 +1,225 @@
+print "1..22\n";
+
+use HTTP::Request::Common;
+
+$r = GET 'http://www.sn.no/';
+print $r->as_string;
+
+print "not " unless $r->method eq "GET" and $r->url eq "http://www.sn.no/";
+print "ok 1\n";
+
+$r = HEAD "http://www.sn.no/",
+     If_Match => 'abc',
+     From => 'aas@sn.no';
+print $r->as_string;
+
+print "not " unless $r->method eq "HEAD" and $r->url->eq("http://www.sn.no");
+print "ok 2\n";
+
+print "not " unless $r->header('If-Match') eq "abc" and $r->header("from") eq "aas\@sn.no";
+print "ok 3\n";
+
+$r = PUT "http://www.sn.no",
+     Content => 'foo';
+print $r->as_string, "\n";
+
+print "not " unless $r->method eq "PUT" and $r->uri->host eq "www.sn.no";
+print "ok 4\n";
+
+print "not " if defined($r->header("Content"));
+print "ok 5\n";
+
+print "not " unless ${$r->content_ref} eq "foo" and
+                    $r->content eq "foo" and $r->content_length == 3;
+print "ok 6\n";
+
+#--- Test POST requests ---
+
+$r = POST "http://www.sn.no", [foo => 'bar;baz',
+                               baz => [qw(a b c)],
+                               foo => 'zoo=&',
+                               "space " => " + ",
+                              ],
+                              bar => 'foo';
+print $r->as_string, "\n";
+
+print "not " unless $r->method eq "POST" and
+                    $r->content_type eq "application/x-www-form-urlencoded" and
+                    $r->content_length == 58 and
+                    $r->header("bar") eq "foo";
+print "ok 7\n";
+
+print "not " unless $r->content eq "foo=bar%3Bbaz&baz=a&baz=b&baz=c&foo=zoo%3D%26&space+=+%2B+";
+print "ok 8\n";
+
+$r = POST "mailto:gisle\@aas.no",
+     Subject => "Heisan",
+     Content_Type => "text/plain",
+     Content => "Howdy\n";
+print $r->as_string;
+
+print "not " unless $r->method eq "POST" and
+                    $r->header("Subject") eq "Heisan" and
+                    $r->content eq "Howdy\n" and
+	            $r->content_type eq "text/plain";
+print "ok 9\n";
+
+#
+# POST for File upload
+#
+$file = "test-$$";
+open(FILE, ">$file") or die "Can't create $file: $!";
+print FILE "foo\nbar\nbaz\n";
+close(FILE);
+
+$r = POST 'http://www.perl.org/survey.cgi',
+       Content_Type => 'form-data',
+       Content      => [ name  => 'Gisle Aas',
+                         email => 'gisle@aas.no',
+                         gender => 'm',
+                         born   => '1964',
+                         file   => [$file],
+                       ];
+print $r->as_string;
+
+unlink($file) or warn "Can't unlink $file: $!";
+
+print "not " unless $r->method eq "POST" and
+	            $r->url->path eq "/survey.cgi" and
+                    $r->content_type eq "multipart/form-data" and
+	            $r->header(Content_type) =~ /boundary="?([^"]+)"?/;
+print "ok 10\n";
+$boundary = $1;
+
+$c = $r->content;
+$c =~ s/\r//g;
+@c = split(/--\Q$boundary/, $c);
+print "$c[5]\n";
+
+print "not " unless @c == 7 and $c[6] =~ /^--\n/;  # 5 parts + header & trailer
+print "ok 11\n";
+
+print "not " unless $c[2] =~ /^Content-Disposition:\s*form-data;\s*name="email"/m and
+                    $c[2] =~ /^gisle\@aas.no$/m;
+print "ok 12\n";
+
+print "not " unless $c[5] =~ /^Content-Disposition:\s*form-data;\s*name="file";\s*filename="$file"/m and
+	            $c[5] =~ /^Content-Type:\s*text\/plain$/m and
+	            $c[5] =~ /^foo\nbar\nbaz/m;
+print "ok 13\n";
+
+$r = POST 'http://www.perl.org/survey.cgi',
+      [ file => [ undef, "xxy\"", Content_type => "text/html", Content => "<h1>Hello, world!</h1>" ]],
+      Content_type => 'multipart/form-data';
+print $r->as_string;
+
+if($^O eq "MacOS") {
+    print "not " unless $r->content =~ /^--\S+\015\012Content-Disposition:\s*form-data;\s*name="file";\s*filename="xxy\\"/m and
+		        $r->content =~ /^\012Content-Type: text\/html/m and
+	        	$r->content =~ /^\012<h1>Hello, world/m;
+}
+else {
+    print "not " unless $r->content =~ /^--\S+\015\012Content-Disposition:\s*form-data;\s*name="file";\s*filename="xxy\\"/m and
+	                $r->content =~ /^Content-Type: text\/html/m and
+	                $r->content =~ /^<h1>Hello, world/m;
+}
+print "ok 14\n";
+
+
+$r = POST 'http://www.perl.org/survey.cgi',
+      Content_type => 'multipart/form-data',
+      Content => [ file => [ undef, undef, Content => "foo"]];
+print $r->as_string;
+
+print "not " if $r->content =~ /filename=/;
+print "ok 15\n";
+
+
+# The POST routine can now also take a hash reference.
+my %hash = (foo => 42, bar => 24);
+$r = POST 'http://www.perl.org/survey.cgi', \%hash;
+print $r->as_string, "\n";
+print "not " unless $r->content =~ /foo=42/ &&
+                    $r->content =~ /bar=24/ &&
+                    $r->content_type eq "application/x-www-form-urlencoded" &&
+                    $r->content_length == 13;
+print "ok 16\n";
+
+ 
+#
+# POST for File upload
+#
+use HTTP::Request::Common qw($DYNAMIC_FILE_UPLOAD);
+
+$file = "test-$$";
+open(FILE, ">$file") or die "Can't create $file: $!";
+for (1..1000) {
+   print FILE "a" .. "z";
+}
+close(FILE);
+
+$DYNAMIC_FILE_UPLOAD++;
+$r = POST 'http://www.perl.org/survey.cgi',
+       Content_Type => 'form-data',
+       Content      => [ name  => 'Gisle Aas',
+                         email => 'gisle@aas.no',
+                         gender => 'm',
+                         born   => '1964',
+                         file   => [$file],
+                       ];
+print $r->as_string, "\n";
+
+print "not " unless $r->method eq "POST" and
+	            $r->url->path eq "/survey.cgi" and
+                    $r->content_type eq "multipart/form-data" and
+	            $r->header(Content_type) =~ /boundary="?([^"]+)"?/ and
+		    ref($r->content) eq "CODE";
+print "ok 17\n";
+$boundary = $1;
+
+print "not " unless length($boundary) > 10;
+print "ok 18\n";
+
+$code = $r->content;
+my $chunk;
+my @chunks;
+while (defined($chunk = &$code) && length $chunk) {
+   push(@chunks, $chunk);
+}
+
+unlink($file) or warn "Can't unlink $file: $!";
+
+$_ = join("", @chunks);
+
+print int(@chunks), " chunks, total size is ", length($_), " bytes\n";
+
+# should be close to expected size and number of chunks
+print "not " unless abs(@chunks - 15 < 3) and
+                    abs(length($_) - 26589) < 20;
+print "ok 19\n";
+
+$r = POST 'http://www.example.com';
+print "not " unless $r->as_string eq <<EOT; print "ok 20\n";
+POST http://www.example.com
+Content-Length: 0
+Content-Type: application/x-www-form-urlencoded
+
+EOT
+
+$r = POST 'http://www.example.com', Content_Type => 'form-data', Content => [];
+print "not " unless $r->as_string eq <<EOT; print "ok 21\n";
+POST http://www.example.com
+Content-Length: 0
+Content-Type: multipart/form-data; boundary=none
+
+EOT
+
+$r = POST 'http://www.example.com', Content_Type => 'form-data';
+#print $r->as_string;
+print "not " unless $r->as_string eq <<EOT; print "ok 22\n";
+POST http://www.example.com
+Content-Length: 0
+Content-Type: multipart/form-data
+
+EOT
+