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

   1 #!perl -w
   2
   3 use strict;
   4 use Test qw(plan ok);
   5
   6 plan tests => 157;
   7
   8 my($h, $h2);
   9 sub j { join("|", @_) }
  10
  11
  12 require HTTP::Headers;
  13 $h = HTTP::Headers->new;
  14 ok($h);
  15 ok(ref($h), "HTTP::Headers");
  16 ok($h->as_string, "");
  17
  18 $h = HTTP::Headers->new(foo => "bar", foo => "baaaaz", Foo => "baz");
  19 ok($h->as_string, "Foo: bar\nFoo: baaaaz\nFoo: baz\n");
  20
  21 $h = HTTP::Headers->new(foo => ["bar", "baz"]);
  22 ok($h->as_string, "Foo: bar\nFoo: baz\n");
  23
  24 $h = HTTP::Headers->new(foo => 1, bar => 2, foo_bar => 3);
  25 ok($h->as_string, "Bar: 2\nFoo: 1\nFoo-Bar: 3\n");
  26 ok($h->as_string(";"), "Bar: 2;Foo: 1;Foo-Bar: 3;");
  27
  28 ok($h->header("Foo"), 1);
  29 ok($h->header("FOO"), 1);
  30 ok(j($h->header("foo")), 1);
  31 ok($h->header("foo-bar"), 3);
  32 ok($h->header("foo_bar"), 3);
  33 ok($h->header("Not-There"), undef);
  34 ok(j($h->header("Not-There")), "");
  35 ok(eval { $h->header }, undef);
  36 ok($@);
  37
  38 ok($h->header("Foo", 11), 1);
  39 ok($h->header("Foo", [1, 1]), 11);
  40 ok($h->header("Foo"), "1, 1");
  41 ok(j($h->header("Foo")), "1|1");
  42 ok($h->header(foo => 11, Foo => 12, bar => 22), 2);
  43 ok($h->header("Foo"), "11, 12");
  44 ok($h->header("Bar"), 22);
  45 ok($h->header("Bar", undef), 22);
  46 ok(j($h->header("bar", 22)), "");
  47
  48 $h->push_header(Bar => 22);
  49 ok($h->header("Bar"), "22, 22");
  50 $h->push_header(Bar => [23 .. 25]);
  51 ok($h->header("Bar"), "22, 22, 23, 24, 25");
  52 eval { $h->push_header(Bar => 23 .. 25) };
  53 ok($@);
  54 ok(j($h->header("Bar")), "22|22|23|24|25");
  55
  56 $h->clear;
  57 $h->header(Foo => 1);
  58 ok($h->as_string, "Foo: 1\n");
  59 $h->init_header(Foo => 2);
  60 $h->init_header(Bar => 2);
  61 ok($h->as_string, "Bar: 2\nFoo: 1\n");
  62 $h->init_header(Foo => [2, 3]);
  63 $h->init_header(Baz => [2, 3]);
  64 ok($h->as_string, "Bar: 2\nBaz: 2\nBaz: 3\nFoo: 1\n");
  65
  66 eval { $h->init_header(A => 1, B => 2, C => 3) };
  67 ok($@);
  68 ok($h->as_string, "Bar: 2\nBaz: 2\nBaz: 3\nFoo: 1\n");
  69
  70 ok($h->clone->remove_header("Foo"), 1);
  71 ok($h->clone->remove_header("Bar"), 1);
  72 ok($h->clone->remove_header("Baz"), 2);
  73 ok($h->clone->remove_header(qw(Foo Bar Baz Not-There)), 4);
  74 ok($h->clone->remove_header("Not-There"), 0);
  75 ok(j($h->clone->remove_header("Foo")), 1);
  76 ok(j($h->clone->remove_header("Bar")), 2);
  77 ok(j($h->clone->remove_header("Baz")), "2|3");
  78 ok(j($h->clone->remove_header(qw(Foo Bar Baz Not-There))), "1|2|2|3");
  79 ok(j($h->clone->remove_header("Not-There")), "");
  80
  81 $h = HTTP::Headers->new(
  82     allow => "GET",
  83     content => "none",
  84     content_type => "text/html",
  85     content_md5 => "dummy",
  86     content_encoding => "gzip",
  87     content_foo => "bar",
  88     last_modified => "yesterday",
  89     expires => "tomorrow",
  90     etag => "abc",
  91     date => "today",
  92     user_agent => "libwww-perl",
  93     zoo => "foo",
  94    );
  95 ok($h->as_string, <<EOT);
  96 Date: today
  97 User-Agent: libwww-perl
  98 ETag: abc
  99 Allow: GET
 100 Content-Encoding: gzip
 101 Content-MD5: dummy
 102 Content-Type: text/html
 103 Expires: tomorrow
 104 Last-Modified: yesterday
 105 Content: none
 106 Content-Foo: bar
 107 Zoo: foo
 108 EOT
 109
 110 $h2 = $h->clone;
 111 ok($h->as_string, $h2->as_string);
 112
 113 ok($h->remove_content_headers->as_string, <<EOT);
 114 Allow: GET
 115 Content-Encoding: gzip
 116 Content-MD5: dummy
 117 Content-Type: text/html
 118 Expires: tomorrow
 119 Last-Modified: yesterday
 120 Content-Foo: bar
 121 EOT
 122
 123 ok($h->as_string, <<EOT);
 124 Date: today
 125 User-Agent: libwww-perl
 126 ETag: abc
 127 Content: none
 128 Zoo: foo
 129 EOT
 130
 131 # separate code path for the void context case, so test it as well
 132 $h2->remove_content_headers;
 133 ok($h->as_string, $h2->as_string);
 134
 135 $h->clear;
 136 ok($h->as_string, "");
 137 undef($h2);
 138
 139 $h = HTTP::Headers->new;
 140 ok($h->header_field_names, 0);
 141 ok(j($h->header_field_names), "");
 142
 143 $h = HTTP::Headers->new( etag => 1, foo => [2,3],
 144                          content_type => "text/plain");
 145 ok($h->header_field_names, 3);
 146 ok(j($h->header_field_names), "ETag|Content-Type|Foo");
 147
 148 {
 149     my @tmp;
 150     $h->scan(sub { push(@tmp, @_) });
 151     ok(j(@tmp), "ETag|1|Content-Type|text/plain|Foo|2|Foo|3");
 152
 153     @tmp = ();
 154     eval { $h->scan(sub { push(@tmp, @_); die if $_[0] eq "Content-Type" }) };
 155     ok($@);
 156     ok(j(@tmp), "ETag|1|Content-Type|text/plain");
 157
 158     @tmp = ();
 159     $h->scan(sub { push(@tmp, @_) });
 160     ok(j(@tmp), "ETag|1|Content-Type|text/plain|Foo|2|Foo|3");
 161 }
 162
 163 # CONVENIENCE METHODS
 164
 165 $h = HTTP::Headers->new;
 166 ok($h->date, undef);
 167 ok($h->date(time), undef);
 168 ok(j($h->header_field_names), "Date");
 169 ok($h->header("Date") =~ /^[A-Z][a-z][a-z], \d\d .* GMT$/);
 170 {
 171     my $off = time - $h->date;
 172     ok($off == 0 || $off == 1);
 173 }
 174
 175 if ($] < 5.006) {
 176    Test::skip("Can't call variable method", 1) for 1..13;
 177 }
 178 else {
 179 # other date fields
 180 for my $field (qw(expires if_modified_since if_unmodified_since
 181                   last_modified))
 182 {
 183     eval <<'EOT'; die $@ if $@;
 184     ok($h->$field, undef);
 185     ok($h->$field(time), undef);
 186     ok((time - $h->$field) =~ /^[01]$/);
 187 EOT
 188 }
 189 ok(j($h->header_field_names), "Date|If-Modified-Since|If-Unmodified-Since|Expires|Last-Modified");
 190 }
 191
 192 $h->clear;
 193 ok($h->content_type, "");
 194 ok($h->content_type("text/html"), "");
 195 ok($h->content_type, "text/html");
 196 ok($h->content_type("   TEXT  / HTML   ") , "text/html");
 197 ok($h->content_type, "text/html");
 198 ok(j($h->content_type), "text/html");
 199 ok($h->content_type("text/html;\n charSet = \"ISO-8859-1\"; Foo=1 "), "text/html");
 200 ok($h->content_type, "text/html");
 201 ok(j($h->content_type), "text/html|charSet = \"ISO-8859-1\"; Foo=1 ");
 202 ok($h->header("content_type"), "text/html;\n charSet = \"ISO-8859-1\"; Foo=1 ");
 203
 204 ok($h->content_encoding, undef);
 205 ok($h->content_encoding("gzip"), undef);
 206 ok($h->content_encoding, "gzip");
 207 ok(j($h->header_field_names), "Content-Encoding|Content-Type");
 208
 209 ok($h->content_language, undef);
 210 ok($h->content_language("no"), undef);
 211 ok($h->content_language, "no");
 212
 213 ok($h->title, undef);
 214 ok($h->title("This is a test"), undef);
 215 ok($h->title, "This is a test");
 216
 217 ok($h->user_agent, undef);
 218 ok($h->user_agent("Mozilla/1.2"), undef);
 219 ok($h->user_agent, "Mozilla/1.2");
 220
 221 ok($h->server, undef);
 222 ok($h->server("Apache/2.1"), undef);
 223 ok($h->server, "Apache/2.1");
 224
 225 ok($h->from("Gisle\@ActiveState.com"), undef);
 226 ok($h->header("from", "Gisle\@ActiveState.com"));
 227
 228 ok($h->referer("http://www.example.com"), undef);
 229 ok($h->referer, "http://www.example.com");
 230 ok($h->referrer, "http://www.example.com");
 231 ok($h->referer("http://www.example.com/#bar"), "http://www.example.com");
 232 ok($h->referer, "http://www.example.com/");
 233 {
 234     require URI;
 235     my $u = URI->new("http://www.example.com#bar");
 236     $h->referer($u);
 237     ok($u->as_string, "http://www.example.com#bar");
 238     ok($h->referer->fragment, undef);
 239     ok($h->referrer->as_string, "http://www.example.com");
 240 }
 241
 242 ok($h->as_string, <<EOT);
 243 From: Gisle\@ActiveState.com
 244 Referer: http://www.example.com
 245 User-Agent: Mozilla/1.2
 246 Server: Apache/2.1
 247 Content-Encoding: gzip
 248 Content-Language: no
 249 Content-Type: text/html;
 250  charSet = "ISO-8859-1"; Foo=1
 251 Title: This is a test
 252 EOT
 253
 254 $h->clear;
 255 ok($h->www_authenticate("foo"), undef);
 256 ok($h->www_authenticate("bar"), "foo");
 257 ok($h->www_authenticate, "bar");
 258 ok($h->proxy_authenticate("foo"), undef);
 259 ok($h->proxy_authenticate("bar"), "foo");
 260 ok($h->proxy_authenticate, "bar");
 261
 262 ok($h->authorization_basic, undef);
 263 ok($h->authorization_basic("u"), undef);
 264 ok($h->authorization_basic("u", "p"), "u:");
 265 ok($h->authorization_basic, "u:p");
 266 ok(j($h->authorization_basic), "u|p");
 267 ok($h->authorization, "Basic dTpw");
 268
 269 ok(eval { $h->authorization_basic("u2:p") }, undef);
 270 ok($@);
 271 ok(j($h->authorization_basic), "u|p");
 272
 273 ok($h->proxy_authorization_basic("u2", "p2"), undef);
 274 ok(j($h->proxy_authorization_basic), "u2|p2");
 275 ok($h->proxy_authorization, "Basic dTI6cDI=");
 276
 277 ok($h->as_string, <<EOT);
 278 Authorization: Basic dTpw
 279 Proxy-Authorization: Basic dTI6cDI=
 280 Proxy-Authenticate: bar
 281 WWW-Authenticate: bar
 282 EOT
 283
 284
 285
 286 #---- old tests below -----
 287
 288 $h = new HTTP::Headers
 289         mime_version  => "1.0",
 290         content_type  => "text/html";
 291 $h->header(URI => "http://www.oslonett.no/");
 292
 293 ok($h->header("MIME-Version"), "1.0");
 294 ok($h->header('Uri'), "http://www.oslonett.no/");
 295
 296 $h->header("MY-header" => "foo",
 297            "Date" => "somedate",
 298            "Accept" => ["text/plain", "image/*"],
 299           );
 300 $h->push_header("accept" => "audio/basic");
 301
 302 ok($h->header("date"), "somedate");
 303
 304 my @accept = $h->header("accept");
 305 ok(@accept, 3);
 306
 307 $h->remove_header("uri", "date");
 308
 309 my $str = $h->as_string;
 310 my $lines = ($str =~ tr/\n/\n/);
 311 ok($lines, 6);
 312
 313 $h2 = $h->clone;
 314
 315 $h->header("accept", "*/*");
 316 $h->remove_header("my-header");
 317
 318 @accept = $h2->header("accept");
 319 ok(@accept, 3);
 320
 321 @accept = $h->header("accept");
 322 ok(@accept, 1);
 323
 324 # Check order of headers, but first remove this one
 325 $h2->remove_header('mime_version');
 326
 327 # and add this general header
 328 $h2->header(Connection => 'close');
 329
 330 my @x = ();
 331 $h2->scan(sub {push(@x, shift);});
 332 ok(join(";", @x), "Connection;Accept;Accept;Accept;Content-Type;MY-Header");
 333
 334 # Check headers with embedded newlines:
 335 $h = HTTP::Headers->new(
 336         a => "foo\n\n",
 337         b => "foo\nbar",
 338         c => "foo\n\nbar\n\n",
 339         d => "foo\n\tbar",
 340         e => "foo\n  bar  ",
 341         f => "foo\n bar\n  baz\nbaz",
 342      );
 343 ok($h->as_string("<<\n"), <<EOT);
 344 A: foo<<
 345 B: foo<<
 346  bar<<
 347 C: foo<<
 348  bar<<
 349 D: foo<<
 350 \tbar<<
 351 E: foo<<
 352   bar<<
 353 F: foo<<
 354  bar<<
 355   baz<<
 356  baz<<
 357 EOT
 358
 359
 360 # Check with FALSE $HTML::Headers::TRANSLATE_UNDERSCORE
 361 {
 362     local($HTTP::Headers::TRANSLATE_UNDERSCORE);
 363     $HTTP::Headers::TRANSLATE_UNDERSCORE = undef; # avoid -w warning
 364
 365     $h = HTTP::Headers->new;
 366     $h->header(abc_abc   => "foo");
 367     $h->header("abc-abc" => "bar");
 368
 369     ok($h->header("ABC_ABC"), "foo");
 370     ok($h->header("ABC-ABC"),"bar");
 371     ok($h->remove_header("Abc_Abc"));
 372     ok(!defined($h->header("abc_abc")));
 373     ok($h->header("ABC-ABC"), "bar");
 374 }
 375
 376 # Check if objects as header values works
 377 require URI;
 378 $h->header(URI => URI->new("http://www.perl.org"));
 379
 380 ok($h->header("URI")->scheme, "http");
 381
 382 $h->clear;
 383 ok($h->as_string, "");
 384
 385 $h->content_type("text/plain");
 386 $h->header(content_md5 => "dummy");
 387 $h->header("Content-Foo" => "foo");
 388 $h->header(Location => "http:", xyzzy => "plugh!");
 389
 390 ok($h->as_string, <<EOT);
 391 Location: http:
 392 Content-MD5: dummy
 393 Content-Type: text/plain
 394 Content-Foo: foo
 395 Xyzzy: plugh!
 396 EOT
 397
 398 my $c = $h->remove_content_headers;
 399 ok($h->as_string, <<EOT);
 400 Location: http:
 401 Xyzzy: plugh!
 402 EOT
 403
 404 ok($c->as_string, <<EOT);
 405 Content-MD5: dummy
 406 Content-Type: text/plain
 407 Content-Foo: foo
 408 EOT
 409
 410 $h = HTTP::Headers->new;
 411 $h->content_type("text/plain");
 412 $h->header(":foo_bar", 1);
 413 $h->push_header(":content_type", "text/html");
 414 ok(j($h->header_field_names), "Content-Type|:content_type|:foo_bar");
 415 ok($h->header('Content-Type'), "text/plain");
 416 ok($h->header(':Content_Type'), undef);
 417 ok($h->header(':content_type'), "text/html");
 418 ok($h->as_string, <<EOT);
 419 Content-Type: text/plain
 420 content_type: text/html
 421 foo_bar: 1
 422 EOT
 423
 424 # [RT#30579] IE6 appens "; length = NNNN" on If-Modified-Since (can we handle it)
 425 $h = HTTP::Headers->new(
 426     if_modified_since => "Sat, 29 Oct 1994 19:43:31 GMT; length=34343"
 427 );
 428 ok(gmtime($h->if_modified_since), "Sat Oct 29 19:43:31 1994");