File | /usr/local/lib/perl5/site_perl/5.10.1/HTTP/Response.pm |
Statements Executed | 67 |
Statement Execution Time | 1.53ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 2.39ms | 2.52ms | BEGIN@8 | HTTP::Response::
3 | 1 | 1 | 126µs | 314µs | new | HTTP::Response::
9 | 3 | 3 | 68µs | 105µs | code | HTTP::Response::
9 | 3 | 3 | 63µs | 100µs | request | HTTP::Response::
3 | 1 | 1 | 33µs | 60µs | redirects | HTTP::Response::
3 | 1 | 1 | 21µs | 33µs | message | HTTP::Response::
3 | 1 | 1 | 21µs | 35µs | is_success | HTTP::Response::
3 | 1 | 1 | 18µs | 27µs | previous | HTTP::Response::
1 | 1 | 1 | 17µs | 22µs | BEGIN@7 | HTTP::Response::
0 | 0 | 0 | 0s | 0s | as_string | HTTP::Response::
0 | 0 | 0 | 0s | 0s | base | HTTP::Response::
0 | 0 | 0 | 0s | 0s | clone | HTTP::Response::
0 | 0 | 0 | 0s | 0s | current_age | HTTP::Response::
0 | 0 | 0 | 0s | 0s | dump | HTTP::Response::
0 | 0 | 0 | 0s | 0s | error_as_HTML | HTTP::Response::
0 | 0 | 0 | 0s | 0s | filename | HTTP::Response::
0 | 0 | 0 | 0s | 0s | fresh_until | HTTP::Response::
0 | 0 | 0 | 0s | 0s | freshness_lifetime | HTTP::Response::
0 | 0 | 0 | 0s | 0s | is_error | HTTP::Response::
0 | 0 | 0 | 0s | 0s | is_fresh | HTTP::Response::
0 | 0 | 0 | 0s | 0s | is_info | HTTP::Response::
0 | 0 | 0 | 0s | 0s | is_redirect | HTTP::Response::
0 | 0 | 0 | 0s | 0s | parse | HTTP::Response::
0 | 0 | 0 | 0s | 0s | status_line | HTTP::Response::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package HTTP::Response; | ||||
2 | |||||
3 | 1 | 500ns | require HTTP::Message; | ||
4 | 1 | 7µs | @ISA = qw(HTTP::Message); | ||
5 | 1 | 400ns | $VERSION = "5.824"; | ||
6 | |||||
7 | 3 | 23µs | 2 | 28µs | # spent 22µs (17+5) within HTTP::Response::BEGIN@7 which was called
# once (17µs+5µs) by LWP::UserAgent::BEGIN@11 at line 7 # spent 22µs making 1 call to HTTP::Response::BEGIN@7
# spent 5µs making 1 call to strict::import |
8 | 3 | 1.20ms | 1 | 2.52ms | # spent 2.52ms (2.39+127µs) within HTTP::Response::BEGIN@8 which was called
# once (2.39ms+127µs) by LWP::UserAgent::BEGIN@11 at line 8 # spent 2.52ms making 1 call to HTTP::Response::BEGIN@8 |
9 | |||||
10 | |||||
11 | |||||
12 | sub new | ||||
13 | # spent 314µs (126+189) within HTTP::Response::new which was called 3 times, avg 105µs/call:
# 3 times (126µs+189µs) by LWP::Protocol::http::request at line 357 of LWP/Protocol/http.pm, avg 105µs/call | ||||
14 | 3 | 11µs | my($class, $rc, $msg, $header, $content) = @_; | ||
15 | 3 | 62µs | 3 | 93µs | my $self = $class->SUPER::new($header, $content); # spent 93µs making 3 calls to HTTP::Message::new, avg 31µs/call |
16 | 3 | 12µs | 3 | 63µs | $self->code($rc); # spent 63µs making 3 calls to HTTP::Response::code, avg 21µs/call |
17 | 3 | 11µs | 3 | 33µs | $self->message($msg); # spent 33µs making 3 calls to HTTP::Response::message, avg 11µs/call |
18 | 3 | 20µs | $self; | ||
19 | } | ||||
20 | |||||
21 | |||||
22 | sub parse | ||||
23 | { | ||||
24 | my($class, $str) = @_; | ||||
25 | my $status_line; | ||||
26 | if ($str =~ s/^(.*)\n//) { | ||||
27 | $status_line = $1; | ||||
28 | } | ||||
29 | else { | ||||
30 | $status_line = $str; | ||||
31 | $str = ""; | ||||
32 | } | ||||
33 | |||||
34 | my $self = $class->SUPER::parse($str); | ||||
35 | my($protocol, $code, $message); | ||||
36 | if ($status_line =~ /^\d{3} /) { | ||||
37 | # Looks like a response created by HTTP::Response->new | ||||
38 | ($code, $message) = split(' ', $status_line, 2); | ||||
39 | } else { | ||||
40 | ($protocol, $code, $message) = split(' ', $status_line, 3); | ||||
41 | } | ||||
42 | $self->protocol($protocol) if $protocol; | ||||
43 | $self->code($code) if defined($code); | ||||
44 | $self->message($message) if defined($message); | ||||
45 | $self; | ||||
46 | } | ||||
47 | |||||
48 | |||||
49 | sub clone | ||||
50 | { | ||||
51 | my $self = shift; | ||||
52 | my $clone = bless $self->SUPER::clone, ref($self); | ||||
53 | $clone->code($self->code); | ||||
54 | $clone->message($self->message); | ||||
55 | $clone->request($self->request->clone) if $self->request; | ||||
56 | # we don't clone previous | ||||
57 | $clone; | ||||
58 | } | ||||
59 | |||||
60 | |||||
61 | 9 | 50µs | 9 | 36µs | # spent 105µs (68+36) within HTTP::Response::code which was called 9 times, avg 12µs/call:
# 3 times (44µs+19µs) by HTTP::Response::new at line 16, avg 21µs/call
# 3 times (12µs+9µs) by LWP::UserAgent::request at line 274 of LWP/UserAgent.pm, avg 7µs/call
# 3 times (12µs+8µs) by SimpleDB::Client::send_request at line 212 of ../lib/SimpleDB/Client.pm, avg 7µs/call # spent 36µs making 9 calls to HTTP::Message::_elem, avg 4µs/call |
62 | 3 | 18µs | 3 | 12µs | # spent 33µs (21+12) within HTTP::Response::message which was called 3 times, avg 11µs/call:
# 3 times (21µs+12µs) by HTTP::Response::new at line 17, avg 11µs/call # spent 12µs making 3 calls to HTTP::Message::_elem, avg 4µs/call |
63 | 3 | 16µs | 3 | 9µs | # spent 27µs (18+9) within HTTP::Response::previous which was called 3 times, avg 9µs/call:
# 3 times (18µs+9µs) by HTTP::Response::redirects at line 103, avg 9µs/call # spent 9µs making 3 calls to HTTP::Message::_elem, avg 3µs/call |
64 | 9 | 54µs | 9 | 37µs | # spent 100µs (63+37) within HTTP::Response::request which was called 9 times, avg 11µs/call:
# 3 times (25µs+14µs) by LWP::UserAgent::send_request at line 195 of LWP/UserAgent.pm, avg 13µs/call
# 3 times (24µs+12µs) by LWP::Protocol::http::request at line 366 of LWP/Protocol/http.pm, avg 12µs/call
# 3 times (15µs+11µs) by HTTP::Config::matching at line 174 of HTTP/Config.pm, avg 9µs/call # spent 37µs making 9 calls to HTTP::Message::_elem, avg 4µs/call |
65 | |||||
66 | |||||
67 | sub status_line | ||||
68 | { | ||||
69 | my $self = shift; | ||||
70 | my $code = $self->{'_rc'} || "000"; | ||||
71 | my $mess = $self->{'_msg'} || HTTP::Status::status_message($code) || "Unknown code"; | ||||
72 | return "$code $mess"; | ||||
73 | } | ||||
74 | |||||
75 | |||||
76 | sub base | ||||
77 | { | ||||
78 | my $self = shift; | ||||
79 | my $base = $self->header('Content-Base') || # used to be HTTP/1.1 | ||||
80 | $self->header('Content-Location') || # HTTP/1.1 | ||||
81 | $self->header('Base'); # HTTP/1.0 | ||||
82 | if ($base && $base =~ /^$URI::scheme_re:/o) { | ||||
83 | # already absolute | ||||
84 | return $HTTP::URI_CLASS->new($base); | ||||
85 | } | ||||
86 | |||||
87 | my $req = $self->request; | ||||
88 | if ($req) { | ||||
89 | # if $base is undef here, the return value is effectively | ||||
90 | # just a copy of $self->request->uri. | ||||
91 | return $HTTP::URI_CLASS->new_abs($base, $req->uri); | ||||
92 | } | ||||
93 | |||||
94 | # can't find an absolute base | ||||
95 | return undef; | ||||
96 | } | ||||
97 | |||||
98 | |||||
99 | # spent 60µs (33+27) within HTTP::Response::redirects which was called 3 times, avg 20µs/call:
# 3 times (33µs+27µs) by LWP::UserAgent::request at line 264 of LWP/UserAgent.pm, avg 20µs/call | ||||
100 | 3 | 2µs | my $self = shift; | ||
101 | 3 | 900ns | my @r; | ||
102 | 3 | 2µs | my $r = $self; | ||
103 | 3 | 11µs | 3 | 27µs | while (my $p = $r->previous) { # spent 27µs making 3 calls to HTTP::Response::previous, avg 9µs/call |
104 | push(@r, $p); | ||||
105 | $r = $p; | ||||
106 | } | ||||
107 | 3 | 13µs | return @r unless wantarray; | ||
108 | return reverse @r; | ||||
109 | } | ||||
110 | |||||
111 | |||||
112 | sub filename | ||||
113 | { | ||||
114 | my $self = shift; | ||||
115 | my $file; | ||||
116 | |||||
117 | my $cd = $self->header('Content-Disposition'); | ||||
118 | if ($cd) { | ||||
119 | require HTTP::Headers::Util; | ||||
120 | if (my @cd = HTTP::Headers::Util::split_header_words($cd)) { | ||||
121 | my ($disposition, undef, %cd_param) = @{$cd[-1]}; | ||||
122 | $file = $cd_param{filename}; | ||||
123 | |||||
124 | # RFC 2047 encoded? | ||||
125 | if ($file && $file =~ /^=\?(.+?)\?(.+?)\?(.+)\?=$/) { | ||||
126 | my $charset = $1; | ||||
127 | my $encoding = uc($2); | ||||
128 | my $encfile = $3; | ||||
129 | |||||
130 | if ($encoding eq 'Q' || $encoding eq 'B') { | ||||
131 | local($SIG{__DIE__}); | ||||
132 | eval { | ||||
133 | if ($encoding eq 'Q') { | ||||
134 | $encfile =~ s/_/ /g; | ||||
135 | require MIME::QuotedPrint; | ||||
136 | $encfile = MIME::QuotedPrint::decode($encfile); | ||||
137 | } | ||||
138 | else { # $encoding eq 'B' | ||||
139 | require MIME::Base64; | ||||
140 | $encfile = MIME::Base64::decode($encfile); | ||||
141 | } | ||||
142 | |||||
143 | require Encode; | ||||
144 | require encoding; | ||||
145 | # This is ugly use of non-public API, but is there | ||||
146 | # a better way to accomplish what we want (locally | ||||
147 | # as-is usable filename string)? | ||||
148 | my $locale_charset = encoding::_get_locale_encoding(); | ||||
149 | Encode::from_to($encfile, $charset, $locale_charset); | ||||
150 | }; | ||||
151 | |||||
152 | $file = $encfile unless $@; | ||||
153 | } | ||||
154 | } | ||||
155 | } | ||||
156 | } | ||||
157 | |||||
158 | my $uri; | ||||
159 | unless (defined($file) && length($file)) { | ||||
160 | if (my $cl = $self->header('Content-Location')) { | ||||
161 | $uri = URI->new($cl); | ||||
162 | } | ||||
163 | elsif (my $request = $self->request) { | ||||
164 | $uri = $request->uri; | ||||
165 | } | ||||
166 | |||||
167 | if ($uri) { | ||||
168 | $file = ($uri->path_segments)[-1]; | ||||
169 | } | ||||
170 | } | ||||
171 | |||||
172 | if ($file) { | ||||
173 | $file =~ s,.*[\\/],,; # basename | ||||
174 | } | ||||
175 | |||||
176 | if ($file && !length($file)) { | ||||
177 | $file = undef; | ||||
178 | } | ||||
179 | |||||
180 | $file; | ||||
181 | } | ||||
182 | |||||
183 | |||||
184 | sub as_string | ||||
185 | { | ||||
186 | require HTTP::Status; | ||||
187 | my $self = shift; | ||||
188 | my($eol) = @_; | ||||
189 | $eol = "\n" unless defined $eol; | ||||
190 | |||||
191 | my $status_line = $self->status_line; | ||||
192 | my $proto = $self->protocol; | ||||
193 | $status_line = "$proto $status_line" if $proto; | ||||
194 | |||||
195 | return join($eol, $status_line, $self->SUPER::as_string(@_)); | ||||
196 | } | ||||
197 | |||||
198 | |||||
199 | sub dump | ||||
200 | { | ||||
201 | my $self = shift; | ||||
202 | |||||
203 | my $status_line = $self->status_line; | ||||
204 | my $proto = $self->protocol; | ||||
205 | $status_line = "$proto $status_line" if $proto; | ||||
206 | |||||
207 | return $self->SUPER::dump( | ||||
208 | preheader => $status_line, | ||||
209 | @_, | ||||
210 | ); | ||||
211 | } | ||||
212 | |||||
213 | |||||
214 | sub is_info { HTTP::Status::is_info (shift->{'_rc'}); } | ||||
215 | 3 | 19µs | 3 | 14µs | # spent 35µs (21+14) within HTTP::Response::is_success which was called 3 times, avg 12µs/call:
# 3 times (21µs+14µs) by SimpleDB::Client::handle_response at line 248 of ../lib/SimpleDB/Client.pm, avg 12µs/call # spent 14µs making 3 calls to HTTP::Status::is_success, avg 5µs/call |
216 | sub is_redirect { HTTP::Status::is_redirect (shift->{'_rc'}); } | ||||
217 | sub is_error { HTTP::Status::is_error (shift->{'_rc'}); } | ||||
218 | |||||
219 | |||||
220 | sub error_as_HTML | ||||
221 | { | ||||
222 | require HTML::Entities; | ||||
223 | my $self = shift; | ||||
224 | my $title = 'An Error Occurred'; | ||||
225 | my $body = HTML::Entities::encode($self->status_line); | ||||
226 | return <<EOM; | ||||
227 | <html> | ||||
228 | <head><title>$title</title></head> | ||||
229 | <body> | ||||
230 | <h1>$title</h1> | ||||
231 | <p>$body</p> | ||||
232 | </body> | ||||
233 | </html> | ||||
234 | EOM | ||||
235 | } | ||||
236 | |||||
237 | |||||
238 | sub current_age | ||||
239 | { | ||||
240 | my $self = shift; | ||||
241 | my $time = shift; | ||||
242 | |||||
243 | # Implementation of RFC 2616 section 13.2.3 | ||||
244 | # (age calculations) | ||||
245 | my $response_time = $self->client_date; | ||||
246 | my $date = $self->date; | ||||
247 | |||||
248 | my $age = 0; | ||||
249 | if ($response_time && $date) { | ||||
250 | $age = $response_time - $date; # apparent_age | ||||
251 | $age = 0 if $age < 0; | ||||
252 | } | ||||
253 | |||||
254 | my $age_v = $self->header('Age'); | ||||
255 | if ($age_v && $age_v > $age) { | ||||
256 | $age = $age_v; # corrected_received_age | ||||
257 | } | ||||
258 | |||||
259 | if ($response_time) { | ||||
260 | my $request = $self->request; | ||||
261 | if ($request) { | ||||
262 | my $request_time = $request->date; | ||||
263 | if ($request_time && $request_time < $response_time) { | ||||
264 | # Add response_delay to age to get 'corrected_initial_age' | ||||
265 | $age += $response_time - $request_time; | ||||
266 | } | ||||
267 | } | ||||
268 | $age += ($time || time) - $response_time; | ||||
269 | } | ||||
270 | return $age; | ||||
271 | } | ||||
272 | |||||
273 | |||||
274 | sub freshness_lifetime | ||||
275 | { | ||||
276 | my($self, %opt) = @_; | ||||
277 | |||||
278 | # First look for the Cache-Control: max-age=n header | ||||
279 | for my $cc ($self->header('Cache-Control')) { | ||||
280 | for my $cc_dir (split(/\s*,\s*/, $cc)) { | ||||
281 | return $1 if $cc_dir =~ /^max-age\s*=\s*(\d+)/i; | ||||
282 | } | ||||
283 | } | ||||
284 | |||||
285 | # Next possibility is to look at the "Expires" header | ||||
286 | my $date = $self->date || $self->client_date || $opt{time} || time; | ||||
287 | if (my $expires = $self->expires) { | ||||
288 | return $expires - $date; | ||||
289 | } | ||||
290 | |||||
291 | # Must apply heuristic expiration | ||||
292 | return undef if exists $opt{heuristic_expiry} && !$opt{heuristic_expiry}; | ||||
293 | |||||
294 | # Default heuristic expiration parameters | ||||
295 | $opt{h_min} ||= 60; | ||||
296 | $opt{h_max} ||= 24 * 3600; | ||||
297 | $opt{h_lastmod_fraction} ||= 0.10; # 10% since last-mod suggested by RFC2616 | ||||
298 | $opt{h_default} ||= 3600; | ||||
299 | |||||
300 | # Should give a warning if more than 24 hours according to | ||||
301 | # RFC 2616 section 13.2.4. Here we just make this the default | ||||
302 | # maximum value. | ||||
303 | |||||
304 | if (my $last_modified = $self->last_modified) { | ||||
305 | my $h_exp = ($date - $last_modified) * $opt{h_lastmod_fraction}; | ||||
306 | return $opt{h_min} if $h_exp < $opt{h_min}; | ||||
307 | return $opt{h_max} if $h_exp > $opt{h_max}; | ||||
308 | return $h_exp; | ||||
309 | } | ||||
310 | |||||
311 | # default when all else fails | ||||
312 | return $opt{h_min} if $opt{h_min} > $opt{h_default}; | ||||
313 | return $opt{h_default}; | ||||
314 | } | ||||
315 | |||||
316 | |||||
317 | sub is_fresh | ||||
318 | { | ||||
319 | my($self, %opt) = @_; | ||||
320 | $opt{time} ||= time; | ||||
321 | my $f = $self->freshness_lifetime(%opt); | ||||
322 | return undef unless defined($f); | ||||
323 | return $f > $self->current_age($opt{time}); | ||||
324 | } | ||||
325 | |||||
326 | |||||
327 | sub fresh_until | ||||
328 | { | ||||
329 | my($self, %opt) = @_; | ||||
330 | $opt{time} ||= time; | ||||
331 | my $f = $self->freshness_lifetime(%opt); | ||||
332 | return undef unless defined($f); | ||||
333 | return $f - $self->current_age($opt{time}) + $opt{time}; | ||||
334 | } | ||||
335 | |||||
336 | 1 | 4µs | 1; | ||
337 | |||||
338 | |||||
339 | __END__ | ||||
340 | |||||
341 | =head1 NAME | ||||
342 | |||||
343 | HTTP::Response - HTTP style response message | ||||
344 | |||||
345 | =head1 SYNOPSIS | ||||
346 | |||||
347 | Response objects are returned by the request() method of the C<LWP::UserAgent>: | ||||
348 | |||||
349 | # ... | ||||
350 | $response = $ua->request($request) | ||||
351 | if ($response->is_success) { | ||||
352 | print $response->content; | ||||
353 | } | ||||
354 | else { | ||||
355 | print STDERR $response->status_line, "\n"; | ||||
356 | } | ||||
357 | |||||
358 | =head1 DESCRIPTION | ||||
359 | |||||
360 | The C<HTTP::Response> class encapsulates HTTP style responses. A | ||||
361 | response consists of a response line, some headers, and a content | ||||
362 | body. Note that the LWP library uses HTTP style responses even for | ||||
363 | non-HTTP protocol schemes. Instances of this class are usually | ||||
364 | created and returned by the request() method of an C<LWP::UserAgent> | ||||
365 | object. | ||||
366 | |||||
367 | C<HTTP::Response> is a subclass of C<HTTP::Message> and therefore | ||||
368 | inherits its methods. The following additional methods are available: | ||||
369 | |||||
370 | =over 4 | ||||
371 | |||||
372 | =item $r = HTTP::Response->new( $code ) | ||||
373 | |||||
374 | =item $r = HTTP::Response->new( $code, $msg ) | ||||
375 | |||||
376 | =item $r = HTTP::Response->new( $code, $msg, $header ) | ||||
377 | |||||
378 | =item $r = HTTP::Response->new( $code, $msg, $header, $content ) | ||||
379 | |||||
380 | Constructs a new C<HTTP::Response> object describing a response with | ||||
381 | response code $code and optional message $msg. The optional $header | ||||
382 | argument should be a reference to an C<HTTP::Headers> object or a | ||||
383 | plain array reference of key/value pairs. The optional $content | ||||
384 | argument should be a string of bytes. The meaning these arguments are | ||||
385 | described below. | ||||
386 | |||||
387 | =item $r = HTTP::Response->parse( $str ) | ||||
388 | |||||
389 | This constructs a new response object by parsing the given string. | ||||
390 | |||||
391 | =item $r->code | ||||
392 | |||||
393 | =item $r->code( $code ) | ||||
394 | |||||
395 | This is used to get/set the code attribute. The code is a 3 digit | ||||
396 | number that encode the overall outcome of a HTTP response. The | ||||
397 | C<HTTP::Status> module provide constants that provide mnemonic names | ||||
398 | for the code attribute. | ||||
399 | |||||
400 | =item $r->message | ||||
401 | |||||
402 | =item $r->message( $message ) | ||||
403 | |||||
404 | This is used to get/set the message attribute. The message is a short | ||||
405 | human readable single line string that explains the response code. | ||||
406 | |||||
407 | =item $r->header( $field ) | ||||
408 | |||||
409 | =item $r->header( $field => $value ) | ||||
410 | |||||
411 | This is used to get/set header values and it is inherited from | ||||
412 | C<HTTP::Headers> via C<HTTP::Message>. See L<HTTP::Headers> for | ||||
413 | details and other similar methods that can be used to access the | ||||
414 | headers. | ||||
415 | |||||
416 | =item $r->content | ||||
417 | |||||
418 | =item $r->content( $bytes ) | ||||
419 | |||||
420 | This is used to get/set the raw content and it is inherited from the | ||||
421 | C<HTTP::Message> base class. See L<HTTP::Message> for details and | ||||
422 | other methods that can be used to access the content. | ||||
423 | |||||
424 | =item $r->decoded_content( %options ) | ||||
425 | |||||
426 | This will return the content after any C<Content-Encoding> and | ||||
427 | charsets have been decoded. See L<HTTP::Message> for details. | ||||
428 | |||||
429 | =item $r->request | ||||
430 | |||||
431 | =item $r->request( $request ) | ||||
432 | |||||
433 | This is used to get/set the request attribute. The request attribute | ||||
434 | is a reference to the the request that caused this response. It does | ||||
435 | not have to be the same request passed to the $ua->request() method, | ||||
436 | because there might have been redirects and authorization retries in | ||||
437 | between. | ||||
438 | |||||
439 | =item $r->previous | ||||
440 | |||||
441 | =item $r->previous( $response ) | ||||
442 | |||||
443 | This is used to get/set the previous attribute. The previous | ||||
444 | attribute is used to link together chains of responses. You get | ||||
445 | chains of responses if the first response is redirect or unauthorized. | ||||
446 | The value is C<undef> if this is the first response in a chain. | ||||
447 | |||||
448 | Note that the method $r->redirects is provided as a more convenient | ||||
449 | way to access the response chain. | ||||
450 | |||||
451 | =item $r->status_line | ||||
452 | |||||
453 | Returns the string "E<lt>code> E<lt>message>". If the message attribute | ||||
454 | is not set then the official name of E<lt>code> (see L<HTTP::Status>) | ||||
455 | is substituted. | ||||
456 | |||||
457 | =item $r->base | ||||
458 | |||||
459 | Returns the base URI for this response. The return value will be a | ||||
460 | reference to a URI object. | ||||
461 | |||||
462 | The base URI is obtained from one the following sources (in priority | ||||
463 | order): | ||||
464 | |||||
465 | =over 4 | ||||
466 | |||||
467 | =item 1. | ||||
468 | |||||
469 | Embedded in the document content, for instance <BASE HREF="..."> | ||||
470 | in HTML documents. | ||||
471 | |||||
472 | =item 2. | ||||
473 | |||||
474 | A "Content-Base:" or a "Content-Location:" header in the response. | ||||
475 | |||||
476 | For backwards compatibility with older HTTP implementations we will | ||||
477 | also look for the "Base:" header. | ||||
478 | |||||
479 | =item 3. | ||||
480 | |||||
481 | The URI used to request this response. This might not be the original | ||||
482 | URI that was passed to $ua->request() method, because we might have | ||||
483 | received some redirect responses first. | ||||
484 | |||||
485 | =back | ||||
486 | |||||
487 | If none of these sources provide an absolute URI, undef is returned. | ||||
488 | |||||
489 | When the LWP protocol modules produce the HTTP::Response object, then | ||||
490 | any base URI embedded in the document (step 1) will already have | ||||
491 | initialized the "Content-Base:" header. This means that this method | ||||
492 | only performs the last 2 steps (the content is not always available | ||||
493 | either). | ||||
494 | |||||
495 | =item $r->filename | ||||
496 | |||||
497 | Returns a filename for this response. Note that doing sanity checks | ||||
498 | on the returned filename (eg. removing characters that cannot be used | ||||
499 | on the target filesystem where the filename would be used, and | ||||
500 | laundering it for security purposes) are the caller's responsibility; | ||||
501 | the only related thing done by this method is that it makes a simple | ||||
502 | attempt to return a plain filename with no preceding path segments. | ||||
503 | |||||
504 | The filename is obtained from one the following sources (in priority | ||||
505 | order): | ||||
506 | |||||
507 | =over 4 | ||||
508 | |||||
509 | =item 1. | ||||
510 | |||||
511 | A "Content-Disposition:" header in the response. Proper decoding of | ||||
512 | RFC 2047 encoded filenames requires the C<MIME::QuotedPrint> (for "Q" | ||||
513 | encoding), C<MIME::Base64> (for "B" encoding), and C<Encode> modules. | ||||
514 | |||||
515 | =item 2. | ||||
516 | |||||
517 | A "Content-Location:" header in the response. | ||||
518 | |||||
519 | =item 3. | ||||
520 | |||||
521 | The URI used to request this response. This might not be the original | ||||
522 | URI that was passed to $ua->request() method, because we might have | ||||
523 | received some redirect responses first. | ||||
524 | |||||
525 | =back | ||||
526 | |||||
527 | If a filename cannot be derived from any of these sources, undef is | ||||
528 | returned. | ||||
529 | |||||
530 | =item $r->as_string | ||||
531 | |||||
532 | =item $r->as_string( $eol ) | ||||
533 | |||||
534 | Returns a textual representation of the response. | ||||
535 | |||||
536 | =item $r->is_info | ||||
537 | |||||
538 | =item $r->is_success | ||||
539 | |||||
540 | =item $r->is_redirect | ||||
541 | |||||
542 | =item $r->is_error | ||||
543 | |||||
544 | These methods indicate if the response was informational, successful, a | ||||
545 | redirection, or an error. See L<HTTP::Status> for the meaning of these. | ||||
546 | |||||
547 | =item $r->error_as_HTML | ||||
548 | |||||
549 | Returns a string containing a complete HTML document indicating what | ||||
550 | error occurred. This method should only be called when $r->is_error | ||||
551 | is TRUE. | ||||
552 | |||||
553 | =item $r->redirects | ||||
554 | |||||
555 | Returns the list of redirect responses that lead up to this response | ||||
556 | by following the $r->previous chain. The list order is oldest first. | ||||
557 | |||||
558 | In scalar context return the number of redirect responses leading up | ||||
559 | to this one. | ||||
560 | |||||
561 | =item $r->current_age | ||||
562 | |||||
563 | Calculates the "current age" of the response as specified by RFC 2616 | ||||
564 | section 13.2.3. The age of a response is the time since it was sent | ||||
565 | by the origin server. The returned value is a number representing the | ||||
566 | age in seconds. | ||||
567 | |||||
568 | =item $r->freshness_lifetime( %opt ) | ||||
569 | |||||
570 | Calculates the "freshness lifetime" of the response as specified by | ||||
571 | RFC 2616 section 13.2.4. The "freshness lifetime" is the length of | ||||
572 | time between the generation of a response and its expiration time. | ||||
573 | The returned value is the number of seconds until expiry. | ||||
574 | |||||
575 | If the response does not contain an "Expires" or a "Cache-Control" | ||||
576 | header, then this function will apply some simple heuristic based on | ||||
577 | the "Last-Modified" header to determine a suitable lifetime. The | ||||
578 | following options might be passed to control the heuristics: | ||||
579 | |||||
580 | =over | ||||
581 | |||||
582 | =item heuristic_expiry => $bool | ||||
583 | |||||
584 | If passed as a FALSE value, don't apply heuristics and just return | ||||
585 | C<undef> when "Expires" or "Cache-Control" is lacking. | ||||
586 | |||||
587 | =item h_lastmod_fraction => $num | ||||
588 | |||||
589 | This number represent the fraction of the difference since the | ||||
590 | "Last-Modified" timestamp to make the expiry time. The default is | ||||
591 | C<0.10>, the suggested typical setting of 10% in RFC 2616. | ||||
592 | |||||
593 | =item h_min => $sec | ||||
594 | |||||
595 | This is the lower limit of the heuristic expiry age to use. The | ||||
596 | default is C<60> (1 minute). | ||||
597 | |||||
598 | =item h_max => $sec | ||||
599 | |||||
600 | This is the upper limit of the heuristic expiry age to use. The | ||||
601 | default is C<86400> (24 hours). | ||||
602 | |||||
603 | =item h_default => $sec | ||||
604 | |||||
605 | This is the expiry age to use when nothing else applies. The default | ||||
606 | is C<3600> (1 hour) or "h_min" if greater. | ||||
607 | |||||
608 | =back | ||||
609 | |||||
610 | =item $r->is_fresh( %opt ) | ||||
611 | |||||
612 | Returns TRUE if the response is fresh, based on the values of | ||||
613 | freshness_lifetime() and current_age(). If the response is no longer | ||||
614 | fresh, then it has to be re-fetched or re-validated by the origin | ||||
615 | server. | ||||
616 | |||||
617 | Options might be passed to control expiry heuristics, see the | ||||
618 | description of freshness_lifetime(). | ||||
619 | |||||
620 | =item $r->fresh_until( %opt ) | ||||
621 | |||||
622 | Returns the time (seconds since epoch) when this entity is no longer fresh. | ||||
623 | |||||
624 | Options might be passed to control expiry heuristics, see the | ||||
625 | description of freshness_lifetime(). | ||||
626 | |||||
627 | =back | ||||
628 | |||||
629 | =head1 SEE ALSO | ||||
630 | |||||
631 | L<HTTP::Headers>, L<HTTP::Message>, L<HTTP::Status>, L<HTTP::Request> | ||||
632 | |||||
633 | =head1 COPYRIGHT | ||||
634 | |||||
635 | Copyright 1995-2004 Gisle Aas. | ||||
636 | |||||
637 | This library is free software; you can redistribute it and/or | ||||
638 | modify it under the same terms as Perl itself. | ||||
639 |