t/base/message.t

   1 #!perl -w
   2
   3 use strict;
   4 use Test qw(plan ok skip);
   5
   6 plan tests => 118;
   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 ok($m2->dump, "Bar: 2\nFoo: 1\n\n(no content)\n");
  30
  31 $m2 = HTTP::Message->new($m->headers, "foo");
  32 ok($m2->as_string, "Foo: 1\n\nfoo\n");
  33 ok($m2->as_string("<<\n"), "Foo: 1<<\n<<\nfoo");
  34 $m2 = HTTP::Message->new($m->headers, "foo\n");
  35 ok($m2->as_string, "Foo: 1\n\nfoo\n");
  36
  37 $m = HTTP::Message->new([a => 1, b => 2], "abc");
  38 ok($m->as_string, "A: 1\nB: 2\n\nabc\n");
  39
  40 $m = HTTP::Message->parse("");
  41 ok($m->as_string, "\n");
  42 $m = HTTP::Message->parse("\n");
  43 ok($m->as_string, "\n");
  44 $m = HTTP::Message->parse("\n\n");
  45 ok($m->as_string, "\n\n");
  46 ok($m->content, "\n");
  47
  48 $m = HTTP::Message->parse("foo");
  49 ok($m->as_string, "\nfoo\n");
  50 $m = HTTP::Message->parse("foo: 1");
  51 ok($m->as_string, "Foo: 1\n\n");
  52 $m = HTTP::Message->parse("foo_bar: 1");
  53 ok($m->as_string, "Foo_bar: 1\n\n");
  54 $m = HTTP::Message->parse("foo: 1\n\nfoo");
  55 ok($m->as_string, "Foo: 1\n\nfoo\n");
  56 $m = HTTP::Message->parse(<<EOT);
  57 FOO : 1
  58  2
  59   3
  60    4
  61 bar:
  62  1
  63 Baz: 1
  64
  65 foobarbaz
  66 EOT
  67 ok($m->as_string, <<EOT);
  68 Bar:
  69  1
  70 Baz: 1
  71 Foo: 1
  72  2
  73   3
  74    4
  75
  76 foobarbaz
  77 EOT
  78
  79 $m = HTTP::Message->parse(<<EOT);
  80 Date: Fri, 18 Feb 2005 18:33:46 GMT
  81 Connection: close
  82 Content-Type: text/plain
  83
  84 foo:bar
  85 second line
  86 EOT
  87 ok($m->content(""), <<EOT);
  88 foo:bar
  89 second line
  90 EOT
  91 ok($m->as_string, <<EOT);
  92 Connection: close
  93 Date: Fri, 18 Feb 2005 18:33:46 GMT
  94 Content-Type: text/plain
  95
  96 EOT
  97
  98 $m = HTTP::Message->parse("  abc\nfoo: 1\n");
  99 ok($m->as_string, "\n  abc\nfoo: 1\n");
 100 $m = HTTP::Message->parse(" foo : 1\n");
 101 ok($m->as_string, "\n foo : 1\n");
 102 $m = HTTP::Message->parse("\nfoo: bar\n");
 103 ok($m->as_string, "\nfoo: bar\n");
 104
 105 $m = HTTP::Message->new([a => 1, b => 2], "abc");
 106 ok($m->content("foo\n"), "abc");
 107 ok($m->content, "foo\n");
 108
 109 $m->add_content("bar");
 110 ok($m->content, "foo\nbar");
 111 $m->add_content(\"\n");
 112 ok($m->content, "foo\nbar\n");
 113
 114 ok(ref($m->content_ref), "SCALAR");
 115 ok(${$m->content_ref}, "foo\nbar\n");
 116 ${$m->content_ref} =~ s/[ao]/i/g;
 117 ok($m->content, "fii\nbir\n");
 118
 119 $m->clear;
 120 ok($m->headers->header_field_names, 0);
 121 ok($m->content, "");
 122
 123 ok($m->parts, undef);
 124 $m->parts(HTTP::Message->new,
 125           HTTP::Message->new([a => 1], "foo"),
 126           HTTP::Message->new(undef, "bar\n"),
 127          );
 128 ok($m->parts->as_string, "\n");
 129
 130 my $str = $m->as_string;
 131 $str =~ s/\r/<CR>/g;
 132 ok($str, <<EOT);
 133 Content-Type: multipart/mixed; boundary=xYzZY
 134
 135 --xYzZY<CR>
 136 <CR>
 137 <CR>
 138 --xYzZY<CR>
 139 A: 1<CR>
 140 <CR>
 141 foo<CR>
 142 --xYzZY<CR>
 143 <CR>
 144 bar
 145 <CR>
 146 --xYzZY--<CR>
 147 EOT
 148
 149 $m2 = HTTP::Message->new;
 150 $m2->parts($m);
 151
 152 $str = $m2->as_string;
 153 $str =~ s/\r/<CR>/g;
 154 ok($str =~ /boundary=(\S+)/);
 155
 156
 157 ok($str, <<EOT);
 158 Content-Type: multipart/mixed; boundary=$1
 159
 160 --$1<CR>
 161 Content-Type: multipart/mixed; boundary=xYzZY<CR>
 162 <CR>
 163 --xYzZY<CR>
 164 <CR>
 165 <CR>
 166 --xYzZY<CR>
 167 A: 1<CR>
 168 <CR>
 169 foo<CR>
 170 --xYzZY<CR>
 171 <CR>
 172 bar
 173 <CR>
 174 --xYzZY--<CR>
 175 <CR>
 176 --$1--<CR>
 177 EOT
 178
 179 @parts = $m2->parts;
 180 ok(@parts, 1);
 181
 182 @parts = $parts[0]->parts;
 183 ok(@parts, 3);
 184 ok($parts[1]->header("A"), 1);
 185
 186 $m2->parts([HTTP::Message->new]);
 187 @parts = $m2->parts;
 188 ok(@parts, 1);
 189
 190 $m2->parts([]);
 191 @parts = $m2->parts;
 192 ok(@parts, 0);
 193
 194 $m->clear;
 195 $m2->clear;
 196
 197 $m = HTTP::Message->new([content_type => "message/http; boundary=aaa",
 198                         ],
 199                         <<EOT);
 200 GET / HTTP/1.1
 201 Host: www.example.com:8008
 202
 203 EOT
 204
 205 @parts = $m->parts;
 206 ok(@parts, 1);
 207 $m2 = $parts[0];
 208 ok(ref($m2), "HTTP::Request");
 209 ok($m2->method, "GET");
 210 ok($m2->uri, "/");
 211 ok($m2->protocol, "HTTP/1.1");
 212 ok($m2->header("Host"), "www.example.com:8008");
 213 ok($m2->content, "");
 214
 215 $m->content(<<EOT);
 216 HTTP/1.0 200 OK
 217 Content-Type: text/plain
 218
 219 Hello
 220 EOT
 221
 222 $m2 = $m->parts;
 223 ok(ref($m2), "HTTP::Response");
 224 ok($m2->protocol, "HTTP/1.0");
 225 ok($m2->code, "200");
 226 ok($m2->message, "OK");
 227 ok($m2->content_type, "text/plain");
 228 ok($m2->content, "Hello\n");
 229
 230 eval { $m->parts(HTTP::Message->new, HTTP::Message->new) };
 231 ok($@);
 232
 233 $m->add_part(HTTP::Message->new([a=>[1..3]], "a"));
 234 $str = $m->as_string;
 235 $str =~ s/\r/<CR>/g;
 236 ok($str, <<EOT);
 237 Content-Type: multipart/mixed; boundary=xYzZY
 238
 239 --xYzZY<CR>
 240 Content-Type: message/http; boundary=aaa<CR>
 241 <CR>
 242 HTTP/1.0 200 OK
 243 Content-Type: text/plain
 244
 245 Hello
 246 <CR>
 247 --xYzZY<CR>
 248 A: 1<CR>
 249 A: 2<CR>
 250 A: 3<CR>
 251 <CR>
 252 a<CR>
 253 --xYzZY--<CR>
 254 EOT
 255
 256 $m->add_part(HTTP::Message->new([b=>[1..3]], "b"));
 257
 258 $str = $m->as_string;
 259 $str =~ s/\r/<CR>/g;
 260 ok($str, <<EOT);
 261 Content-Type: multipart/mixed; boundary=xYzZY
 262
 263 --xYzZY<CR>
 264 Content-Type: message/http; boundary=aaa<CR>
 265 <CR>
 266 HTTP/1.0 200 OK
 267 Content-Type: text/plain
 268
 269 Hello
 270 <CR>
 271 --xYzZY<CR>
 272 A: 1<CR>
 273 A: 2<CR>
 274 A: 3<CR>
 275 <CR>
 276 a<CR>
 277 --xYzZY<CR>
 278 B: 1<CR>
 279 B: 2<CR>
 280 B: 3<CR>
 281 <CR>
 282 b<CR>
 283 --xYzZY--<CR>
 284 EOT
 285
 286 $m = HTTP::Message->new;
 287 $m->add_part(HTTP::Message->new([a=>[1..3]], "a"));
 288 $str = $m->as_string;
 289 $str =~ s/\r/<CR>/g;
 290 ok($str, <<EOT);
 291 Content-Type: multipart/mixed; boundary=xYzZY
 292
 293 --xYzZY<CR>
 294 A: 1<CR>
 295 A: 2<CR>
 296 A: 3<CR>
 297 <CR>
 298 a<CR>
 299 --xYzZY--<CR>
 300 EOT
 301
 302 $m = HTTP::Message->new;
 303 $m->content_ref(\my $foo);
 304 ok($m->content_ref, \$foo);
 305 $foo = "foo";
 306 ok($m->content, "foo");
 307 $m->add_content("bar");
 308 ok($foo, "foobar");
 309 ok($m->as_string, "\nfoobar\n");
 310 $m->content_type("message/foo");
 311 $m->parts(HTTP::Message->new(["h", "v"], "C"));
 312 ok($foo, "H: v\r\n\r\nC");
 313 $foo =~ s/C/c/;
 314 $m2 = $m->parts;
 315 ok($m2->content, "c");
 316
 317 $m = HTTP::Message->new;
 318 $foo = [];
 319 $m->content($foo);
 320 ok($m->content, $foo);
 321 ok(${$m->content_ref}, $foo);
 322 ok(${$m->content_ref([])}, $foo);
 323 ok($m->content_ref != $foo);
 324 eval {$m->add_content("x")};
 325 ok($@ && $@ =~ /^Can't append to ARRAY content/);
 326
 327 $foo = sub { "foo" };
 328 $m->content($foo);
 329 ok($m->content, $foo);
 330 ok(${$m->content_ref}, $foo);
 331
 332 $m->content_ref($foo);
 333 ok($m->content, $foo);
 334 ok($m->content_ref, $foo);
 335
 336 eval {$m->content_ref("foo")};
 337 ok($@ && $@ =~ /^Setting content_ref to a non-ref/);
 338
 339 $m->content_ref(\"foo");
 340 eval {$m->content("bar")};
 341 ok($@ && $@ =~ /^Modification of a read-only value/);
 342
 343 $foo = "foo";
 344 $m->content_ref(\$foo);
 345 ok($m->content("bar"), "foo");
 346 ok($foo, "bar");
 347 ok($m->content, "bar");
 348 ok($m->content_ref, \$foo);
 349
 350 $m = HTTP::Message->new;
 351 $m->content("fo=6F");
 352 ok($m->decoded_content, "fo=6F");
 353 $m->header("Content-Encoding", "quoted-printable");
 354 ok($m->decoded_content, "foo");
 355
 356 $m = HTTP::Message->new;
 357 $m->header("Content-Encoding", "gzip, base64");
 358 $m->content_type("text/plain; charset=UTF-8");
 359 $m->content("H4sICFWAq0ECA3h4eAB7v3u/R6ZCSUZqUarCoxm7uAAZKHXiEAAAAA==\n");
 360
 361 my $NO_ENCODE = $] < 5.008 || ($Config{'extensions'} !~ /\bEncode\b/)
 362     ? "No Encode module" : "";
 363 $@ = "";
 364 skip($NO_ENCODE, sub { eval { $m->decoded_content } }, "\x{FEFF}Hi there \x{263A}\n");
 365 ok($@ || "", "");
 366 ok($m->content, "H4sICFWAq0ECA3h4eAB7v3u/R6ZCSUZqUarCoxm7uAAZKHXiEAAAAA==\n");
 367
 368 $m2 = $m->clone;
 369 ok($m2->decode);
 370 ok($m2->header("Content-Encoding"), undef);
 371 ok($m2->content, qr/Hi there/);
 372
 373 ok(grep { $_ eq "gzip" } $m->decodable);
 374
 375 my $tmp = MIME::Base64::decode($m->content);
 376 $m->content($tmp);
 377 $m->header("Content-Encoding", "gzip");
 378 $@ = "";
 379 skip($NO_ENCODE, sub { eval { $m->decoded_content } }, "\x{FEFF}Hi there \x{263A}\n");
 380 ok($@ || "", "");
 381 ok($m->content, $tmp);
 382
 383 $m->remove_header("Content-Encoding");
 384 $m->content("a\xFF");
 385
 386 skip($NO_ENCODE, sub { $m->decoded_content }, "a\x{FFFD}");
 387 skip($NO_ENCODE, sub { $m->decoded_content(charset_strict => 1) }, undef);
 388
 389 $m->header("Content-Encoding", "foobar");
 390 ok($m->decoded_content, undef);
 391 ok($@ =~ /^Don't know how to decode Content-Encoding 'foobar'/);
 392
 393 my $err = 0;
 394 eval {
 395     $m->decoded_content(raise_error => 1);
 396     $err++;
 397 };
 398 ok($@ =~ /Don't know how to decode Content-Encoding 'foobar'/);
 399 ok($err, 0);
 400
 401 if ($] >= 5.008001) {
 402     eval {
 403         HTTP::Message->new([], "\x{263A}");
 404     };
 405     ok($@ =~ /bytes/);
 406     $m = HTTP::Message->new;
 407     eval {
 408         $m->add_content("\x{263A}");
 409     };
 410     ok($@ =~ /bytes/);
 411     eval {
 412         $m->content("\x{263A}");
 413     };
 414     ok($@ =~ /bytes/);
 415 }
 416 else {
 417     skip("Missing is_utf8 test", undef) for 1..3;
 418 }
 419
 420 # test the add_content_utf8 method
 421 if ($] >= 5.008001) {
 422     $m = HTTP::Message->new(["Content-Type", "text/plain; charset=UTF-8"]);
 423     $m->add_content_utf8("\x{263A}");
 424     $m->add_content_utf8("-\xC5");
 425     ok($m->content, "\xE2\x98\xBA-\xC3\x85");
 426     ok($m->decoded_content, "\x{263A}-\x{00C5}");
 427 }
 428 else {
 429     skip("Missing is_utf8 test", undef) for 1..2;
 430 }
 431
 432 $m = HTTP::Message->new([
 433     "Content-Type", "text/plain"
 434     ],
 435     "Hello world!"
 436 );
 437 $m->encode("deflate");
 438 $m->dump(prefix => "# ");
 439 ok($m->dump(prefix => "| "), <<'EOT');
 440 | Content-Encoding: deflate
 441 | Content-Type: text/plain
 442 |
 443 | x\x9C\xF3H\xCD\xC9\xC9W(\xCF/\xCAIQ\4\0\35\t\4^
 444 EOT
 445 $m->encode("base64", "identity");
 446 ok($m->as_string, <<'EOT');
 447 Content-Encoding: deflate, base64, identity
 448 Content-Type: text/plain
 449
 450 eJzzSM3JyVcozy/KSVEEAB0JBF4=
 451 EOT
 452 if (eval { require Encode; 1 }) {
 453     ok($m->decoded_content, "Hello world!");
 454 } else {
 455     skip('Needs Encode.pm for this test', undef);
 456 }
 457
 458 if (eval "require Compress::Bzip2") {
 459     $m = HTTP::Message->new([
 460         "Content-Type" => "text/plain",
 461         ],
 462         "Hello world!"
 463     );
 464     ok($m->encode("x-bzip2"));
 465     ok($m->header("Content-Encoding"), "x-bzip2");
 466     ok($m->content =~ /\0/);
 467     ok($m->decoded_content, "Hello world!");
 468     ok($m->decode);
 469     ok($m->content, "Hello world!");
 470
 471     if (0) {
 472         # I prepared the following message by using bzip2 command (v1.0.4)
 473         # but for some reason it will not pass
 474     $m = HTTP::Message->new([
 475         "Content-Type" => "text/plain",
 476         "Content-Encoding" => "x-bzip2, base64",
 477         ],
 478         "QlpoOTFBWSZTWcvLx0QAAAHVgAAQYAAAQAYEkIAgADEAMCBoYlnQeSEMvxdyRThQkMvLx0Q=\n"
 479     );
 480     $m->decode;
 481     $m->dump;
 482     }
 483 }
 484 else {
 485     skip("Need Compress::Bzip2", undef) for 1..6;
 486 }