← Index
NYTProf Performance Profile   « block view • line view • sub view »
For ddd2.pl
  Run on Tue May 25 16:52:24 2010
Reported on Tue May 25 16:57:03 2010

File /project/perl/lib/HTTP/Headers.pm
Statements Executed 190903
Statement Execution Time 1.70s
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
875241950ms1.00sHTTP::Headers::::_headerHTTP::Headers::_header
552522162ms803msHTTP::Headers::::push_headerHTTP::Headers::push_header
184432152ms355msHTTP::Headers::::headerHTTP::Headers::header
92222108ms290msHTTP::Headers::::scanHTTP::Headers::scan
105974261.0ms61.0msHTTP::Headers::::CORE:matchHTTP::Headers::CORE:match (opcode)
13832243.6ms43.6msHTTP::Headers::::newHTTP::Headers::new
4611142.8ms88.5msHTTP::Headers::::content_typeHTTP::Headers::content_type
4611134.8ms196msHTTP::Headers::::cloneHTTP::Headers::clone
4611133.0ms35.7msHTTP::Headers::::remove_headerHTTP::Headers::remove_header
9222230.0ms144msHTTP::Headers::::init_headerHTTP::Headers::init_header
9221127.7ms38.9msHTTP::Headers::::_sorted_field_namesHTTP::Headers::_sorted_field_names
4611111.9ms83.8msHTTP::Headers::::__ANON__[:250]HTTP::Headers::__ANON__[:250]
9221211.2ms11.2msHTTP::Headers::::CORE:sortHTTP::Headers::CORE:sort (opcode)
466223.21ms3.21msHTTP::Headers::::CORE:substHTTP::Headers::CORE:subst (opcode)
1712115µs115µsHTTP::Headers::::CORE:substcontHTTP::Headers::CORE:substcont (opcode)
0000s0sHTTP::Headers::::BEGINHTTP::Headers::BEGIN
0000s0sHTTP::Headers::::__ANON__[:240]HTTP::Headers::__ANON__[:240]
0000s0sHTTP::Headers::::_basic_authHTTP::Headers::_basic_auth
0000s0sHTTP::Headers::::_date_headerHTTP::Headers::_date_header
0000s0sHTTP::Headers::::as_stringHTTP::Headers::as_string
0000s0sHTTP::Headers::::authorizationHTTP::Headers::authorization
0000s0sHTTP::Headers::::authorization_basicHTTP::Headers::authorization_basic
0000s0sHTTP::Headers::::clearHTTP::Headers::clear
0000s0sHTTP::Headers::::client_dateHTTP::Headers::client_date
0000s0sHTTP::Headers::::content_encodingHTTP::Headers::content_encoding
0000s0sHTTP::Headers::::content_languageHTTP::Headers::content_language
0000s0sHTTP::Headers::::content_lengthHTTP::Headers::content_length
0000s0sHTTP::Headers::::dateHTTP::Headers::date
0000s0sHTTP::Headers::::expiresHTTP::Headers::expires
0000s0sHTTP::Headers::::fromHTTP::Headers::from
0000s0sHTTP::Headers::::header_field_namesHTTP::Headers::header_field_names
0000s0sHTTP::Headers::::if_modified_sinceHTTP::Headers::if_modified_since
0000s0sHTTP::Headers::::if_unmodified_sinceHTTP::Headers::if_unmodified_since
0000s0sHTTP::Headers::::last_modifiedHTTP::Headers::last_modified
0000s0sHTTP::Headers::::proxy_authenticateHTTP::Headers::proxy_authenticate
0000s0sHTTP::Headers::::proxy_authorizationHTTP::Headers::proxy_authorization
0000s0sHTTP::Headers::::proxy_authorization_basicHTTP::Headers::proxy_authorization_basic
0000s0sHTTP::Headers::::refererHTTP::Headers::referer
0000s0sHTTP::Headers::::remove_content_headersHTTP::Headers::remove_content_headers
0000s0sHTTP::Headers::::serverHTTP::Headers::server
0000s0sHTTP::Headers::::titleHTTP::Headers::title
0000s0sHTTP::Headers::::user_agentHTTP::Headers::user_agent
0000s0sHTTP::Headers::::warningHTTP::Headers::warning
0000s0sHTTP::Headers::::www_authenticateHTTP::Headers::www_authenticate
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package HTTP::Headers;
2
3# $Id: Headers.pm,v 1.64 2005/12/08 12:11:48 gisle Exp $
4
5395µs127µsuse strict;
# spent 27µs making 1 call to strict::import
6367µsuse Carp ();
7
834.64ms1227µsuse vars qw($VERSION $TRANSLATE_UNDERSCORE);
# spent 227µs making 1 call to vars::import
9165µs124µs$VERSION = sprintf("%d.%02d", q$Revision: 1.64 $ =~ /(\d+)\.(\d+)/);
# spent 24µs making 1 call to HTTP::Headers::CORE:match
10
11# The $TRANSLATE_UNDERSCORE variable controls whether '_' can be used
12# as a replacement for '-' in header field names.
1316µs$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
21112µsmy @general_headers = qw(
22 Cache-Control Connection Date Pragma Trailer Transfer-Encoding Upgrade
23 Via Warning
24);
25
26110µsmy @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
3317µsmy @response_headers = qw(
34 Accept-Ranges Age ETag Location Proxy-Authenticate Retry-After Server
35 Vary WWW-Authenticate
36);
37
3817µsmy @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
43130µsmy %entity_header = map { lc($_) => 1 } @entity_headers;
44
45129µsmy @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.
5414µsmy %header_order;
5514µsmy %standard_case;
56
57{
58215µs my $i = 0;
59112µs for (@header_order) {
6047213µs my $lc = lc $_;
6147355µs $header_order{$lc} = ++$i;
6247464µs $standard_case{$lc} = $_;
63 }
64}
65
66
67
68sub new
69
# spent 43.6ms within HTTP::Headers::new which was called 1383 times, avg 32µs/call: # 922 times (29.4ms+0s) by HTTP::Message::new at line 31 of HTTP/Message.pm, avg 32µs/call # 461 times (14.2ms+0s) by HTTP::Headers::clone at line 249, avg 31µs/call
{
7013837.75ms my($class) = shift;
71138312.8ms my $self = bless {}, $class;
7213836.57ms $self->header(@_) if @_; # set up initial headers
73138322.5ms $self;
74}
75
76
77sub header
78
# spent 355ms (152+203) within HTTP::Headers::header which was called 1844 times, avg 192µs/call: # 922 times (80.0ms+124ms) by HTTP::Message::__ANON__[(eval 0)[/project/perl/lib/HTTP/Message.pm:371]:1] at line 1 of (eval 0)[HTTP/Message.pm:371] at line 371 of HTTP/Message.pm, avg 222µs/call # 461 times (37.5ms+40.1ms) by LWP::Protocol::http::request at line 184 of LWP/Protocol/http.pm, avg 168µs/call # 461 times (34.9ms+38.1ms) by LWP::Protocol::http::request at line 202 of LWP/Protocol/http.pm, avg 158µs/call
{
7918448.84ms my $self = shift;
8018448.27ms Carp::croak('Usage: $h->header($field, ...)') unless @_;
8118448.23ms my(@old);
8218448.24ms my %seen;
83184416.8ms while (@_) {
8418449.38ms my $field = shift;
85184412.8ms my $op = @_ ? ($seen{lc($field)}++ ? 'PUSH' : 'SET') : 'GET';
86184440.4ms1844203ms @old = $self->_header($field, shift, $op);
# spent 203ms making 1844 calls to HTTP::Headers::_header, avg 110µs/call
87 }
8818448.10ms return @old if wantarray;
89184427.8ms return $old[0] if @old <= 1;
90 join(", ", @old);
91}
92
93sub clear
94{
95 my $self = shift;
96 %$self = ();
97}
98
99
100sub push_header
101
# spent 803ms (162+641) within HTTP::Headers::push_header which was called 5525 times, avg 145µs/call: # 5064 times (147ms+584ms) by HTTP::Message::__ANON__[(eval 0)[/project/perl/lib/HTTP/Message.pm:371]:1] at line 1 of (eval 0)[HTTP/Message.pm:371] at line 371 of HTTP/Message.pm, avg 144µs/call # 461 times (14.9ms+57.1ms) by HTTP::Headers::__ANON__[/project/perl/lib/HTTP/Headers.pm:250] at line 250, avg 156µs/call
{
102552525.8ms Carp::croak('Usage: $h->push_header($field, $val)') if @_ != 3;
1035525124ms5525641ms shift->_header(@_, 'PUSH');
# spent 641ms making 5525 calls to HTTP::Headers::_header, avg 116µs/call
104}
105
106
107sub init_header
108
# spent 144ms (30.0+114) within HTTP::Headers::init_header which was called 922 times, avg 157µs/call: # 461 times (14.9ms+59.3ms) by HTTP::Message::__ANON__[(eval 0)[/project/perl/lib/HTTP/Message.pm:371]:1] at line 1 of (eval 0)[HTTP/Message.pm:371] at line 371 of HTTP/Message.pm, avg 161µs/call # 461 times (15.1ms+55.1ms) by LWP::Protocol::http::_fixup_header at line 96 of LWP/Protocol/http.pm, avg 152µs/call
{
1099224.86ms Carp::croak('Usage: $h->init_header($field, $val)') if @_ != 3;
11092221.9ms922114ms shift->_header(@_, 'INIT');
# spent 114ms making 922 calls to HTTP::Headers::_header, avg 124µs/call
111}
112
113
114sub remove_header
115
# spent 35.7ms (33.0+2.78) within HTTP::Headers::remove_header which was called 461 times, avg 78µs/call: # 461 times (33.0ms+2.78ms) by HTTP::Message::__ANON__[(eval 0)[/project/perl/lib/HTTP/Message.pm:371]:1] at line 1 of (eval 0)[HTTP/Message.pm:371] at line 371 of HTTP/Message.pm, avg 78µs/call
{
1164612.99ms my($self, @fields) = @_;
1174611.98ms my $field;
1184612.01ms my @values;
1194615.04ms foreach $field (@fields) {
1204619.88ms4612.78ms $field =~ tr/_/-/ if $field !~ /^:/ && $TRANSLATE_UNDERSCORE;
# spent 2.78ms making 461 calls to HTTP::Headers::CORE:match, avg 6µs/call
1214613.05ms my $v = delete $self->{lc $field};
1224615.23ms push(@values, ref($v) eq 'ARRAY' ? @$v : $v) if defined $v;
123 }
1244616.31ms return @values;
125}
126
127sub 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
144sub _header
145
# spent 1.00s (950ms+50.4ms) within HTTP::Headers::_header which was called 8752 times, avg 114µs/call: # 5525 times (610ms+30.8ms) by HTTP::Headers::push_header at line 103, avg 116µs/call # 1844 times (191ms+11.3ms) by HTTP::Headers::header at line 86, avg 110µs/call # 922 times (109ms+5.67ms) by HTTP::Headers::init_header at line 110, avg 124µs/call # 461 times (39.9ms+2.70ms) by HTTP::Headers::content_type at line 285, avg 92µs/call
{
146875251.1ms my($self, $field, $val, $op) = @_;
147
148 # $push is only used interally sub push_header
149875244.2ms Carp::croak('Need a field name') unless length($field);
150
1518752206ms875250.2ms unless ($field =~ /^:/) {
# spent 50.2ms making 8752 calls to HTTP::Headers::CORE:match, avg 6µs/call
152875249.9ms $field =~ tr/_/-/ if $TRANSLATE_UNDERSCORE;
153875240.4ms my $old = $field;
154875242.8ms $field = lc $field;
155875252.3ms unless(defined $standard_case{$field}) {
156 # generate a %standard_case entry for this field
1575398µs22177µs $old =~ s/\b(\w)/\u$1/g;
# spent 115µs making 17 calls to HTTP::Headers::CORE:substcont, avg 7µs/call # spent 62µs making 5 calls to HTTP::Headers::CORE:subst, avg 12µs/call
158538µs $standard_case{$field} = $old;
159 }
160 }
161
162875245.0ms my $h = $self->{$field};
163875250.7ms my @old = ref($h) eq 'ARRAY' ? @$h : (defined($h) ? ($h) : ());
164
165875246.2ms $op ||= defined($val) ? 'SET' : 'GET';
166875275.7ms unless ($op eq 'GET' || ($op eq 'INIT' && @old)) {
167736963.2ms if (defined($val)) {
168736935.3ms my @new = ($op eq 'PUSH') ? @old : ();
169736945.0ms if (ref($val) ne 'ARRAY') {
170 push(@new, $val);
171 }
172 else {
173 push(@new, @$val);
174 }
175736956.4ms $self->{$field} = @new > 1 ? \@new : $new[0];
176 }
177 elsif ($op ne 'PUSH') {
178 delete $self->{$field};
179 }
180 }
1818752130ms @old;
182}
183
184
185sub _sorted_field_names
186
# spent 38.9ms (27.7+11.2) within HTTP::Headers::_sorted_field_names which was called 922 times, avg 42µs/call: # 922 times (27.7ms+11.2ms) by HTTP::Headers::scan at line 207, avg 42µs/call
{
1879224.24ms my $self = shift;
188 return sort {
18992235.9ms92211.2ms ($header_order{$a} || 999) <=> ($header_order{$b} || 999) ||
# spent 11.2ms making 922 calls to HTTP::Headers::CORE:sort, avg 12µs/call
190 $a cmp $b
191 } keys %$self
192}
193
194
195sub 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
203sub scan
204
# spent 290ms (108+182) within HTTP::Headers::scan which was called 922 times, avg 314µs/call: # 461 times (43.1ms+104ms) by HTTP::Headers::clone at line 250, avg 319µs/call # 461 times (64.8ms+77.9ms) by LWP::Protocol::http::request at line 166 of LWP/Protocol/http.pm, avg 310µs/call
{
2059224.99ms my($self, $sub) = @_;
2069223.89ms my $key;
20792227.6ms92238.9ms foreach $key ($self->_sorted_field_names) {
# spent 38.9ms making 922 calls to HTTP::Headers::_sorted_field_names, avg 42µs/call
208138324.7ms13837.99ms next if $key =~ /^_/;
# spent 7.99ms making 1383 calls to HTTP::Headers::CORE:match, avg 6µs/call
20913838.04ms my $vals = $self->{$key};
210138321.1ms if (ref($vals) eq 'ARRAY') {
211 my $val;
212 for $val (@$vals) {
213 &$sub($standard_case{$key} || $key, $val);
214 }
215 }
216 else {
217138324.2ms1383135ms &$sub($standard_case{$key} || $key, $vals);
# spent 83.8ms making 461 calls to HTTP::Headers::__ANON__[HTTP/Headers.pm:250], avg 182µs/call # spent 50.9ms making 922 calls to LWP::Protocol::http::__ANON__[LWP/Protocol/http.pm:166], avg 55µs/call
218 }
219 }
220}
221
222
223sub 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
246sub clone
247
# spent 196ms (34.8+161) within HTTP::Headers::clone which was called 461 times, avg 425µs/call: # 461 times (34.8ms+161ms) by LWP::Protocol::http::request at line 158 of LWP/Protocol/http.pm, avg 425µs/call
{
2484612.24ms my $self = shift;
24946111.6ms46114.2ms my $clone = new HTTP::Headers;
# spent 14.2ms making 461 calls to HTTP::Headers::new, avg 31µs/call
25092225.2ms922219ms
# spent 83.8ms (11.9+72.0) within HTTP::Headers::__ANON__[/project/perl/lib/HTTP/Headers.pm:250] which was called 461 times, avg 182µs/call: # 461 times (11.9ms+72.0ms) by HTTP::Headers::scan at line 217, avg 182µs/call
$self->scan(sub { $clone->push_header(@_);} );
# spent 147ms making 461 calls to HTTP::Headers::scan, avg 319µs/call # spent 72.0ms making 461 calls to HTTP::Headers::push_header, avg 156µs/call
2514616.01ms $clone;
252}
253
254
255sub _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
267sub date { shift->_date_header('Date', @_); }
268sub expires { shift->_date_header('Expires', @_); }
269sub if_modified_since { shift->_date_header('If-Modified-Since', @_); }
270sub if_unmodified_since { shift->_date_header('If-Unmodified-Since', @_); }
271sub 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.
275sub 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
# spent 88.5ms (42.8+45.7) within HTTP::Headers::content_type which was called 461 times, avg 192µs/call: # 461 times (42.8ms+45.7ms) by HTTP::Message::__ANON__[(eval 0)[/project/perl/lib/HTTP/Message.pm:371]:1] at line 1 of (eval 0)[HTTP/Message.pm:371] at line 371 of HTTP/Message.pm, avg 192µs/call
sub content_type {
2854618.04ms46142.6ms my $ct = (shift->_header('Content-Type', @_))[0];
# spent 42.6ms making 461 calls to HTTP::Headers::_header, avg 92µs/call
2864612.32ms return '' unless defined($ct) && length($ct);
2874617.58ms my @ct = split(/;\s*/, $ct, 2);
2884615.00ms for ($ct[0]) {
2894619.58ms4613.15ms s/\s+//g;
# spent 3.15ms making 461 calls to HTTP::Headers::CORE:subst, avg 7µs/call
2904615.56ms $_ = lc($_);
291 }
2924616.89ms wantarray ? @ct : $ct[0];
293}
294
295sub 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}
31119µs*referrer = \&referer; # on tchrist's request
312
313sub title { (shift->_header('Title', @_))[0] }
314sub content_encoding { (shift->_header('Content-Encoding', @_))[0] }
315sub content_language { (shift->_header('Content-Language', @_))[0] }
316sub content_length { (shift->_header('Content-Length', @_))[0] }
317
318sub user_agent { (shift->_header('User-Agent', @_))[0] }
319sub server { (shift->_header('Server', @_))[0] }
320
321sub from { (shift->_header('From', @_))[0] }
322sub warning { (shift->_header('Warning', @_))[0] }
323
324sub www_authenticate { (shift->_header('WWW-Authenticate', @_))[0] }
325sub authorization { (shift->_header('Authorization', @_))[0] }
326
327sub proxy_authenticate { (shift->_header('Proxy-Authenticate', @_))[0] }
328sub proxy_authorization { (shift->_header('Proxy-Authorization', @_))[0] }
329
330sub authorization_basic { shift->_basic_auth("Authorization", @_) }
331sub proxy_authorization_basic { shift->_basic_auth("Proxy-Authorization", @_) }
332
333sub _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
353159µs1;
354
355__END__
356
357=head1 NAME
358
359HTTP::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
372The C<HTTP::Headers> class encapsulates HTTP-style message headers.
373The headers consist of attribute-value pairs also called fields, which
374may be repeated, and which are printed in a particular order. The
375field names are cases insensitive.
376
377Instances of this class are usually created as member variables of the
378C<HTTP::Request> and C<HTTP::Response> classes, internal to the
379library.
380
381The following methods are available:
382
383=over 4
384
385=item $h = HTTP::Headers->new
386
387Constructs a new C<HTTP::Headers> object. You might pass some initial
388attribute-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
395The constructor arguments are passed to the C<header> method which is
396described below.
397
398=item $h->clone
399
400Returns a copy of this C<HTTP::Headers> object.
401
402=item $h->header( $field )
403
404=item $h->header( $field => $value, ... )
405
406Get or set the value of one or more header fields. The header field
407name ($field) is not case sensitive. To make the life easier for perl
408users who wants to avoid quoting before the => operator, you can use
409'_' as a replacement for '-' in header names.
410
411The header() method accepts multiple ($field => $value) pairs, which
412means that you can update several fields with a single invocation.
413
414The $value argument may be a plain string or a reference to an array
415of strings for a multi-valued field. If the $value is provided as
416C<undef> then the field is removed. If the $value is not given, then
417that header field will remain unchanged.
418
419The old value (or values) of the last of the header fields is returned.
420If no such field exists C<undef> will be returned.
421
422A multi-valued field will be returned as separate values in list
423context and will be concatenated with ", " as separator in scalar
424context. The HTTP spec (RFC 2616) promise that joining multiple
425values in this way will not change the semantic of a header field, but
426in practice there are cases like old-style Netscape cookies (see
427L<HTTP::Cookies>) where "," is used as part of the syntax of a single
428field value.
429
430Examples:
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
441Add a new field value for the specified header field. Previous values
442for the same field are retained.
443
444As for the header() method, the field name ($field) is not case
445sensitive and '_' can be used as a replacement for '-'.
446
447The $value argument may be a scalar or a reference to a list of
448scalars.
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
455Set the specified header to the given value, but only if no previous
456value for that field is set.
457
458The header field name ($field) is not case sensitive and '_'
459can be used as a replacement for '-'.
460
461The $value argument may be a scalar or a reference to a list of
462scalars.
463
464=item $h->remove_header( $field, ... )
465
466This function removes the header fields with the specified names.
467
468The header field names ($field) are not case sensitive and '_'
469can be used as a replacement for '-'.
470
471The return value is the values of the fields removed. In scalar
472context the number of fields removed is returned.
473
474Note that if you pass in multiple field names then it is generally not
475possible to tell which of the returned values belonged to which field.
476
477=item $h->remove_content_headers
478
479This will remove all the header fields used to describe the content of
480a message. All header field names prefixed with C<Content-> falls
481into this category, as well as C<Allow>, C<Expires> and
482C<Last-Modified>. RFC 2616 denote these fields as I<Entity Header
483Fields>.
484
485The return value is a new C<HTTP::Headers> object that contains the
486removed headers only.
487
488=item $h->clear
489
490This will remove all header fields.
491
492=item $h->header_field_names
493
494Returns the list of distinct names for the fields present in the
495header. The field names have case as suggested by HTTP spec, and the
496names are returned in the recommended "Good Practice" order.
497
498In scalar context return the number of distinct field names.
499
500=item $h->scan( \&process_header_field )
501
502Apply a subroutine to each header field in turn. The callback routine
503is called with two parameters; the name of the field and a single
504value (a string). If a header field is multi-valued, then the
505routine is called once for each value. The field name passed to the
506callback routine has case as suggested by HTTP spec, and the headers
507will be visited in the recommended "Good Practice" order.
508
509Any return values of the callback routine are ignored. The loop can
510be broken by raising an exception (C<die>), but the caller of scan()
511would have to trap the exception itself.
512
513=item $h->as_string
514
515=item $h->as_string( $eol )
516
517Return the header fields as a formatted MIME header. Since it
518internally uses the C<scan> method to build the string, the result
519will use case as suggested by HTTP spec, and it will follow
520recommended "Good Practice" of ordering the header fields. Long header
521values are not folded.
522
523The optional $eol parameter specifies the line ending sequence to
524use. The default is "\n". Embedded "\n" characters in header field
525values will be substituted with this line ending sequence.
526
527=back
528
529=head1 CONVENIENCE METHODS
530
531The most frequently used headers can also be accessed through the
532following convenience methods. These methods can both be used to read
533and to set the value of a header. The header value is set if you pass
534an argument to the method. The old header value is always returned.
535If the given header did not exist then C<undef> is returned.
536
537Methods that deal with dates/times always convert their value to system
538time (seconds since Jan 1, 1970) and they also expect this kind of
539value when the header value is set.
540
541=over 4
542
543=item $h->date
544
545This header represents the date and time at which the message was
546originated. I<E.g.>:
547
548 $h->date(time); # set current date
549
550=item $h->expires
551
552This header gives the date and time after which the entity should be
553considered stale.
554
555=item $h->if_modified_since
556
557=item $h->if_unmodified_since
558
559These header fields are used to make a request conditional. If the requested
560resource has (or has not) been modified since the time specified in this field,
561then the server will return a C<304 Not Modified> response instead of
562the document itself.
563
564=item $h->last_modified
565
566This header indicates the date and time at which the resource was last
567modified. 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
578The Content-Type header field indicates the media type of the message
579content. I<E.g.>:
580
581 $h->content_type('text/html');
582
583The value returned will be converted to lower case, and potential
584parameters will be chopped off and returned as a separate value if in
585an array context. If there is no such header field, then the empty
586string 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
596The Content-Encoding header field is used as a modifier to the
597media type. When present, its value indicates what additional
598encoding mechanism has been applied to the resource.
599
600=item $h->content_length
601
602A decimal number indicating the size in bytes of the message content.
603
604=item $h->content_language
605
606The natural language(s) of the intended audience for the message
607content. The value is one or more language tags as defined by RFC
6081766. Eg. "no" for some kind of Norwegian and "en-US" for English the
609way it is written in the US.
610
611=item $h->title
612
613The title of the document. In libwww-perl this header will be
614initialized automatically from the E<lt>TITLE>...E<lt>/TITLE> element
615of HTML documents. I<This header is no longer part of the HTTP
616standard.>
617
618=item $h->user_agent
619
620This header field is used in request messages and contains information
621about the user agent originating the request. I<E.g.>:
622
623 $h->user_agent('Mozilla/1.2');
624
625=item $h->server
626
627The server header field contains information about the software being
628used by the originating server program handling the request.
629
630=item $h->from
631
632This header should contain an Internet e-mail address for the human
633user who controls the requesting user agent. The address should be
634machine-usable, as defined by RFC822. E.g.:
635
636 $h->from('King Kong <king@kong.com>');
637
638I<This header is no longer part of the HTTP standard.>
639
640=item $h->referer
641
642Used to specify the address (URI) of the document from which the
643requested resource address was obtained.
644
645The "Free On-line Dictionary of Computing" as this to say about the
646word 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
657By popular demand C<referrer> exists as an alias for this method so you
658can avoid this misspelling in your programs and still send the right
659thing on the wire.
660
661When setting the referrer, this method removes the fragment from the
662given URI if it is present, as mandated by RFC2616. Note that
663the removal does I<not> happen automatically if using the header(),
664push_header() or init_header() methods to set the referrer.
665
666=item $h->www_authenticate
667
668This header must be included as part of a C<401 Unauthorized> response.
669The field value consist of a challenge that indicates the
670authentication scheme and parameters applicable to the requested URI.
671
672=item $h->proxy_authenticate
673
674This header must be included in a C<407 Proxy Authentication Required>
675response.
676
677=item $h->authorization
678
679=item $h->proxy_authorization
680
681A user agent that wishes to authenticate itself with a server or a
682proxy, may do so by including these headers.
683
684=item $h->authorization_basic
685
686This method is used to get or set an authorization header that use the
687"Basic Authentication Scheme". In array context it will return two
688values; the user name and the password. In scalar context it will
689return I<"uname:password"> as a single string value.
690
691When used to set the header value, it expects two arguments. I<E.g.>:
692
693 $h->authorization_basic($uname, $password);
694
695The method will croak if the $uname contains a colon ':'.
696
697=item $h->proxy_authorization_basic
698
699Same as authorization_basic() but will set the "Proxy-Authorization"
700header instead.
701
702=back
703
704=head1 NON-CANONICALIZED FIELD NAMES
705
706The header field name spelling is normally canonicalized including the
707'_' to '-' translation. There are some application where this is not
708appropriate. Prefixing field names with ':' allow you to force a
709specific spelling. For example if you really want a header field name
710to show up as C<foo_bar> instead of "Foo-Bar", you might set it like
711this:
712
713 $h->header(":foo_bar" => 1);
714
715These field names are returned with the ':' intact for
716$h->header_field_names and the $h->scan callback, but the colons do
717not show in $h->as_string.
718
719=head1 COPYRIGHT
720
721Copyright 1995-2005 Gisle Aas.
722
723This library is free software; you can redistribute it and/or
724modify it under the same terms as Perl itself.
725
# spent 61.0ms within HTTP::Headers::CORE:match which was called 10597 times, avg 6µs/call: # 8752 times (50.2ms+0s) by HTTP::Headers::_header at line 151 of HTTP/Headers.pm, avg 6µs/call # 1383 times (7.99ms+0s) by HTTP::Headers::scan at line 208 of HTTP/Headers.pm, avg 6µs/call # 461 times (2.78ms+0s) by HTTP::Headers::remove_header at line 120 of HTTP/Headers.pm, avg 6µs/call # once (24µs+0s) by LWP::UserAgent::BEGIN at line 9 of HTTP/Headers.pm
sub HTTP::Headers::CORE:match; # xsub
# spent 11.2ms within HTTP::Headers::CORE:sort which was called 922 times, avg 12µs/call: # 922 times (11.2ms+0s) by HTTP::Headers::_sorted_field_names at line 189 of HTTP/Headers.pm, avg 12µs/call
sub HTTP::Headers::CORE:sort; # xsub
# spent 3.21ms within HTTP::Headers::CORE:subst which was called 466 times, avg 7µs/call: # 461 times (3.15ms+0s) by HTTP::Headers::content_type at line 289 of HTTP/Headers.pm, avg 7µs/call # 5 times (62µs+0s) by HTTP::Headers::_header at line 157 of HTTP/Headers.pm, avg 12µs/call
sub HTTP::Headers::CORE:subst; # xsub
# spent 115µs within HTTP::Headers::CORE:substcont which was called 17 times, avg 7µs/call: # 17 times (115µs+0s) by HTTP::Headers::_header at line 157 of HTTP/Headers.pm, avg 7µs/call
sub HTTP::Headers::CORE:substcont; # xsub
Report produced by the NYTProf 3.11 Perl profiler, developed by Tim Bunce and Adam Kaplan.