File | /usr/local/lib/perl5/site_perl/5.10.1/HTTP/Headers.pm |
Statements Executed | 14707 |
Statement Execution Time | 20.0ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
615 | 5 | 1 | 7.07ms | 7.40ms | _header | HTTP::Headers::
247 | 5 | 3 | 2.49ms | 5.56ms | header | HTTP::Headers::
205 | 3 | 2 | 2.02ms | 2.12ms | content_type | HTTP::Headers::
122 | 1 | 1 | 1.35ms | 4.08ms | push_header | HTTP::Headers::
41 | 1 | 1 | 1.07ms | 2.49ms | scan | HTTP::Headers::
41 | 1 | 1 | 679µs | 711µs | remove_header | HTTP::Headers::
83 | 2 | 2 | 521µs | 521µs | new | HTTP::Headers::
82 | 2 | 2 | 520µs | 1.31ms | content_is_xhtml | HTTP::Headers::
82 | 2 | 1 | 503µs | 775µs | _sorted_field_names | HTTP::Headers::
41 | 1 | 1 | 445µs | 1.57ms | content_is_html | HTTP::Headers::
82 | 2 | 2 | 413µs | 1.52ms | init_header | HTTP::Headers::
779 | 3 | 2 | 363µs | 363µs | CORE:match (opcode) | HTTP::Headers::
41 | 1 | 1 | 344µs | 651µs | header_field_names | HTTP::Headers::
82 | 1 | 2 | 273µs | 273µs | CORE:sort (opcode) | HTTP::Headers::
41 | 1 | 1 | 264µs | 757µs | content_length | HTTP::Headers::
168 | 2 | 2 | 117µs | 117µs | CORE:subst (opcode) | HTTP::Headers::
14 | 1 | 2 | 22µs | 22µs | CORE:substcont (opcode) | HTTP::Headers::
1 | 1 | 1 | 15µs | 18µs | BEGIN@3 | HTTP::Headers::
1 | 1 | 1 | 6µs | 33µs | BEGIN@6 | HTTP::Headers::
1 | 1 | 1 | 3µs | 3µs | BEGIN@4 | HTTP::Headers::
0 | 0 | 0 | 0s | 0s | __ANON__[:254] | HTTP::Headers::
0 | 0 | 0 | 0s | 0s | __ANON__[:266] | HTTP::Headers::
0 | 0 | 0 | 0s | 0s | __ANON__[:268] | HTTP::Headers::
0 | 0 | 0 | 0s | 0s | _basic_auth | HTTP::Headers::
0 | 0 | 0 | 0s | 0s | _date_header | HTTP::Headers::
0 | 0 | 0 | 0s | 0s | as_string | HTTP::Headers::
0 | 0 | 0 | 0s | 0s | authorization | HTTP::Headers::
0 | 0 | 0 | 0s | 0s | authorization_basic | HTTP::Headers::
0 | 0 | 0 | 0s | 0s | clear | HTTP::Headers::
0 | 0 | 0 | 0s | 0s | client_date | HTTP::Headers::
0 | 0 | 0 | 0s | 0s | content_encoding | HTTP::Headers::
0 | 0 | 0 | 0s | 0s | content_is_text | HTTP::Headers::
0 | 0 | 0 | 0s | 0s | content_is_xml | HTTP::Headers::
0 | 0 | 0 | 0s | 0s | content_language | HTTP::Headers::
0 | 0 | 0 | 0s | 0s | content_type_charset | HTTP::Headers::
0 | 0 | 0 | 0s | 0s | date | HTTP::Headers::
0 | 0 | 0 | 0s | 0s | expires | HTTP::Headers::
0 | 0 | 0 | 0s | 0s | from | HTTP::Headers::
0 | 0 | 0 | 0s | 0s | if_modified_since | HTTP::Headers::
0 | 0 | 0 | 0s | 0s | if_unmodified_since | HTTP::Headers::
0 | 0 | 0 | 0s | 0s | last_modified | HTTP::Headers::
0 | 0 | 0 | 0s | 0s | proxy_authenticate | HTTP::Headers::
0 | 0 | 0 | 0s | 0s | proxy_authorization | HTTP::Headers::
0 | 0 | 0 | 0s | 0s | proxy_authorization_basic | HTTP::Headers::
0 | 0 | 0 | 0s | 0s | referer | HTTP::Headers::
0 | 0 | 0 | 0s | 0s | remove_content_headers | HTTP::Headers::
0 | 0 | 0 | 0s | 0s | server | HTTP::Headers::
0 | 0 | 0 | 0s | 0s | title | HTTP::Headers::
0 | 0 | 0 | 0s | 0s | user_agent | HTTP::Headers::
0 | 0 | 0 | 0s | 0s | warning | HTTP::Headers::
0 | 0 | 0 | 0s | 0s | www_authenticate | HTTP::Headers::
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 # 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 # 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 # 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 | 83 | 76µs | my($class) = shift; | ||
69 | 83 | 245µs | my $self = bless {}, $class; | ||
70 | 83 | 18µs | $self->header(@_) if @_; # set up initial headers | ||
71 | 83 | 316µs | $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 | 247 | 74µs | my $self = shift; | ||
78 | 247 | 71µs | Carp::croak('Usage: $h->header($field, ...)') unless @_; | ||
79 | 247 | 43µs | my(@old); | ||
80 | 247 | 46µs | my %seen; | ||
81 | 247 | 101µs | while (@_) { | ||
82 | 247 | 87µs | my $field = shift; | ||
83 | 247 | 222µs | my $op = @_ ? ($seen{lc($field)}++ ? 'PUSH' : 'SET') : 'GET'; | ||
84 | 247 | 610µs | 247 | 3.07ms | @old = $self->_header($field, shift, $op); # spent 3.07ms making 247 calls to HTTP::Headers::_header, avg 12µs/call |
85 | } | ||||
86 | 247 | 192µs | return @old if wantarray; | ||
87 | 206 | 764µs | 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 | 122 | 44µs | my $self = shift; | ||
101 | 122 | 403µs | 81 | 864µs | return $self->_header(@_, 'PUSH_H') if @_ == 2; # spent 864µs making 81 calls to HTTP::Headers::_header, avg 11µs/call |
102 | 41 | 171µs | while (@_) { | ||
103 | 164 | 481µs | 164 | 1.87ms | $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 | 82 | 66µs | Carp::croak('Usage: $h->init_header($field, $val)') if @_ != 3; | ||
111 | 82 | 305µs | 82 | 1.10ms | 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 | 41 | 78µs | my($self, @fields) = @_; | ||
118 | 41 | 17µs | my $field; | ||
119 | 41 | 14µs | my @values; | ||
120 | 41 | 74µs | foreach $field (@fields) { | ||
121 | 41 | 183µs | 41 | 32µs | $field =~ tr/_/-/ if $field !~ /^:/ && $TRANSLATE_UNDERSCORE; # spent 32µs making 41 calls to HTTP::Headers::CORE:match, avg 778ns/call |
122 | 41 | 80µs | my $v = delete $self->{lc $field}; | ||
123 | 41 | 96µs | push(@values, ref($v) eq 'ARRAY' ? @$v : $v) if defined $v; | ||
124 | } | ||||
125 | 41 | 180µs | 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 | 615 | 524µs | my($self, $field, $val, $op) = @_; | ||
148 | |||||
149 | 615 | 1.74ms | 615 | 294µs | unless ($field =~ /^:/) { # spent 294µs making 615 calls to HTTP::Headers::CORE:match, avg 479ns/call |
150 | 615 | 290µs | $field =~ tr/_/-/ if $TRANSLATE_UNDERSCORE; | ||
151 | 615 | 177µs | my $old = $field; | ||
152 | 615 | 212µs | $field = lc $field; | ||
153 | 615 | 535µs | unless(defined $standard_case{$field}) { | ||
154 | # generate a %standard_case entry for this field | ||||
155 | 4 | 82µs | 18 | 38µs | $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 | 4 | 6µs | $standard_case{$field} = $old; | ||
157 | } | ||||
158 | } | ||||
159 | |||||
160 | 615 | 125µs | $op ||= defined($val) ? 'SET' : 'GET'; | ||
161 | 615 | 224µs | if ($op eq 'PUSH_H') { | ||
162 | # Like PUSH but where we don't care about the return value | ||||
163 | 245 | 117µs | 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 | 245 | 286µs | $self->{$field} = $val; | ||
174 | 245 | 692µs | return; | ||
175 | } | ||||
176 | |||||
177 | 370 | 192µs | my $h = $self->{$field}; | ||
178 | 370 | 325µs | my @old = ref($h) eq 'ARRAY' ? @$h : (defined($h) ? ($h) : ()); | ||
179 | |||||
180 | 370 | 187µs | unless ($op eq 'GET' || ($op eq 'INIT' && @old)) { | ||
181 | 165 | 83µs | if (defined($val)) { | ||
182 | 165 | 66µs | my @new = ($op eq 'PUSH') ? @old : (); | ||
183 | 165 | 195µs | if (ref($val) ne 'ARRAY') { | ||
184 | push(@new, $val); | ||||
185 | } | ||||
186 | else { | ||||
187 | 41 | 42µs | push(@new, @$val); | ||
188 | } | ||||
189 | 165 | 280µs | $self->{$field} = @new > 1 ? \@new : $new[0]; | ||
190 | } | ||||
191 | elsif ($op ne 'PUSH') { | ||||
192 | delete $self->{$field}; | ||||
193 | } | ||||
194 | } | ||||
195 | 370 | 994µs | @old; | ||
196 | } | ||||
197 | |||||
198 | |||||
199 | sub _sorted_field_names | ||||
200 | { | ||||
201 | 82 | 34µs | my $self = shift; | ||
202 | return sort { | ||||
203 | 82 | 797µs | 82 | 273µs | ($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 | ||||
210 | 41 | 26µs | my $self = shift; | ||
211 | 41 | 308µs | 41 | 307µs | 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 | 41 | 52µs | my($self, $sub) = @_; | ||
220 | 41 | 13µs | my $key; | ||
221 | 41 | 196µs | 41 | 468µs | foreach $key ($self->_sorted_field_names) { # spent 468µs making 41 calls to HTTP::Headers::_sorted_field_names, avg 11µs/call |
222 | 123 | 228µs | 123 | 36µs | next if $key =~ /^_/; # spent 36µs making 123 calls to HTTP::Headers::CORE:match, avg 294ns/call |
223 | 123 | 62µs | my $vals = $self->{$key}; | ||
224 | 123 | 101µs | if (ref($vals) eq 'ARRAY') { | ||
225 | my $val; | ||||
226 | for $val (@$vals) { | ||||
227 | &$sub($standard_case{$key} || $key, $val); | ||||
228 | } | ||||
229 | } | ||||
230 | else { | ||||
231 | 123 | 212µs | 123 | 912µs | &$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 | ||||
303 | 205 | 66µs | my $self = shift; | ||
304 | 205 | 109µs | my $ct = $self->{'content-type'}; | ||
305 | 205 | 105µs | $self->{'content-type'} = shift if @_; | ||
306 | 205 | 73µs | $ct = $ct->[0] if ref($ct) eq 'ARRAY'; | ||
307 | 205 | 173µs | return '' unless defined($ct) && length($ct); | ||
308 | 164 | 318µs | my @ct = split(/;\s*/, $ct, 2); | ||
309 | 164 | 137µs | for ($ct[0]) { | ||
310 | 164 | 486µs | 164 | 101µs | s/\s+//g; # spent 101µs making 164 calls to HTTP::Headers::CORE:subst, avg 616ns/call |
311 | 164 | 210µs | $_ = lc($_); | ||
312 | } | ||||
313 | 164 | 543µs | 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 | ||||
348 | 41 | 22µs | my $self = shift; | ||
349 | 41 | 332µs | 82 | 1.12ms | 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 | ||||
353 | 82 | 144µ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 | 82 | 318µs | 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 # 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 | |||||
# 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 | |||||
# 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 | |||||
# 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 |