Profile of /usr/local/lib/perl5/site_perl/5.10.1/HTTP/Headers.pm

← Index
NYTProf Performance Profile «block view•line view•sub view»
For 05.Domain_and_Item.t
Run on Tue May 4 17:21:41 2010
Reported on Tue May 4 17:22:21 2010

File | /usr/local/lib/perl5/site_perl/5.10.1/HTTP/Headers.pm
Statements Executed | 14707
Statement Execution Time | 20.0ms

Subroutines — ordered by exclusive time
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
615 | 5 | 1 | 7.07ms | 7.40ms | HTTP::Headers::::_headerHTTP::Headers::_header
247 | 5 | 3 | 2.49ms | 5.56ms | HTTP::Headers::::headerHTTP::Headers::header
205 | 3 | 2 | 2.02ms | 2.12ms | HTTP::Headers::::content_typeHTTP::Headers::content_type
122 | 1 | 1 | 1.35ms | 4.08ms | HTTP::Headers::::push_headerHTTP::Headers::push_header
41 | 1 | 1 | 1.07ms | 2.49ms | HTTP::Headers::::scanHTTP::Headers::scan
41 | 1 | 1 | 679µs | 711µs | HTTP::Headers::::remove_headerHTTP::Headers::remove_header
83 | 2 | 2 | 521µs | 521µs | HTTP::Headers::::newHTTP::Headers::new
82 | 2 | 2 | 520µs | 1.31ms | HTTP::Headers::::content_is_xhtmlHTTP::Headers::content_is_xhtml
82 | 2 | 1 | 503µs | 775µs | HTTP::Headers::::_sorted_field_namesHTTP::Headers::_sorted_field_names
41 | 1 | 1 | 445µs | 1.57ms | HTTP::Headers::::content_is_htmlHTTP::Headers::content_is_html
82 | 2 | 2 | 413µs | 1.52ms | HTTP::Headers::::init_headerHTTP::Headers::init_header
779 | 3 | 2 | 363µs | 363µs | HTTP::Headers::::CORE:matchHTTP::Headers::CORE:match (opcode)
41 | 1 | 1 | 344µs | 651µs | HTTP::Headers::::header_field_namesHTTP::Headers::header_field_names
82 | 1 | 2 | 273µs | 273µs | HTTP::Headers::::CORE:sortHTTP::Headers::CORE:sort (opcode)
41 | 1 | 1 | 264µs | 757µs | HTTP::Headers::::content_lengthHTTP::Headers::content_length
168 | 2 | 2 | 117µs | 117µs | HTTP::Headers::::CORE:substHTTP::Headers::CORE:subst (opcode)
14 | 1 | 2 | 22µs | 22µs | HTTP::Headers::::CORE:substcontHTTP::Headers::CORE:substcont (opcode)
1 | 1 | 1 | 15µs | 18µs | HTTP::Headers::::BEGIN@3HTTP::Headers::BEGIN@3
1 | 1 | 1 | 6µs | 33µs | HTTP::Headers::::BEGIN@6HTTP::Headers::BEGIN@6
1 | 1 | 1 | 3µs | 3µs | HTTP::Headers::::BEGIN@4HTTP::Headers::BEGIN@4
0 | 0 | 0 | 0s | 0s | HTTP::Headers::::__ANON__[:254]HTTP::Headers::__ANON__[:254]
0 | 0 | 0 | 0s | 0s | HTTP::Headers::::__ANON__[:266]HTTP::Headers::__ANON__[:266]
0 | 0 | 0 | 0s | 0s | HTTP::Headers::::__ANON__[:268]HTTP::Headers::__ANON__[:268]
0 | 0 | 0 | 0s | 0s | HTTP::Headers::::_basic_authHTTP::Headers::_basic_auth
0 | 0 | 0 | 0s | 0s | HTTP::Headers::::_date_headerHTTP::Headers::_date_header
0 | 0 | 0 | 0s | 0s | HTTP::Headers::::as_stringHTTP::Headers::as_string
0 | 0 | 0 | 0s | 0s | HTTP::Headers::::authorizationHTTP::Headers::authorization
0 | 0 | 0 | 0s | 0s | HTTP::Headers::::authorization_basicHTTP::Headers::authorization_basic
0 | 0 | 0 | 0s | 0s | HTTP::Headers::::clearHTTP::Headers::clear
0 | 0 | 0 | 0s | 0s | HTTP::Headers::::client_dateHTTP::Headers::client_date
0 | 0 | 0 | 0s | 0s | HTTP::Headers::::content_encodingHTTP::Headers::content_encoding
0 | 0 | 0 | 0s | 0s | HTTP::Headers::::content_is_textHTTP::Headers::content_is_text
0 | 0 | 0 | 0s | 0s | HTTP::Headers::::content_is_xmlHTTP::Headers::content_is_xml
0 | 0 | 0 | 0s | 0s | HTTP::Headers::::content_languageHTTP::Headers::content_language
0 | 0 | 0 | 0s | 0s | HTTP::Headers::::content_type_charsetHTTP::Headers::content_type_charset
0 | 0 | 0 | 0s | 0s | HTTP::Headers::::dateHTTP::Headers::date
0 | 0 | 0 | 0s | 0s | HTTP::Headers::::expiresHTTP::Headers::expires
0 | 0 | 0 | 0s | 0s | HTTP::Headers::::fromHTTP::Headers::from
0 | 0 | 0 | 0s | 0s | HTTP::Headers::::if_modified_sinceHTTP::Headers::if_modified_since
0 | 0 | 0 | 0s | 0s | HTTP::Headers::::if_unmodified_sinceHTTP::Headers::if_unmodified_since
0 | 0 | 0 | 0s | 0s | HTTP::Headers::::last_modifiedHTTP::Headers::last_modified
0 | 0 | 0 | 0s | 0s | HTTP::Headers::::proxy_authenticateHTTP::Headers::proxy_authenticate
0 | 0 | 0 | 0s | 0s | HTTP::Headers::::proxy_authorizationHTTP::Headers::proxy_authorization
0 | 0 | 0 | 0s | 0s | HTTP::Headers::::proxy_authorization_basicHTTP::Headers::proxy_authorization_basic
0 | 0 | 0 | 0s | 0s | HTTP::Headers::::refererHTTP::Headers::referer
0 | 0 | 0 | 0s | 0s | HTTP::Headers::::remove_content_headersHTTP::Headers::remove_content_headers
0 | 0 | 0 | 0s | 0s | HTTP::Headers::::serverHTTP::Headers::server
0 | 0 | 0 | 0s | 0s | HTTP::Headers::::titleHTTP::Headers::title
0 | 0 | 0 | 0s | 0s | HTTP::Headers::::user_agentHTTP::Headers::user_agent
0 | 0 | 0 | 0s | 0s | HTTP::Headers::::warningHTTP::Headers::warning
0 | 0 | 0 | 0s | 0s | HTTP::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
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package HTTP::Headers;
2 |  |  |  |  |
3 | 3 | 28µs | 2 | 21µs | # spent 18µs (15+3) within HTTP::Headers::BEGIN@3 which was called # once (15µs+3µs) by LWP::UserAgent::BEGIN@10 at line 3 use strict; # spent 18µs making 1 call to HTTP::Headers::BEGIN@3 # spent 3µs making 1 call to strict::import
4 | 3 | 24µs | 1 | 3µs | # spent 3µs within HTTP::Headers::BEGIN@4 which was called # once (3µs+0s) by LWP::UserAgent::BEGIN@10 at line 4 use Carp (); # spent 3µs making 1 call to HTTP::Headers::BEGIN@4
5 |  |  |  |  |
6 | 3 | 2.02ms | 2 | 61µs | # spent 33µs (6+28) within HTTP::Headers::BEGIN@6 which was called # once (6µs+28µs) by LWP::UserAgent::BEGIN@10 at line 6 use vars qw($VERSION $TRANSLATE_UNDERSCORE); # spent 33µs making 1 call to HTTP::Headers::BEGIN@6 # spent 28µs making 1 call to vars::import
7 | 1 | 900ns |  |  | $VERSION = "5.827";
8 |  |  |  |  |
9 |  |  |  |  | # The $TRANSLATE_UNDERSCORE variable controls whether '_' can be used
10 |  |  |  |  | # as a replacement for '-' in header field names.
11 | 1 | 500ns |  |  | $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 | 1 | 4µs |  |  | my @general_headers = qw(
20 |  |  |  |  | Cache-Control Connection Date Pragma Trailer Transfer-Encoding Upgrade
21 |  |  |  |  | Via Warning
22 |  |  |  |  | );
23 |  |  |  |  |
24 | 1 | 4µs |  |  | 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 | 1 | 2µs |  |  | my @response_headers = qw(
32 |  |  |  |  | Accept-Ranges Age ETag Location Proxy-Authenticate Retry-After Server
33 |  |  |  |  | Vary WWW-Authenticate
34 |  |  |  |  | );
35 |  |  |  |  |
36 | 1 | 2µs |  |  | 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 | 1 | 17µs |  |  | my %entity_header = map { lc($_) => 1 } @entity_headers;
42 |  |  |  |  |
43 | 1 | 16µs |  |  | 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 | 1 | 100ns |  |  | my %header_order;
53 | 1 | 0s |  |  | my %standard_case;
54 |  |  |  |  |
55 |  |  |  |  | {
56 | 2 | 1µs |  |  | my $i = 0;
57 | 1 | 900ns |  |  | for (@header_order) {
58 | 47 | 7µs |  |  | my $lc = lc $_;
59 | 47 | 24µs |  |  | $header_order{$lc} = ++$i;
60 | 47 | 29µs |  |  | $standard_case{$lc} = $_;
61 |  |  |  |  | }
62 |  |  |  |  | }
63 |  |  |  |  |
64 |  |  |  |  |
65 |  |  |  |  |
66 |  |  |  |  | sub new
67 |  |  |  |  | # spent 521µs within HTTP::Headers::new which was called 83 times, avg 6µs/call: # 82 times (512µs+0s) by HTTP::Message::new at line 36 of HTTP/Message.pm, avg 6µs/call # once (10µs+0s) by LWP::UserAgent::default_headers at line 643 of LWP/UserAgent.pm {
68 | 332 | 655µs |  |  | 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 |  |  |  |  | # spent 5.56ms (2.49+3.07) within HTTP::Headers::header which was called 247 times, avg 23µs/call: # 123 times (1.46ms+1.91ms) by HTTP::Message::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/HTTP/Message.pm:622] at line 622 of HTTP/Message.pm, avg 27µs/call # 41 times (450µs+561µs) by LWP::UserAgent::prepare_request at line 217 of LWP/UserAgent.pm, avg 25µs/call # 41 times (318µs+304µs) by LWP::Protocol::http::request at line 185 of LWP/Protocol/http.pm, avg 15µs/call # 41 times (251µs+269µs) by LWP::Protocol::http::request at line 203 of LWP/Protocol/http.pm, avg 13µs/call # once (16µs+27µs) by LWP::UserAgent::default_header at line 654 of LWP/UserAgent.pm {
77 | 2429 | 2.21ms |  |  | 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); # spent 3.07ms making 247 calls to HTTP::Headers::_header, avg 12µs/call
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 |  |  |  |  | # spent 4.08ms (1.35+2.73) within HTTP::Headers::push_header which was called 122 times, avg 33µs/call: # 122 times (1.35ms+2.73ms) by HTTP::Message::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/HTTP/Message.pm:622] at line 622 of HTTP/Message.pm, avg 33µs/call {
100 | 449 | 1.10ms |  |  | my $self = shift;
101 |  |  |  |  | return $self->_header(@_, 'PUSH_H') if @_ == 2; # spent 864µs making 81 calls to HTTP::Headers::_header, avg 11µs/call
102 |  |  |  |  | while (@_) {
103 |  |  |  |  | $self->_header(splice(@_, 0, 2), 'PUSH_H'); # spent 1.87ms making 164 calls to HTTP::Headers::_header, avg 11µs/call
104 |  |  |  |  | }
105 |  |  |  |  | }
106 |  |  |  |  |
107 |  |  |  |  |
108 |  |  |  |  | sub init_header
109 |  |  |  |  | # spent 1.52ms (413µs+1.10) within HTTP::Headers::init_header which was called 82 times, avg 19µs/call: # 41 times (236µs+545µs) by HTTP::Message::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/HTTP/Message.pm:622] at line 622 of HTTP/Message.pm, avg 19µs/call # 41 times (177µs+560µs) by LWP::Protocol::http::_fixup_header at line 98 of LWP/Protocol/http.pm, avg 18µs/call {
110 | 164 | 371µs |  |  | Carp::croak('Usage: $h->init_header($field, $val)') if @_ != 3;
111 |  |  |  |  | shift->_header(@_, 'INIT'); # spent 1.10ms making 82 calls to HTTP::Headers::_header, avg 13µs/call
112 |  |  |  |  | }
113 |  |  |  |  |
114 |  |  |  |  |
115 |  |  |  |  | sub remove_header
116 |  |  |  |  | # spent 711µs (679+32) within HTTP::Headers::remove_header which was called 41 times, avg 17µs/call: # 41 times (679µs+32µs) by HTTP::Message::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/HTTP/Message.pm:622] at line 622 of HTTP/Message.pm, avg 17µs/call {
117 | 328 | 722µs |  |  | my($self, @fields) = @_;
118 |  |  |  |  | my $field;
119 |  |  |  |  | my @values;
120 |  |  |  |  | foreach $field (@fields) {
121 |  |  |  |  | $field =~ tr/_/-/ if $field !~ /^:/ && $TRANSLATE_UNDERSCORE; # spent 32µs making 41 calls to HTTP::Headers::CORE:match, avg 778ns/call
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 |  |  |  |  | # spent 7.40ms (7.07+332µs) within HTTP::Headers::_header which was called 615 times, avg 12µs/call: # 247 times (2.93ms+140µs) by HTTP::Headers::header at line 84, avg 12µs/call # 164 times (1.78ms+87µs) by HTTP::Headers::push_header at line 103, avg 11µs/call # 82 times (1.08ms+28µs) by HTTP::Headers::init_header at line 111, avg 13µs/call # 81 times (810µs+53µs) by HTTP::Headers::push_header at line 101, avg 11µs/call # 41 times (468µs+24µs) by HTTP::Headers::content_length at line 387, avg 12µs/call {
147 | 7844 | 7.37ms |  |  | my($self, $field, $val, $op) = @_;
148 |  |  |  |  |
149 |  |  |  |  | unless ($field =~ /^:/) { # spent 294µs making 615 calls to HTTP::Headers::CORE:match, avg 479ns/call
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; # spent 22µs making 14 calls to HTTP::Headers::CORE:substcont, avg 2µs/call # spent 16µs making 4 calls to HTTP::Headers::CORE:subst, avg 4µs/call
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 |  |  |  |  | # spent 775µs (503+273) within HTTP::Headers::_sorted_field_names which was called 82 times, avg 9µs/call: # 41 times (222µs+246µs) by HTTP::Headers::scan at line 221, avg 11µs/call # 41 times (280µs+27µs) by HTTP::Headers::header_field_names at line 211, avg 7µs/call {
201 | 164 | 831µs |  |  | my $self = shift;
202 |  |  |  |  | return sort {
203 |  |  |  |  | ($header_order{$a} || 999) <=> ($header_order{$b} || 999) || # spent 273µs making 82 calls to HTTP::Headers::CORE:sort, avg 3µs/call
204 |  |  |  |  | $a cmp $b
205 |  |  |  |  | } keys %$self
206 |  |  |  |  | }
207 |  |  |  |  |
208 |  |  |  |  |
209 |  |  |  |  | # spent 651µs (344+307) within HTTP::Headers::header_field_names which was called 41 times, avg 16µs/call: # 41 times (344µs+307µs) by LWP::UserAgent::prepare_request at line 215 of LWP/UserAgent.pm, avg 16µs/call sub header_field_names {
210 | 82 | 334µs |  |  | my $self = shift;
211 |  |  |  |  | return map $standard_case{$_} || $_, $self->_sorted_field_names # spent 307µs making 41 calls to HTTP::Headers::_sorted_field_names, avg 7µs/call
212 |  |  |  |  | if wantarray;
213 |  |  |  |  | return keys %$self;
214 |  |  |  |  | }
215 |  |  |  |  |
216 |  |  |  |  |
217 |  |  |  |  | sub scan
218 |  |  |  |  | # spent 2.49ms (1.07+1.42) within HTTP::Headers::scan which was called 41 times, avg 61µs/call: # 41 times (1.07ms+1.42ms) by LWP::Protocol::http::request at line 167 of LWP/Protocol/http.pm, avg 61µs/call {
219 | 615 | 863µs |  |  | my($self, $sub) = @_;
220 |  |  |  |  | my $key;
221 |  |  |  |  | foreach $key ($self->_sorted_field_names) { # spent 468µs making 41 calls to HTTP::Headers::_sorted_field_names, avg 11µs/call
222 |  |  |  |  | next if $key =~ /^_/; # spent 36µs making 123 calls to HTTP::Headers::CORE:match, avg 294ns/call
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); # spent 912µs making 123 calls to LWP::Protocol::http::__ANON__[LWP/Protocol/http.pm:167], avg 7µs/call
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 | 3 | 3µs |  |  | 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 |  |  |  |  | # spent 2.12ms (2.02+101µs) within HTTP::Headers::content_type which was called 205 times, avg 10µs/call: # 82 times (885µs+33µs) by HTTP::Message::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/HTTP/Message.pm:622] at line 622 of HTTP/Message.pm, avg 11µs/call # 82 times (743µs+44µs) by HTTP::Headers::content_is_xhtml at line 353, avg 10µs/call # 41 times (394µs+24µs) by HTTP::Headers::content_is_html at line 349, avg 10µs/call sub content_type {
303 | 1845 | 2.22ms |  |  | 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; # spent 101µs making 164 calls to HTTP::Headers::CORE:subst, avg 616ns/call
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 |  |  |  |  | # spent 1.57ms (445µs+1.12) within HTTP::Headers::content_is_html which was called 41 times, avg 38µs/call: # 41 times (445µs+1.12ms) by HTTP::Message::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/HTTP/Message.pm:622] at line 622 of HTTP/Message.pm, avg 38µs/call sub content_is_html {
348 | 82 | 354µs |  |  | my $self = shift;
349 |  |  |  |  | return $self->content_type eq 'text/html' || $self->content_is_xhtml; # spent 704µs making 41 calls to HTTP::Headers::content_is_xhtml, avg 17µs/call # spent 418µs making 41 calls to HTTP::Headers::content_type, avg 10µs/call
350 |  |  |  |  | }
351 |  |  |  |  |
352 |  |  |  |  | # spent 1.31ms (520µs+787µs) within HTTP::Headers::content_is_xhtml which was called 82 times, avg 16µs/call: # 41 times (320µs+384µs) by HTTP::Headers::content_is_html at line 349, avg 17µs/call # 41 times (201µs+403µs) by HTTP::Message::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/HTTP/Message.pm:622] at line 622 of HTTP/Message.pm, avg 15µs/call sub content_is_xhtml {
353 | 164 | 462µs | 82 | 787µs | my $ct = shift->content_type; # spent 787µs making 82 calls to HTTP::Headers::content_type, avg 10µs/call
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 | 1 | 400ns |  |  | *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 | 41 | 249µs | 41 | 493µs | # spent 757µs (264+493) within HTTP::Headers::content_length which was called 41 times, avg 18µs/call: # 41 times (264µs+493µs) by HTTP::Message::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/HTTP/Message.pm:622] at line 622 of HTTP/Message.pm, avg 18µs/call sub content_length { (shift->_header('Content-Length', @_))[0] } # spent 493µs making 41 calls to HTTP::Headers::_header, avg 12µs/call
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 | 42µs |  |  | 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 |  |  |  |  |
|  |  |  |  | # spent 363µs within HTTP::Headers::CORE:match which was called 779 times, avg 465ns/call: # 615 times (294µs+0s) by HTTP::Headers::_header at line 149 of HTTP/Headers.pm, avg 479ns/call # 123 times (36µs+0s) by HTTP::Headers::scan at line 222 of HTTP/Headers.pm, avg 294ns/call # 41 times (32µs+0s) by HTTP::Headers::remove_header at line 121 of HTTP/Headers.pm, avg 778ns/call sub HTTP::Headers::CORE:match; # xsub
|  |  |  |  | # spent 273µs within HTTP::Headers::CORE:sort which was called 82 times, avg 3µs/call: # 82 times (273µs+0s) by HTTP::Headers::_sorted_field_names at line 203 of HTTP/Headers.pm, avg 3µs/call sub HTTP::Headers::CORE:sort; # xsub
|  |  |  |  | # spent 117µs within HTTP::Headers::CORE:subst which was called 168 times, avg 699ns/call: # 164 times (101µs+0s) by HTTP::Headers::content_type at line 310 of HTTP/Headers.pm, avg 616ns/call # 4 times (16µs+0s) by HTTP::Headers::_header at line 155 of HTTP/Headers.pm, avg 4µs/call sub HTTP::Headers::CORE:subst; # xsub
|  |  |  |  | # spent 22µs within HTTP::Headers::CORE:substcont which was called 14 times, avg 2µs/call: # 14 times (22µs+0s) by HTTP::Headers::_header at line 155 of HTTP/Headers.pm, avg 2µs/call sub HTTP::Headers::CORE:substcont; # xsub