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