root/trunk/inc/HTTP/Headers.pm

Revision 95, 23.2 kB (checked in by clinton, 4 years ago)

Add LWP to the inc bundle, tid10737 tid10892

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