home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl5 / HTTP / Headers.pm < prev    next >
Encoding:
Perl POD Document  |  2008-10-20  |  22.1 KB  |  786 lines

  1. package HTTP::Headers;
  2.  
  3. use strict;
  4. use Carp ();
  5.  
  6. use vars qw($VERSION $TRANSLATE_UNDERSCORE);
  7. $VERSION = "5.818";
  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.     foreach $key ($self->_sorted_field_names) {
  222.         next if $key =~ /^_/;
  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.     $self->scan(sub {
  244.     my($field, $val) = @_;
  245.     $field =~ s/^://;
  246.     if ($val =~ /\n/) {
  247.         # must handle header values with embedded newlines with care
  248.         $val =~ s/\s+$//;          # trailing newlines and space must go
  249.         $val =~ s/\n\n+/\n/g;      # no empty lines
  250.         $val =~ s/\n([^\040\t])/\n $1/g;  # intial space for continuation
  251.         $val =~ s/\n/$endl/g;      # substitute with requested line ending
  252.     }
  253.     push(@result, "$field: $val");
  254.     });
  255.  
  256.     join($endl, @result, '');
  257. }
  258.  
  259.  
  260. if (eval { require Storable; 1 }) {
  261.     *clone = \&Storable::dclone;
  262. } else {
  263.     *clone = sub {
  264.     my $self = shift;
  265.     my $clone = new HTTP::Headers;
  266.     $self->scan(sub { $clone->push_header(@_);} );
  267.     $clone;
  268.     };
  269. }
  270.  
  271.  
  272. sub _date_header
  273. {
  274.     require HTTP::Date;
  275.     my($self, $header, $time) = @_;
  276.     my($old) = $self->_header($header);
  277.     if (defined $time) {
  278.     $self->_header($header, HTTP::Date::time2str($time));
  279.     }
  280.     $old =~ s/;.*// if defined($old);
  281.     HTTP::Date::str2time($old);
  282. }
  283.  
  284.  
  285. sub date                { shift->_date_header('Date',                @_); }
  286. sub expires             { shift->_date_header('Expires',             @_); }
  287. sub if_modified_since   { shift->_date_header('If-Modified-Since',   @_); }
  288. sub if_unmodified_since { shift->_date_header('If-Unmodified-Since', @_); }
  289. sub last_modified       { shift->_date_header('Last-Modified',       @_); }
  290.  
  291. # This is used as a private LWP extension.  The Client-Date header is
  292. # added as a timestamp to a response when it has been received.
  293. sub client_date         { shift->_date_header('Client-Date',         @_); }
  294.  
  295. # The retry_after field is dual format (can also be a expressed as
  296. # number of seconds from now), so we don't provide an easy way to
  297. # access it until we have know how both these interfaces can be
  298. # addressed.  One possibility is to return a negative value for
  299. # relative seconds and a positive value for epoch based time values.
  300. #sub retry_after       { shift->_date_header('Retry-After',       @_); }
  301.  
  302. sub content_type      {
  303.     my $self = shift;
  304.     my $ct = $self->{'content-type'};
  305.     $self->{'content-type'} = shift if @_;
  306.     $ct = $ct->[0] if ref($ct) eq 'ARRAY';
  307.     return '' unless defined($ct) && length($ct);
  308.     my @ct = split(/;\s*/, $ct, 2);
  309.     for ($ct[0]) {
  310.     s/\s+//g;
  311.     $_ = lc($_);
  312.     }
  313.     wantarray ? @ct : $ct[0];
  314. }
  315.  
  316. sub content_is_html {
  317.     my $self = shift;
  318.     return $self->content_type eq 'text/html' || $self->content_is_xhtml;
  319. }
  320.  
  321. sub content_is_xhtml {
  322.     my $ct = shift->content_type;
  323.     return $ct eq "application/xhtml+xml" ||
  324.            $ct eq "application/vnd.wap.xhtml+xml";
  325. }
  326.  
  327. sub content_is_xml {
  328.     my $ct = shift->content_type;
  329.     return 1 if $ct eq "text/xml";
  330.     return 1 if $ct eq "application/xml";
  331.     return 1 if $ct =~ /\+xml$/;
  332.     return 0;
  333. }
  334.  
  335. sub referer           {
  336.     my $self = shift;
  337.     if (@_ && $_[0] =~ /#/) {
  338.     # Strip fragment per RFC 2616, section 14.36.
  339.     my $uri = shift;
  340.     if (ref($uri)) {
  341.         $uri = $uri->clone;
  342.         $uri->fragment(undef);
  343.     }
  344.     else {
  345.         $uri =~ s/\#.*//;
  346.     }
  347.     unshift @_, $uri;
  348.     }
  349.     ($self->_header('Referer', @_))[0];
  350. }
  351. *referrer = \&referer;  # on tchrist's request
  352.  
  353. sub title             { (shift->_header('Title',            @_))[0] }
  354. sub content_encoding  { (shift->_header('Content-Encoding', @_))[0] }
  355. sub content_language  { (shift->_header('Content-Language', @_))[0] }
  356. sub content_length    { (shift->_header('Content-Length',   @_))[0] }
  357.  
  358. sub user_agent        { (shift->_header('User-Agent',       @_))[0] }
  359. sub server            { (shift->_header('Server',           @_))[0] }
  360.  
  361. sub from              { (shift->_header('From',             @_))[0] }
  362. sub warning           { (shift->_header('Warning',          @_))[0] }
  363.  
  364. sub www_authenticate  { (shift->_header('WWW-Authenticate', @_))[0] }
  365. sub authorization     { (shift->_header('Authorization',    @_))[0] }
  366.  
  367. sub proxy_authenticate  { (shift->_header('Proxy-Authenticate',  @_))[0] }
  368. sub proxy_authorization { (shift->_header('Proxy-Authorization', @_))[0] }
  369.  
  370. sub authorization_basic       { shift->_basic_auth("Authorization",       @_) }
  371. sub proxy_authorization_basic { shift->_basic_auth("Proxy-Authorization", @_) }
  372.  
  373. sub _basic_auth {
  374.     require MIME::Base64;
  375.     my($self, $h, $user, $passwd) = @_;
  376.     my($old) = $self->_header($h);
  377.     if (defined $user) {
  378.     Carp::croak("Basic authorization user name can't contain ':'")
  379.       if $user =~ /:/;
  380.     $passwd = '' unless defined $passwd;
  381.     $self->_header($h => 'Basic ' .
  382.                              MIME::Base64::encode("$user:$passwd", ''));
  383.     }
  384.     if (defined $old && $old =~ s/^\s*Basic\s+//) {
  385.     my $val = MIME::Base64::decode($old);
  386.     return $val unless wantarray;
  387.     return split(/:/, $val, 2);
  388.     }
  389.     return;
  390. }
  391.  
  392.  
  393. 1;
  394.  
  395. __END__
  396.  
  397. =head1 NAME
  398.  
  399. HTTP::Headers - Class encapsulating HTTP Message headers
  400.  
  401. =head1 SYNOPSIS
  402.  
  403.  require HTTP::Headers;
  404.  $h = HTTP::Headers->new;
  405.  
  406.  $h->header('Content-Type' => 'text/plain');  # set
  407.  $ct = $h->header('Content-Type');            # get
  408.  $h->remove_header('Content-Type');           # delete
  409.  
  410. =head1 DESCRIPTION
  411.  
  412. The C<HTTP::Headers> class encapsulates HTTP-style message headers.
  413. The headers consist of attribute-value pairs also called fields, which
  414. may be repeated, and which are printed in a particular order.  The
  415. field names are cases insensitive.
  416.  
  417. Instances of this class are usually created as member variables of the
  418. C<HTTP::Request> and C<HTTP::Response> classes, internal to the
  419. library.
  420.  
  421. The following methods are available:
  422.  
  423. =over 4
  424.  
  425. =item $h = HTTP::Headers->new
  426.  
  427. Constructs a new C<HTTP::Headers> object.  You might pass some initial
  428. attribute-value pairs as parameters to the constructor.  I<E.g.>:
  429.  
  430.  $h = HTTP::Headers->new(
  431.        Date         => 'Thu, 03 Feb 1994 00:00:00 GMT',
  432.        Content_Type => 'text/html; version=3.2',
  433.        Content_Base => 'http://www.perl.org/');
  434.  
  435. The constructor arguments are passed to the C<header> method which is
  436. described below.
  437.  
  438. =item $h->clone
  439.  
  440. Returns a copy of this C<HTTP::Headers> object.
  441.  
  442. =item $h->header( $field )
  443.  
  444. =item $h->header( $field => $value )
  445.  
  446. =item $h->header( $f1 => $v1, $f2 => $v2, ... )
  447.  
  448. Get or set the value of one or more header fields.  The header field
  449. name ($field) is not case sensitive.  To make the life easier for perl
  450. users who wants to avoid quoting before the => operator, you can use
  451. '_' as a replacement for '-' in header names.
  452.  
  453. The header() method accepts multiple ($field => $value) pairs, which
  454. means that you can update several fields with a single invocation.
  455.  
  456. The $value argument may be a plain string or a reference to an array
  457. of strings for a multi-valued field. If the $value is provided as
  458. C<undef> then the field is removed.  If the $value is not given, then
  459. that header field will remain unchanged.
  460.  
  461. The old value (or values) of the last of the header fields is returned.
  462. If no such field exists C<undef> will be returned.
  463.  
  464. A multi-valued field will be returned as separate values in list
  465. context and will be concatenated with ", " as separator in scalar
  466. context.  The HTTP spec (RFC 2616) promise that joining multiple
  467. values in this way will not change the semantic of a header field, but
  468. in practice there are cases like old-style Netscape cookies (see
  469. L<HTTP::Cookies>) where "," is used as part of the syntax of a single
  470. field value.
  471.  
  472. Examples:
  473.  
  474.  $header->header(MIME_Version => '1.0',
  475.          User_Agent   => 'My-Web-Client/0.01');
  476.  $header->header(Accept => "text/html, text/plain, image/*");
  477.  $header->header(Accept => [qw(text/html text/plain image/*)]);
  478.  @accepts = $header->header('Accept');  # get multiple values
  479.  $accepts = $header->header('Accept');  # get values as a single string
  480.  
  481. =item $h->push_header( $field => $value )
  482.  
  483. =item $h->push_header( $f1 => $v1, $f2 => $v2, ... )
  484.  
  485. Add a new field value for the specified header field.  Previous values
  486. for the same field are retained.
  487.  
  488. As for the header() method, the field name ($field) is not case
  489. sensitive and '_' can be used as a replacement for '-'.
  490.  
  491. The $value argument may be a scalar or a reference to a list of
  492. scalars.
  493.  
  494.  $header->push_header(Accept => 'image/jpeg');
  495.  $header->push_header(Accept => [map "image/$_", qw(gif png tiff)]);
  496.  
  497. =item $h->init_header( $field => $value )
  498.  
  499. Set the specified header to the given value, but only if no previous
  500. value for that field is set.
  501.  
  502. The header field name ($field) is not case sensitive and '_'
  503. can be used as a replacement for '-'.
  504.  
  505. The $value argument may be a scalar or a reference to a list of
  506. scalars.
  507.  
  508. =item $h->remove_header( $field, ... )
  509.  
  510. This function removes the header fields with the specified names.
  511.  
  512. The header field names ($field) are not case sensitive and '_'
  513. can be used as a replacement for '-'.
  514.  
  515. The return value is the values of the fields removed.  In scalar
  516. context the number of fields removed is returned.
  517.  
  518. Note that if you pass in multiple field names then it is generally not
  519. possible to tell which of the returned values belonged to which field.
  520.  
  521. =item $h->remove_content_headers
  522.  
  523. This will remove all the header fields used to describe the content of
  524. a message.  All header field names prefixed with C<Content-> falls
  525. into this category, as well as C<Allow>, C<Expires> and
  526. C<Last-Modified>.  RFC 2616 denote these fields as I<Entity Header
  527. Fields>.
  528.  
  529. The return value is a new C<HTTP::Headers> object that contains the
  530. removed headers only.
  531.  
  532. =item $h->clear
  533.  
  534. This will remove all header fields.
  535.  
  536. =item $h->header_field_names
  537.  
  538. Returns the list of distinct names for the fields present in the
  539. header.  The field names have case as suggested by HTTP spec, and the
  540. names are returned in the recommended "Good Practice" order.
  541.  
  542. In scalar context return the number of distinct field names.
  543.  
  544. =item $h->scan( \&process_header_field )
  545.  
  546. Apply a subroutine to each header field in turn.  The callback routine
  547. is called with two parameters; the name of the field and a single
  548. value (a string).  If a header field is multi-valued, then the
  549. routine is called once for each value.  The field name passed to the
  550. callback routine has case as suggested by HTTP spec, and the headers
  551. will be visited in the recommended "Good Practice" order.
  552.  
  553. Any return values of the callback routine are ignored.  The loop can
  554. be broken by raising an exception (C<die>), but the caller of scan()
  555. would have to trap the exception itself.
  556.  
  557. =item $h->as_string
  558.  
  559. =item $h->as_string( $eol )
  560.  
  561. Return the header fields as a formatted MIME header.  Since it
  562. internally uses the C<scan> method to build the string, the result
  563. will use case as suggested by HTTP spec, and it will follow
  564. recommended "Good Practice" of ordering the header fields.  Long header
  565. values are not folded.
  566.  
  567. The optional $eol parameter specifies the line ending sequence to
  568. use.  The default is "\n".  Embedded "\n" characters in header field
  569. values will be substituted with this line ending sequence.
  570.  
  571. =back
  572.  
  573. =head1 CONVENIENCE METHODS
  574.  
  575. The most frequently used headers can also be accessed through the
  576. following convenience Methods.  Most of these methods can both be used to read
  577. and to set the value of a header.  The header value is set if you pass
  578. an argument to the method.  The old header value is always returned.
  579. If the given header did not exist then C<undef> is returned.
  580.  
  581. Methods that deal with dates/times always convert their value to system
  582. time (seconds since Jan 1, 1970) and they also expect this kind of
  583. value when the header value is set.
  584.  
  585. =over 4
  586.  
  587. =item $h->date
  588.  
  589. This header represents the date and time at which the message was
  590. originated. I<E.g.>:
  591.  
  592.   $h->date(time);  # set current date
  593.  
  594. =item $h->expires
  595.  
  596. This header gives the date and time after which the entity should be
  597. considered stale.
  598.  
  599. =item $h->if_modified_since
  600.  
  601. =item $h->if_unmodified_since
  602.  
  603. These header fields are used to make a request conditional.  If the requested
  604. resource has (or has not) been modified since the time specified in this field,
  605. then the server will return a C<304 Not Modified> response instead of
  606. the document itself.
  607.  
  608. =item $h->last_modified
  609.  
  610. This header indicates the date and time at which the resource was last
  611. modified. I<E.g.>:
  612.  
  613.   # check if document is more than 1 hour old
  614.   if (my $last_mod = $h->last_modified) {
  615.       if ($last_mod < time - 60*60) {
  616.       ...
  617.       }
  618.   }
  619.  
  620. =item $h->content_type
  621.  
  622. The Content-Type header field indicates the media type of the message
  623. content. I<E.g.>:
  624.  
  625.   $h->content_type('text/html');
  626.  
  627. The value returned will be converted to lower case, and potential
  628. parameters will be chopped off and returned as a separate value if in
  629. an array context.  If there is no such header field, then the empty
  630. string is returned.  This makes it safe to do the following:
  631.  
  632.   if ($h->content_type eq 'text/html') {
  633.      # we enter this place even if the real header value happens to
  634.      # be 'TEXT/HTML; version=3.0'
  635.      ...
  636.   }
  637.  
  638. =item $h->content_is_html
  639.  
  640. Returns TRUE if the Content-Type header field indicate that the
  641. content is some kind of HTML (including XHTML).  This method can't be
  642. used to set Content-Type.
  643.  
  644. =item $h->content_is_xhtml
  645.  
  646. Returns TRUE if the Content-Type header field indicate that the
  647. content is XHTML.  This method can't be used to set Content-Type.
  648.  
  649. =item $h->content_is_xml
  650.  
  651. Returns TRUE if the Content-Type header field indicate that the
  652. content is XML.  This method can't be used to set Content-Type.
  653.  
  654. =item $h->content_encoding
  655.  
  656. The Content-Encoding header field is used as a modifier to the
  657. media type.  When present, its value indicates what additional
  658. encoding mechanism has been applied to the resource.
  659.  
  660. =item $h->content_length
  661.  
  662. A decimal number indicating the size in bytes of the message content.
  663.  
  664. =item $h->content_language
  665.  
  666. The natural language(s) of the intended audience for the message
  667. content.  The value is one or more language tags as defined by RFC
  668. 1766.  Eg. "no" for some kind of Norwegian and "en-US" for English the
  669. way it is written in the US.
  670.  
  671. =item $h->title
  672.  
  673. The title of the document.  In libwww-perl this header will be
  674. initialized automatically from the E<lt>TITLE>...E<lt>/TITLE> element
  675. of HTML documents.  I<This header is no longer part of the HTTP
  676. standard.>
  677.  
  678. =item $h->user_agent
  679.  
  680. This header field is used in request messages and contains information
  681. about the user agent originating the request.  I<E.g.>:
  682.  
  683.   $h->user_agent('Mozilla/1.2');
  684.  
  685. =item $h->server
  686.  
  687. The server header field contains information about the software being
  688. used by the originating server program handling the request.
  689.  
  690. =item $h->from
  691.  
  692. This header should contain an Internet e-mail address for the human
  693. user who controls the requesting user agent.  The address should be
  694. machine-usable, as defined by RFC822.  E.g.:
  695.  
  696.   $h->from('King Kong <king@kong.com>');
  697.  
  698. I<This header is no longer part of the HTTP standard.>
  699.  
  700. =item $h->referer
  701.  
  702. Used to specify the address (URI) of the document from which the
  703. requested resource address was obtained.
  704.  
  705. The "Free On-line Dictionary of Computing" as this to say about the
  706. word I<referer>:
  707.  
  708.      <World-Wide Web> A misspelling of "referrer" which
  709.      somehow made it into the {HTTP} standard.  A given {web
  710.      page}'s referer (sic) is the {URL} of whatever web page
  711.      contains the link that the user followed to the current
  712.      page.  Most browsers pass this information as part of a
  713.      request.
  714.  
  715.      (1998-10-19)
  716.  
  717. By popular demand C<referrer> exists as an alias for this method so you
  718. can avoid this misspelling in your programs and still send the right
  719. thing on the wire.
  720.  
  721. When setting the referrer, this method removes the fragment from the
  722. given URI if it is present, as mandated by RFC2616.  Note that
  723. the removal does I<not> happen automatically if using the header(),
  724. push_header() or init_header() methods to set the referrer.
  725.  
  726. =item $h->www_authenticate
  727.  
  728. This header must be included as part of a C<401 Unauthorized> response.
  729. The field value consist of a challenge that indicates the
  730. authentication scheme and parameters applicable to the requested URI.
  731.  
  732. =item $h->proxy_authenticate
  733.  
  734. This header must be included in a C<407 Proxy Authentication Required>
  735. response.
  736.  
  737. =item $h->authorization
  738.  
  739. =item $h->proxy_authorization
  740.  
  741. A user agent that wishes to authenticate itself with a server or a
  742. proxy, may do so by including these headers.
  743.  
  744. =item $h->authorization_basic
  745.  
  746. This method is used to get or set an authorization header that use the
  747. "Basic Authentication Scheme".  In array context it will return two
  748. values; the user name and the password.  In scalar context it will
  749. return I<"uname:password"> as a single string value.
  750.  
  751. When used to set the header value, it expects two arguments.  I<E.g.>:
  752.  
  753.   $h->authorization_basic($uname, $password);
  754.  
  755. The method will croak if the $uname contains a colon ':'.
  756.  
  757. =item $h->proxy_authorization_basic
  758.  
  759. Same as authorization_basic() but will set the "Proxy-Authorization"
  760. header instead.
  761.  
  762. =back
  763.  
  764. =head1 NON-CANONICALIZED FIELD NAMES
  765.  
  766. The header field name spelling is normally canonicalized including the
  767. '_' to '-' translation.  There are some application where this is not
  768. appropriate.  Prefixing field names with ':' allow you to force a
  769. specific spelling.  For example if you really want a header field name
  770. to show up as C<foo_bar> instead of "Foo-Bar", you might set it like
  771. this:
  772.  
  773.   $h->header(":foo_bar" => 1);
  774.  
  775. These field names are returned with the ':' intact for
  776. $h->header_field_names and the $h->scan callback, but the colons do
  777. not show in $h->as_string.
  778.  
  779. =head1 COPYRIGHT
  780.  
  781. Copyright 1995-2005 Gisle Aas.
  782.  
  783. This library is free software; you can redistribute it and/or
  784. modify it under the same terms as Perl itself.
  785.  
  786.