git.maemo.org Git - dh-make-perl/blob - dev/arm/libwww-perl/libwww-perl-5.813/t/base/message.t

   1 #!perl -w
   2
   3 use strict;
   4 use Test qw(plan ok skip);
   5
   6 plan tests => 102;
   7
   8 require HTTP::Message;
   9 use Config qw(%Config);
  10
  11 my($m, $m2, @parts);
  12
  13 $m = HTTP::Message->new;
  14 ok($m);
  15 ok(ref($m), "HTTP::Message");
  16 ok(ref($m->headers), "HTTP::Headers");
  17 ok($m->as_string, "\n");
  18 ok($m->headers->as_string, "");
  19 ok($m->headers_as_string, "");
  20 ok($m->content, "");
  21
  22 $m->header("Foo", 1);
  23 ok($m->as_string, "Foo: 1\n\n");
  24
  25 $m2 = HTTP::Message->new($m->headers);
  26 $m2->header(bar => 2);
  27 ok($m->as_string, "Foo: 1\n\n");
  28 ok($m2->as_string, "Bar: 2\nFoo: 1\n\n");
  29
  30 $m2 = HTTP::Message->new($m->headers, "foo");
  31 ok($m2->as_string, "Foo: 1\n\nfoo\n");
  32 ok($m2->as_string("<<\n"), "Foo: 1<<\n<<\nfoo");
  33 $m2 = HTTP::Message->new($m->headers, "foo\n");
  34 ok($m2->as_string, "Foo: 1\n\nfoo\n");
  35
  36 $m = HTTP::Message->new([a => 1, b => 2], "abc");
  37 ok($m->as_string, "A: 1\nB: 2\n\nabc\n");
  38
  39 $m = HTTP::Message->parse("");
  40 ok($m->as_string, "\n");
  41 $m = HTTP::Message->parse("\n");
  42 ok($m->as_string, "\n");
  43 $m = HTTP::Message->parse("\n\n");
  44 ok($m->as_string, "\n\n");
  45 ok($m->content, "\n");
  46
  47 $m = HTTP::Message->parse("foo");
  48 ok($m->as_string, "\nfoo\n");
  49 $m = HTTP::Message->parse("foo: 1");
  50 ok($m->as_string, "Foo: 1\n\n");
  51 $m = HTTP::Message->parse("foo: 1\n\nfoo");
  52 ok($m->as_string, "Foo: 1\n\nfoo\n");
  53 $m = HTTP::Message->parse(<<EOT);
  54 FOO : 1
  55  2
  56   3
  57    4
  58 bar:
  59  1
  60 Baz: 1
  61
  62 foobarbaz
  63 EOT
  64 ok($m->as_string, <<EOT);
  65 Bar:
  66  1
  67 Baz: 1
  68 Foo: 1
  69  2
  70   3
  71    4
  72
  73 foobarbaz
  74 EOT
  75
  76 $m = HTTP::Message->parse(<<EOT);
  77 Date: Fri, 18 Feb 2005 18:33:46 GMT
  78 Connection: close
  79 Content-Type: text/plain
  80
  81 foo:bar
  82 second line
  83 EOT
  84 ok($m->content(""), <<EOT);
  85 foo:bar
  86 second line
  87 EOT
  88 ok($m->as_string, <<EOT);
  89 Connection: close
  90 Date: Fri, 18 Feb 2005 18:33:46 GMT
  91 Content-Type: text/plain
  92
  93 EOT
  94
  95 $m = HTTP::Message->parse("  abc\nfoo: 1\n");
  96 ok($m->as_string, "\n  abc\nfoo: 1\n");
  97 $m = HTTP::Message->parse(" foo : 1\n");
  98 ok($m->as_string, "\n foo : 1\n");
  99 $m = HTTP::Message->parse("\nfoo: bar\n");
 100 ok($m->as_string, "\nfoo: bar\n");
 101
 102 $m = HTTP::Message->new([a => 1, b => 2], "abc");
 103 ok($m->content("foo\n"), "abc");
 104 ok($m->content, "foo\n");
 105
 106 $m->add_content("bar");
 107 ok($m->content, "foo\nbar");
 108 $m->add_content(\"\n");
 109 ok($m->content, "foo\nbar\n");
 110
 111 ok(ref($m->content_ref), "SCALAR");
 112 ok(${$m->content_ref}, "foo\nbar\n");
 113 ${$m->content_ref} =~ s/[ao]/i/g;
 114 ok($m->content, "fii\nbir\n");
 115
 116 $m->clear;
 117 ok($m->headers->header_field_names, 0);
 118 ok($m->content, "");
 119
 120 ok($m->parts, undef);
 121 $m->parts(HTTP::Message->new,
 122           HTTP::Message->new([a => 1], "foo"),
 123           HTTP::Message->new(undef, "bar\n"),
 124          );
 125 ok($m->parts->as_string, "\n");
 126
 127 my $str = $m->as_string;
 128 $str =~ s/\r/<CR>/g;
 129 ok($str, <<EOT);
 130 Content-Type: multipart/mixed; boundary=xYzZY
 131
 132 --xYzZY<CR>
 133 <CR>
 134 <CR>
 135 --xYzZY<CR>
 136 A: 1<CR>
 137 <CR>
 138 foo<CR>
 139 --xYzZY<CR>
 140 <CR>
 141 bar
 142 <CR>
 143 --xYzZY--<CR>
 144 EOT
 145
 146 $m2 = HTTP::Message->new;
 147 $m2->parts($m);
 148
 149 $str = $m2->as_string;
 150 $str =~ s/\r/<CR>/g;
 151 ok($str =~ /boundary=(\S+)/);
 152
 153
 154 ok($str, <<EOT);
 155 Content-Type: multipart/mixed; boundary=$1
 156
 157 --$1<CR>
 158 Content-Type: multipart/mixed; boundary=xYzZY<CR>
 159 <CR>
 160 --xYzZY<CR>
 161 <CR>
 162 <CR>
 163 --xYzZY<CR>
 164 A: 1<CR>
 165 <CR>
 166 foo<CR>
 167 --xYzZY<CR>
 168 <CR>
 169 bar
 170 <CR>
 171 --xYzZY--<CR>
 172 <CR>
 173 --$1--<CR>
 174 EOT
 175
 176 @parts = $m2->parts;
 177 ok(@parts, 1);
 178
 179 @parts = $parts[0]->parts;
 180 ok(@parts, 3);
 181 ok($parts[1]->header("A"), 1);
 182
 183 $m2->parts([HTTP::Message->new]);
 184 @parts = $m2->parts;
 185 ok(@parts, 1);
 186
 187 $m2->parts([]);
 188 @parts = $m2->parts;
 189 ok(@parts, 0);
 190
 191 $m->clear;
 192 $m2->clear;
 193
 194 $m = HTTP::Message->new([content_type => "message/http; boundary=aaa",
 195                         ],
 196                         <<EOT);
 197 GET / HTTP/1.1
 198 Host: www.example.com:8008
 199
 200 EOT
 201
 202 @parts = $m->parts;
 203 ok(@parts, 1);
 204 $m2 = $parts[0];
 205 ok(ref($m2), "HTTP::Request");
 206 ok($m2->method, "GET");
 207 ok($m2->uri, "/");
 208 ok($m2->protocol, "HTTP/1.1");
 209 ok($m2->header("Host"), "www.example.com:8008");
 210 ok($m2->content, "");
 211
 212 $m->content(<<EOT);
 213 HTTP/1.0 200 OK
 214 Content-Type: text/plain
 215
 216 Hello
 217 EOT
 218
 219 $m2 = $m->parts;
 220 ok(ref($m2), "HTTP::Response");
 221 ok($m2->protocol, "HTTP/1.0");
 222 ok($m2->code, "200");
 223 ok($m2->message, "OK");
 224 ok($m2->content_type, "text/plain");
 225 ok($m2->content, "Hello\n");
 226
 227 eval { $m->parts(HTTP::Message->new, HTTP::Message->new) };
 228 ok($@);
 229
 230 $m->add_part(HTTP::Message->new([a=>[1..3]], "a"));
 231 $str = $m->as_string;
 232 $str =~ s/\r/<CR>/g;
 233 ok($str, <<EOT);
 234 Content-Type: multipart/mixed; boundary=xYzZY
 235
 236 --xYzZY<CR>
 237 Content-Type: message/http; boundary=aaa<CR>
 238 <CR>
 239 HTTP/1.0 200 OK
 240 Content-Type: text/plain
 241
 242 Hello
 243 <CR>
 244 --xYzZY<CR>
 245 A: 1<CR>
 246 A: 2<CR>
 247 A: 3<CR>
 248 <CR>
 249 a<CR>
 250 --xYzZY--<CR>
 251 EOT
 252
 253 $m->add_part(HTTP::Message->new([b=>[1..3]], "b"));
 254
 255 $str = $m->as_string;
 256 $str =~ s/\r/<CR>/g;
 257 ok($str, <<EOT);
 258 Content-Type: multipart/mixed; boundary=xYzZY
 259
 260 --xYzZY<CR>
 261 Content-Type: message/http; boundary=aaa<CR>
 262 <CR>
 263 HTTP/1.0 200 OK
 264 Content-Type: text/plain
 265
 266 Hello
 267 <CR>
 268 --xYzZY<CR>
 269 A: 1<CR>
 270 A: 2<CR>
 271 A: 3<CR>
 272 <CR>
 273 a<CR>
 274 --xYzZY<CR>
 275 B: 1<CR>
 276 B: 2<CR>
 277 B: 3<CR>
 278 <CR>
 279 b<CR>
 280 --xYzZY--<CR>
 281 EOT
 282
 283 $m = HTTP::Message->new;
 284 $m->content_ref(\my $foo);
 285 ok($m->content_ref, \$foo);
 286 $foo = "foo";
 287 ok($m->content, "foo");
 288 $m->add_content("bar");
 289 ok($foo, "foobar");
 290 ok($m->as_string, "\nfoobar\n");
 291 $m->content_type("message/foo");
 292 $m->parts(HTTP::Message->new(["h", "v"], "C"));
 293 ok($foo, "H: v\r\n\r\nC");
 294 $foo =~ s/C/c/;
 295 $m2 = $m->parts;
 296 ok($m2->content, "c");
 297
 298 $m = HTTP::Message->new;
 299 $foo = [];
 300 $m->content($foo);
 301 ok($m->content, $foo);
 302 ok(${$m->content_ref}, $foo);
 303 ok(${$m->content_ref([])}, $foo);
 304 ok($m->content_ref != $foo);
 305 eval {$m->add_content("x")};
 306 ok($@ && $@ =~ /^Can't append to ARRAY content/);
 307
 308 $foo = sub { "foo" };
 309 $m->content($foo);
 310 ok($m->content, $foo);
 311 ok(${$m->content_ref}, $foo);
 312
 313 $m->content_ref($foo);
 314 ok($m->content, $foo);
 315 ok($m->content_ref, $foo);
 316
 317 eval {$m->content_ref("foo")};
 318 ok($@ && $@ =~ /^Setting content_ref to a non-ref/);
 319
 320 $m->content_ref(\"foo");
 321 eval {$m->content("bar")};
 322 ok($@ && $@ =~ /^Modification of a read-only value/);
 323
 324 $foo = "foo";
 325 $m->content_ref(\$foo);
 326 ok($m->content("bar"), "foo");
 327 ok($foo, "bar");
 328 ok($m->content, "bar");
 329 ok($m->content_ref, \$foo);
 330
 331 $m = HTTP::Message->new;
 332 $m->content("fo=6F");
 333 ok($m->decoded_content, "fo=6F");
 334 $m->header("Content-Encoding", "quoted-printable");
 335 ok($m->decoded_content, "foo");
 336
 337 $m = HTTP::Message->new;
 338 $m->header("Content-Encoding", "gzip, base64");
 339 $m->content_type("text/plain; charset=UTF-8");
 340 $m->content("H4sICFWAq0ECA3h4eAB7v3u/R6ZCSUZqUarCoxm7uAAZKHXiEAAAAA==\n");
 341
 342 my $NO_ENCODE = $] < 5.008 || ($Config{'extensions'} !~ /\bEncode\b/)
 343     ? "No Encode module" : "";
 344 $@ = "";
 345 skip($NO_ENCODE, sub { eval { $m->decoded_content } }, "\x{FEFF}Hi there \x{263A}\n");
 346 ok($@ || "", "");
 347 ok($m->content, "H4sICFWAq0ECA3h4eAB7v3u/R6ZCSUZqUarCoxm7uAAZKHXiEAAAAA==\n");
 348
 349 my $tmp = MIME::Base64::decode($m->content);
 350 $m->content($tmp);
 351 $m->header("Content-Encoding", "gzip");
 352 $@ = "";
 353 skip($NO_ENCODE, sub { eval { $m->decoded_content } }, "\x{FEFF}Hi there \x{263A}\n");
 354 ok($@ || "", "");
 355 ok($m->content, $tmp);
 356
 357 $m->remove_header("Content-Encoding");
 358 $m->content("a\xFF");
 359
 360 skip($NO_ENCODE, sub { $m->decoded_content }, "a\x{FFFD}");
 361 skip($NO_ENCODE, sub { $m->decoded_content(charset_strict => 1) }, undef);
 362
 363 $m->header("Content-Encoding", "foobar");
 364 ok($m->decoded_content, undef);
 365 ok($@ =~ /^Don't know how to decode Content-Encoding 'foobar'/);
 366
 367 my $err = 0;
 368 eval {
 369     $m->decoded_content(raise_error => 1);
 370     $err++;
 371 };
 372 ok($@ =~ /Don't know how to decode Content-Encoding 'foobar'/);
 373 ok($err, 0);
 374
 375 if ($] >= 5.008001) {
 376     eval {
 377         HTTP::Message->new([], "\x{263A}");
 378     };
 379     ok($@ =~ /bytes/);
 380     $m = HTTP::Message->new;
 381     eval {
 382         $m->add_content("\x{263A}");
 383     };
 384     ok($@ =~ /bytes/);
 385     eval {
 386         $m->content("\x{263A}");
 387     };
 388     ok($@ =~ /bytes/);
 389 }
 390 else {
 391     skip("Missing is_utf8 test", undef) for 1..3;
 392 }
 393
 394 # test the add_content_utf8 method
 395 if ($] >= 5.008001) {
 396     $m = HTTP::Message->new(["Content-Type", "text/plain; charset=UTF-8"]);
 397     $m->add_content_utf8("\x{263A}");
 398     $m->add_content_utf8("-\xC5");
 399     ok($m->content, "\xE2\x98\xBA-\xC3\x85");
 400     ok($m->decoded_content, "\x{263A}-\x{00C5}");
 401 }
 402 else {
 403     skip("Missing is_utf8 test", undef) for 1..2;
 404 }