git.maemo.org Git - pkg-perl/blob - deb-src/libwww-perl/libwww-perl-5.813/t/base/common-req.t

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