tags/0.4.3.1-pre2/CPAN/HTTP/Headers.pm

   1 package HTTP::Headers;
   2
   3 use strict;
   4 use Carp ();
   5
   6 use vars qw($VERSION $TRANSLATE_UNDERSCORE);
   7 $VERSION = "6.00";
   8
   9 # The $TRANSLATE_UNDERSCORE variable controls whether '_' can be used
  10 # as a replacement for '-' in header field names.
  11 $TRANSLATE_UNDERSCORE = 1 unless defined $TRANSLATE_UNDERSCORE;
  12
  13 # "Good Practice" order of HTTP message headers:
  14 #    - General-Headers
  15 #    - Request-Headers
  16 #    - Response-Headers
  17 #    - Entity-Headers
  18
  19 my @general_headers = qw(
  20     Cache-Control Connection Date Pragma Trailer Transfer-Encoding Upgrade
  21     Via Warning
  22 );
  23
  24 my @request_headers = qw(
  25     Accept Accept-Charset Accept-Encoding Accept-Language
  26     Authorization Expect From Host
  27     If-Match If-Modified-Since If-None-Match If-Range If-Unmodified-Since
  28     Max-Forwards Proxy-Authorization Range Referer TE User-Agent
  29 );
  30
  31 my @response_headers = qw(
  32     Accept-Ranges Age ETag Location Proxy-Authenticate Retry-After Server
  33     Vary WWW-Authenticate
  34 );
  35
  36 my @entity_headers = qw(
  37     Allow Content-Encoding Content-Language Content-Length Content-Location
  38     Content-MD5 Content-Range Content-Type Expires Last-Modified
  39 );
  40
  41 my %entity_header = map { lc($_) => 1 } @entity_headers;
  42
  43 my @header_order = (
  44     @general_headers,
  45     @request_headers,
  46     @response_headers,
  47     @entity_headers,
  48 );
  49
  50 # Make alternative representations of @header_order.  This is used
  51 # for sorting and case matching.
  52 my %header_order;
  53 my %standard_case;
  54
  55 {
  56     my $i = 0;
  57     for (@header_order) {
  58         my $lc = lc $_;
  59         $header_order{$lc} = ++$i;
  60         $standard_case{$lc} = $_;
  61     }
  62 }
  63
  64
  65
  66 sub new
  67 {
  68     my($class) = shift;
  69     my $self = bless {}, $class;
  70     $self->header(@_) if @_; # set up initial headers
  71     $self;
  72 }
  73
  74
  75 sub header
  76 {
  77     my $self = shift;
  78     Carp::croak('Usage: $h->header($field, ...)') unless @_;
  79     my(@old);
  80     my %seen;
  81     while (@_) {
  82         my $field = shift;
  83         my $op = @_ ? ($seen{lc($field)}++ ? 'PUSH' : 'SET') : 'GET';
  84         @old = $self->_header($field, shift, $op);
  85     }
  86     return @old if wantarray;
  87     return $old[0] if @old <= 1;
  88     join(", ", @old);
  89 }
  90
  91 sub clear
  92 {
  93     my $self = shift;
  94     %$self = ();
  95 }
  96
  97
  98 sub push_header
  99 {
 100     my $self = shift;
 101     return $self->_header(@_, 'PUSH_H') if @_ == 2;
 102     while (@_) {
 103         $self->_header(splice(@_, 0, 2), 'PUSH_H');
 104     }
 105 }
 106
 107
 108 sub init_header
 109 {
 110     Carp::croak('Usage: $h->init_header($field, $val)') if @_ != 3;
 111     shift->_header(@_, 'INIT');
 112 }
 113
 114
 115 sub remove_header
 116 {
 117     my($self, @fields) = @_;
 118     my $field;
 119     my @values;
 120     foreach $field (@fields) {
 121         $field =~ tr/_/-/ if $field !~ /^:/ && $TRANSLATE_UNDERSCORE;
 122         my $v = delete $self->{lc $field};
 123         push(@values, ref($v) eq 'ARRAY' ? @$v : $v) if defined $v;
 124     }
 125     return @values;
 126 }
 127
 128 sub remove_content_headers
 129 {
 130     my $self = shift;
 131     unless (defined(wantarray)) {
 132         # fast branch that does not create return object
 133         delete @$self{grep $entity_header{$_} || /^content-/, keys %$self};
 134         return;
 135     }
 136
 137     my $c = ref($self)->new;
 138     for my $f (grep $entity_header{$_} || /^content-/, keys %$self) {
 139         $c->{$f} = delete $self->{$f};
 140     }
 141     $c;
 142 }
 143
 144
 145 sub _header
 146 {
 147     my($self, $field, $val, $op) = @_;
 148
 149     unless ($field =~ /^:/) {
 150         $field =~ tr/_/-/ if $TRANSLATE_UNDERSCORE;
 151         my $old = $field;
 152         $field = lc $field;
 153         unless(defined $standard_case{$field}) {
 154             # generate a %standard_case entry for this field
 155             $old =~ s/\b(\w)/\u$1/g;
 156             $standard_case{$field} = $old;
 157         }
 158     }
 159
 160     $op ||= defined($val) ? 'SET' : 'GET';
 161     if ($op eq 'PUSH_H') {
 162         # Like PUSH but where we don't care about the return value
 163         if (exists $self->{$field}) {
 164             my $h = $self->{$field};
 165             if (ref($h) eq 'ARRAY') {
 166                 push(@$h, ref($val) eq "ARRAY" ? @$val : $val);
 167             }
 168             else {
 169                 $self->{$field} = [$h, ref($val) eq "ARRAY" ? @$val : $val]
 170             }
 171             return;
 172         }
 173         $self->{$field} = $val;
 174         return;
 175     }
 176
 177     my $h = $self->{$field};
 178     my @old = ref($h) eq 'ARRAY' ? @$h : (defined($h) ? ($h) : ());
 179
 180     unless ($op eq 'GET' || ($op eq 'INIT' && @old)) {
 181         if (defined($val)) {
 182             my @new = ($op eq 'PUSH') ? @old : ();
 183             if (ref($val) ne 'ARRAY') {
 184                 push(@new, $val);
 185             }
 186             else {
 187                 push(@new, @$val);
 188             }
 189             $self->{$field} = @new > 1 ? \@new : $new[0];
 190         }
 191         elsif ($op ne 'PUSH') {
 192             delete $self->{$field};
 193         }
 194     }
 195     @old;
 196 }
 197
 198
 199 sub _sorted_field_names
 200 {
 201     my $self = shift;
 202     return [ sort {
 203         ($header_order{$a} || 999) <=> ($header_order{$b} || 999) ||
 204          $a cmp $b
 205     } keys %$self ];
 206 }
 207
 208
 209 sub header_field_names {
 210     my $self = shift;
 211     return map $standard_case{$_} || $_, @{ $self->_sorted_field_names },
 212         if wantarray;
 213     return keys %$self;
 214 }
 215
 216
 217 sub scan
 218 {
 219     my($self, $sub) = @_;
 220     my $key;
 221     for $key (@{ $self->_sorted_field_names }) {
 222         next if substr($key, 0, 1) eq '_';
 223         my $vals = $self->{$key};
 224         if (ref($vals) eq 'ARRAY') {
 225             my $val;
 226             for $val (@$vals) {
 227                 $sub->($standard_case{$key} || $key, $val);
 228             }
 229         }
 230         else {
 231             $sub->($standard_case{$key} || $key, $vals);
 232         }
 233     }
 234 }
 235
 236
 237 sub as_string
 238 {
 239     my($self, $endl) = @_;
 240     $endl = "\n" unless defined $endl;
 241
 242     my @result = ();
 243     for my $key (@{ $self->_sorted_field_names }) {
 244         next if index($key, '_') == 0;
 245         my $vals = $self->{$key};
 246         if ( ref($vals) eq 'ARRAY' ) {
 247             for my $val (@$vals) {
 248                 my $field = $standard_case{$key} || $key;
 249                 $field =~ s/^://;
 250                 if ( index($val, "\n") >= 0 ) {
 251                     $val = _process_newline($val, $endl);
 252                 }
 253                 push @result, $field . ': ' . $val;
 254             }
 255         }
 256         else {
 257             my $field = $standard_case{$key} || $key;
 258             $field =~ s/^://;
 259             if ( index($vals, "\n") >= 0 ) {
 260                 $vals = _process_newline($vals, $endl);
 261             }
 262             push @result, $field . ': ' . $vals;
 263         }
 264     }
 265
 266     join($endl, @result, '');
 267 }
 268
 269 sub _process_newline {
 270     local $_ = shift;
 271     my $endl = shift;
 272     # must handle header values with embedded newlines with care
 273     s/\s+$//;        # trailing newlines and space must go
 274     s/\n(\x0d?\n)+/\n/g;     # no empty lines
 275     s/\n([^\040\t])/\n $1/g; # intial space for continuation
 276     s/\n/$endl/g;    # substitute with requested line ending
 277     $_;
 278 }
 279
 280
 281
 282 if (eval { require Storable; 1 }) {
 283     *clone = \&Storable::dclone;
 284 } else {
 285     *clone = sub {
 286         my $self = shift;
 287         my $clone = HTTP::Headers->new;
 288         $self->scan(sub { $clone->push_header(@_);} );
 289         $clone;
 290     };
 291 }
 292
 293
 294 sub _date_header
 295 {
 296     require HTTP::Date;
 297     my($self, $header, $time) = @_;
 298     my($old) = $self->_header($header);
 299     if (defined $time) {
 300         $self->_header($header, HTTP::Date::time2str($time));
 301     }
 302     $old =~ s/;.*// if defined($old);
 303     HTTP::Date::str2time($old);
 304 }
 305
 306
 307 sub date                { shift->_date_header('Date',                @_); }
 308 sub expires             { shift->_date_header('Expires',             @_); }
 309 sub if_modified_since   { shift->_date_header('If-Modified-Since',   @_); }
 310 sub if_unmodified_since { shift->_date_header('If-Unmodified-Since', @_); }
 311 sub last_modified       { shift->_date_header('Last-Modified',       @_); }
 312
 313 # This is used as a private LWP extension.  The Client-Date header is
 314 # added as a timestamp to a response when it has been received.
 315 sub client_date         { shift->_date_header('Client-Date',         @_); }
 316
 317 # The retry_after field is dual format (can also be a expressed as
 318 # number of seconds from now), so we don't provide an easy way to
 319 # access it until we have know how both these interfaces can be
 320 # addressed.  One possibility is to return a negative value for
 321 # relative seconds and a positive value for epoch based time values.
 322 #sub retry_after       { shift->_date_header('Retry-After',       @_); }
 323
 324 sub content_type      {
 325     my $self = shift;
 326     my $ct = $self->{'content-type'};
 327     $self->{'content-type'} = shift if @_;
 328     $ct = $ct->[0] if ref($ct) eq 'ARRAY';
 329     return '' unless defined($ct) && length($ct);
 330     my @ct = split(/;\s*/, $ct, 2);
 331     for ($ct[0]) {
 332         s/\s+//g;
 333         $_ = lc($_);
 334     }
 335     wantarray ? @ct : $ct[0];
 336 }
 337
 338 sub content_type_charset {
 339     my $self = shift;
 340     require HTTP::Headers::Util;
 341     my $h = $self->{'content-type'};
 342     $h = $h->[0] if ref($h);
 343     $h = "" unless defined $h;
 344     my @v = HTTP::Headers::Util::split_header_words($h);
 345     if (@v) {
 346         my($ct, undef, %ct_param) = @{$v[0]};
 347         my $charset = $ct_param{charset};
 348         if ($ct) {
 349             $ct = lc($ct);
 350             $ct =~ s/\s+//;
 351         }
 352         if ($charset) {
 353             $charset = uc($charset);
 354             $charset =~ s/^\s+//;  $charset =~ s/\s+\z//;
 355             undef($charset) if $charset eq "";
 356         }
 357         return $ct, $charset if wantarray;
 358         return $charset;
 359     }
 360     return undef, undef if wantarray;
 361     return undef;
 362 }
 363
 364 sub content_is_text {
 365     my $self = shift;
 366     return $self->content_type =~ m,^text/,;
 367 }
 368
 369 sub content_is_html {
 370     my $self = shift;
 371     return $self->content_type eq 'text/html' || $self->content_is_xhtml;
 372 }
 373
 374 sub content_is_xhtml {
 375     my $ct = shift->content_type;
 376     return $ct eq "application/xhtml+xml" ||
 377            $ct eq "application/vnd.wap.xhtml+xml";
 378 }
 379
 380 sub content_is_xml {
 381     my $ct = shift->content_type;
 382     return 1 if $ct eq "text/xml";
 383     return 1 if $ct eq "application/xml";
 384     return 1 if $ct =~ /\+xml$/;
 385     return 0;
 386 }
 387
 388 sub referer           {
 389     my $self = shift;
 390     if (@_ && $_[0] =~ /#/) {
 391         # Strip fragment per RFC 2616, section 14.36.
 392         my $uri = shift;
 393         if (ref($uri)) {
 394             $uri = $uri->clone;
 395             $uri->fragment(undef);
 396         }
 397         else {
 398             $uri =~ s/\#.*//;
 399         }
 400         unshift @_, $uri;
 401     }
 402     ($self->_header('Referer', @_))[0];
 403 }
 404 *referrer = \&referer;  # on tchrist's request
 405
 406 sub title             { (shift->_header('Title',            @_))[0] }
 407 sub content_encoding  { (shift->_header('Content-Encoding', @_))[0] }
 408 sub content_language  { (shift->_header('Content-Language', @_))[0] }
 409 sub content_length    { (shift->_header('Content-Length',   @_))[0] }
 410
 411 sub user_agent        { (shift->_header('User-Agent',       @_))[0] }
 412 sub server            { (shift->_header('Server',           @_))[0] }
 413
 414 sub from              { (shift->_header('From',             @_))[0] }
 415 sub warning           { (shift->_header('Warning',          @_))[0] }
 416
 417 sub www_authenticate  { (shift->_header('WWW-Authenticate', @_))[0] }
 418 sub authorization     { (shift->_header('Authorization',    @_))[0] }
 419
 420 sub proxy_authenticate  { (shift->_header('Proxy-Authenticate',  @_))[0] }
 421 sub proxy_authorization { (shift->_header('Proxy-Authorization', @_))[0] }
 422
 423 sub authorization_basic       { shift->_basic_auth("Authorization",       @_) }
 424 sub proxy_authorization_basic { shift->_basic_auth("Proxy-Authorization", @_) }
 425
 426 sub _basic_auth {
 427     require MIME::Base64;
 428     my($self, $h, $user, $passwd) = @_;
 429     my($old) = $self->_header($h);
 430     if (defined $user) {
 431         Carp::croak("Basic authorization user name can't contain ':'")
 432           if $user =~ /:/;
 433         $passwd = '' unless defined $passwd;
 434         $self->_header($h => 'Basic ' .
 435                              MIME::Base64::encode("$user:$passwd", ''));
 436     }
 437     if (defined $old && $old =~ s/^\s*Basic\s+//) {
 438         my $val = MIME::Base64::decode($old);
 439         return $val unless wantarray;
 440         return split(/:/, $val, 2);
 441     }
 442     return;
 443 }
 444
 445
 446 1;
 447
 448 __END__
 449
 450 =head1 NAME
 451
 452 HTTP::Headers - Class encapsulating HTTP Message headers
 453
 454 =head1 SYNOPSIS
 455
 456  require HTTP::Headers;
 457  $h = HTTP::Headers->new;
 458
 459  $h->header('Content-Type' => 'text/plain');  # set
 460  $ct = $h->header('Content-Type');            # get
 461  $h->remove_header('Content-Type');           # delete
 462
 463 =head1 DESCRIPTION
 464
 465 The C<HTTP::Headers> class encapsulates HTTP-style message headers.
 466 The headers consist of attribute-value pairs also called fields, which
 467 may be repeated, and which are printed in a particular order.  The
 468 field names are cases insensitive.
 469
 470 Instances of this class are usually created as member variables of the
 471 C<HTTP::Request> and C<HTTP::Response> classes, internal to the
 472 library.
 473
 474 The following methods are available:
 475
 476 =over 4
 477
 478 =item $h = HTTP::Headers->new
 479
 480 Constructs a new C<HTTP::Headers> object.  You might pass some initial
 481 attribute-value pairs as parameters to the constructor.  I<E.g.>:
 482
 483  $h = HTTP::Headers->new(
 484        Date         => 'Thu, 03 Feb 1994 00:00:00 GMT',
 485        Content_Type => 'text/html; version=3.2',
 486        Content_Base => 'http://www.perl.org/');
 487
 488 The constructor arguments are passed to the C<header> method which is
 489 described below.
 490
 491 =item $h->clone
 492
 493 Returns a copy of this C<HTTP::Headers> object.
 494
 495 =item $h->header( $field )
 496
 497 =item $h->header( $field => $value )
 498
 499 =item $h->header( $f1 => $v1, $f2 => $v2, ... )
 500
 501 Get or set the value of one or more header fields.  The header field
 502 name ($field) is not case sensitive.  To make the life easier for perl
 503 users who wants to avoid quoting before the => operator, you can use
 504 '_' as a replacement for '-' in header names.
 505
 506 The header() method accepts multiple ($field => $value) pairs, which
 507 means that you can update several fields with a single invocation.
 508
 509 The $value argument may be a plain string or a reference to an array
 510 of strings for a multi-valued field. If the $value is provided as
 511 C<undef> then the field is removed.  If the $value is not given, then
 512 that header field will remain unchanged.
 513
 514 The old value (or values) of the last of the header fields is returned.
 515 If no such field exists C<undef> will be returned.
 516
 517 A multi-valued field will be returned as separate values in list
 518 context and will be concatenated with ", " as separator in scalar
 519 context.  The HTTP spec (RFC 2616) promise that joining multiple
 520 values in this way will not change the semantic of a header field, but
 521 in practice there are cases like old-style Netscape cookies (see
 522 L<HTTP::Cookies>) where "," is used as part of the syntax of a single
 523 field value.
 524
 525 Examples:
 526
 527  $header->header(MIME_Version => '1.0',
 528                  User_Agent   => 'My-Web-Client/0.01');
 529  $header->header(Accept => "text/html, text/plain, image/*");
 530  $header->header(Accept => [qw(text/html text/plain image/*)]);
 531  @accepts = $header->header('Accept');  # get multiple values
 532  $accepts = $header->header('Accept');  # get values as a single string
 533
 534 =item $h->push_header( $field => $value )
 535
 536 =item $h->push_header( $f1 => $v1, $f2 => $v2, ... )
 537
 538 Add a new field value for the specified header field.  Previous values
 539 for the same field are retained.
 540
 541 As for the header() method, the field name ($field) is not case
 542 sensitive and '_' can be used as a replacement for '-'.
 543
 544 The $value argument may be a scalar or a reference to a list of
 545 scalars.
 546
 547  $header->push_header(Accept => 'image/jpeg');
 548  $header->push_header(Accept => [map "image/$_", qw(gif png tiff)]);
 549
 550 =item $h->init_header( $field => $value )
 551
 552 Set the specified header to the given value, but only if no previous
 553 value for that field is set.
 554
 555 The header field name ($field) is not case sensitive and '_'
 556 can be used as a replacement for '-'.
 557
 558 The $value argument may be a scalar or a reference to a list of
 559 scalars.
 560
 561 =item $h->remove_header( $field, ... )
 562
 563 This function removes the header fields with the specified names.
 564
 565 The header field names ($field) are not case sensitive and '_'
 566 can be used as a replacement for '-'.
 567
 568 The return value is the values of the fields removed.  In scalar
 569 context the number of fields removed is returned.
 570
 571 Note that if you pass in multiple field names then it is generally not
 572 possible to tell which of the returned values belonged to which field.
 573
 574 =item $h->remove_content_headers
 575
 576 This will remove all the header fields used to describe the content of
 577 a message.  All header field names prefixed with C<Content-> fall
 578 into this category, as well as C<Allow>, C<Expires> and
 579 C<Last-Modified>.  RFC 2616 denotes these fields as I<Entity Header
 580 Fields>.
 581
 582 The return value is a new C<HTTP::Headers> object that contains the
 583 removed headers only.
 584
 585 =item $h->clear
 586
 587 This will remove all header fields.
 588
 589 =item $h->header_field_names
 590
 591 Returns the list of distinct names for the fields present in the
 592 header.  The field names have case as suggested by HTTP spec, and the
 593 names are returned in the recommended "Good Practice" order.
 594
 595 In scalar context return the number of distinct field names.
 596
 597 =item $h->scan( \&process_header_field )
 598
 599 Apply a subroutine to each header field in turn.  The callback routine
 600 is called with two parameters; the name of the field and a single
 601 value (a string).  If a header field is multi-valued, then the
 602 routine is called once for each value.  The field name passed to the
 603 callback routine has case as suggested by HTTP spec, and the headers
 604 will be visited in the recommended "Good Practice" order.
 605
 606 Any return values of the callback routine are ignored.  The loop can
 607 be broken by raising an exception (C<die>), but the caller of scan()
 608 would have to trap the exception itself.
 609
 610 =item $h->as_string
 611
 612 =item $h->as_string( $eol )
 613
 614 Return the header fields as a formatted MIME header.  Since it
 615 internally uses the C<scan> method to build the string, the result
 616 will use case as suggested by HTTP spec, and it will follow
 617 recommended "Good Practice" of ordering the header fields.  Long header
 618 values are not folded.
 619
 620 The optional $eol parameter specifies the line ending sequence to
 621 use.  The default is "\n".  Embedded "\n" characters in header field
 622 values will be substituted with this line ending sequence.
 623
 624 =back
 625
 626 =head1 CONVENIENCE METHODS
 627
 628 The most frequently used headers can also be accessed through the
 629 following convenience methods.  Most of these methods can both be used to read
 630 and to set the value of a header.  The header value is set if you pass
 631 an argument to the method.  The old header value is always returned.
 632 If the given header did not exist then C<undef> is returned.
 633
 634 Methods that deal with dates/times always convert their value to system
 635 time (seconds since Jan 1, 1970) and they also expect this kind of
 636 value when the header value is set.
 637
 638 =over 4
 639
 640 =item $h->date
 641
 642 This header represents the date and time at which the message was
 643 originated. I<E.g.>:
 644
 645   $h->date(time);  # set current date
 646
 647 =item $h->expires
 648
 649 This header gives the date and time after which the entity should be
 650 considered stale.
 651
 652 =item $h->if_modified_since
 653
 654 =item $h->if_unmodified_since
 655
 656 These header fields are used to make a request conditional.  If the requested
 657 resource has (or has not) been modified since the time specified in this field,
 658 then the server will return a C<304 Not Modified> response instead of
 659 the document itself.
 660
 661 =item $h->last_modified
 662
 663 This header indicates the date and time at which the resource was last
 664 modified. I<E.g.>:
 665
 666   # check if document is more than 1 hour old
 667   if (my $last_mod = $h->last_modified) {
 668       if ($last_mod < time - 60*60) {
 669           ...
 670       }
 671   }
 672
 673 =item $h->content_type
 674
 675 The Content-Type header field indicates the media type of the message
 676 content. I<E.g.>:
 677
 678   $h->content_type('text/html');
 679
 680 The value returned will be converted to lower case, and potential
 681 parameters will be chopped off and returned as a separate value if in
 682 an array context.  If there is no such header field, then the empty
 683 string is returned.  This makes it safe to do the following:
 684
 685   if ($h->content_type eq 'text/html') {
 686      # we enter this place even if the real header value happens to
 687      # be 'TEXT/HTML; version=3.0'
 688      ...
 689   }
 690
 691 =item $h->content_type_charset
 692
 693 Returns the upper-cased charset specified in the Content-Type header.  In list
 694 context return the lower-cased bare content type followed by the upper-cased
 695 charset.  Both values will be C<undef> if not specified in the header.
 696
 697 =item $h->content_is_text
 698
 699 Returns TRUE if the Content-Type header field indicate that the
 700 content is textual.
 701
 702 =item $h->content_is_html
 703
 704 Returns TRUE if the Content-Type header field indicate that the
 705 content is some kind of HTML (including XHTML).  This method can't be
 706 used to set Content-Type.
 707
 708 =item $h->content_is_xhtml
 709
 710 Returns TRUE if the Content-Type header field indicate that the
 711 content is XHTML.  This method can't be used to set Content-Type.
 712
 713 =item $h->content_is_xml
 714
 715 Returns TRUE if the Content-Type header field indicate that the
 716 content is XML.  This method can't be used to set Content-Type.
 717
 718 =item $h->content_encoding
 719
 720 The Content-Encoding header field is used as a modifier to the
 721 media type.  When present, its value indicates what additional
 722 encoding mechanism has been applied to the resource.
 723
 724 =item $h->content_length
 725
 726 A decimal number indicating the size in bytes of the message content.
 727
 728 =item $h->content_language
 729
 730 The natural language(s) of the intended audience for the message
 731 content.  The value is one or more language tags as defined by RFC
 732 1766.  Eg. "no" for some kind of Norwegian and "en-US" for English the
 733 way it is written in the US.
 734
 735 =item $h->title
 736
 737 The title of the document.  In libwww-perl this header will be
 738 initialized automatically from the E<lt>TITLE>...E<lt>/TITLE> element
 739 of HTML documents.  I<This header is no longer part of the HTTP
 740 standard.>
 741
 742 =item $h->user_agent
 743
 744 This header field is used in request messages and contains information
 745 about the user agent originating the request.  I<E.g.>:
 746
 747   $h->user_agent('Mozilla/5.0 (compatible; MSIE 7.0; Windows NT 6.0)');
 748
 749 =item $h->server
 750
 751 The server header field contains information about the software being
 752 used by the originating server program handling the request.
 753
 754 =item $h->from
 755
 756 This header should contain an Internet e-mail address for the human
 757 user who controls the requesting user agent.  The address should be
 758 machine-usable, as defined by RFC822.  E.g.:
 759
 760   $h->from('King Kong <king@kong.com>');
 761
 762 I<This header is no longer part of the HTTP standard.>
 763
 764 =item $h->referer
 765
 766 Used to specify the address (URI) of the document from which the
 767 requested resource address was obtained.
 768
 769 The "Free On-line Dictionary of Computing" as this to say about the
 770 word I<referer>:
 771
 772      <World-Wide Web> A misspelling of "referrer" which
 773      somehow made it into the {HTTP} standard.  A given {web
 774      page}'s referer (sic) is the {URL} of whatever web page
 775      contains the link that the user followed to the current
 776      page.  Most browsers pass this information as part of a
 777      request.
 778
 779      (1998-10-19)
 780
 781 By popular demand C<referrer> exists as an alias for this method so you
 782 can avoid this misspelling in your programs and still send the right
 783 thing on the wire.
 784
 785 When setting the referrer, this method removes the fragment from the
 786 given URI if it is present, as mandated by RFC2616.  Note that
 787 the removal does I<not> happen automatically if using the header(),
 788 push_header() or init_header() methods to set the referrer.
 789
 790 =item $h->www_authenticate
 791
 792 This header must be included as part of a C<401 Unauthorized> response.
 793 The field value consist of a challenge that indicates the
 794 authentication scheme and parameters applicable to the requested URI.
 795
 796 =item $h->proxy_authenticate
 797
 798 This header must be included in a C<407 Proxy Authentication Required>
 799 response.
 800
 801 =item $h->authorization
 802
 803 =item $h->proxy_authorization
 804
 805 A user agent that wishes to authenticate itself with a server or a
 806 proxy, may do so by including these headers.
 807
 808 =item $h->authorization_basic
 809
 810 This method is used to get or set an authorization header that use the
 811 "Basic Authentication Scheme".  In array context it will return two
 812 values; the user name and the password.  In scalar context it will
 813 return I<"uname:password"> as a single string value.
 814
 815 When used to set the header value, it expects two arguments.  I<E.g.>:
 816
 817   $h->authorization_basic($uname, $password);
 818
 819 The method will croak if the $uname contains a colon ':'.
 820
 821 =item $h->proxy_authorization_basic
 822
 823 Same as authorization_basic() but will set the "Proxy-Authorization"
 824 header instead.
 825
 826 =back
 827
 828 =head1 NON-CANONICALIZED FIELD NAMES
 829
 830 The header field name spelling is normally canonicalized including the
 831 '_' to '-' translation.  There are some application where this is not
 832 appropriate.  Prefixing field names with ':' allow you to force a
 833 specific spelling.  For example if you really want a header field name
 834 to show up as C<foo_bar> instead of "Foo-Bar", you might set it like
 835 this:
 836
 837   $h->header(":foo_bar" => 1);
 838
 839 These field names are returned with the ':' intact for
 840 $h->header_field_names and the $h->scan callback, but the colons do
 841 not show in $h->as_string.
 842
 843 =head1 COPYRIGHT
 844
 845 Copyright 1995-2005 Gisle Aas.
 846
 847 This library is free software; you can redistribute it and/or
 848 modify it under the same terms as Perl itself.
 849