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

← Index
NYTProf Performance Profile «block view•line view•sub view»
For 01.HTTP.t
Run on Tue May 4 15:25:55 2010
Reported on Tue May 4 15:26:06 2010

File | /usr/local/lib/perl5/site_perl/5.10.1/HTTP/Response.pm
Statements Executed | 67
Statement Execution Time | 1.53ms

Subroutines — ordered by exclusive time
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 2.39ms | 2.52ms | HTTP::Response::::BEGIN@8HTTP::Response::BEGIN@8
3 | 1 | 1 | 126µs | 314µs | HTTP::Response::::newHTTP::Response::new
9 | 3 | 3 | 68µs | 105µs | HTTP::Response::::codeHTTP::Response::code
9 | 3 | 3 | 63µs | 100µs | HTTP::Response::::requestHTTP::Response::request
3 | 1 | 1 | 33µs | 60µs | HTTP::Response::::redirectsHTTP::Response::redirects
3 | 1 | 1 | 21µs | 33µs | HTTP::Response::::messageHTTP::Response::message
3 | 1 | 1 | 21µs | 35µs | HTTP::Response::::is_successHTTP::Response::is_success
3 | 1 | 1 | 18µs | 27µs | HTTP::Response::::previousHTTP::Response::previous
1 | 1 | 1 | 17µs | 22µs | HTTP::Response::::BEGIN@7HTTP::Response::BEGIN@7
0 | 0 | 0 | 0s | 0s | HTTP::Response::::as_stringHTTP::Response::as_string
0 | 0 | 0 | 0s | 0s | HTTP::Response::::baseHTTP::Response::base
0 | 0 | 0 | 0s | 0s | HTTP::Response::::cloneHTTP::Response::clone
0 | 0 | 0 | 0s | 0s | HTTP::Response::::current_ageHTTP::Response::current_age
0 | 0 | 0 | 0s | 0s | HTTP::Response::::dumpHTTP::Response::dump
0 | 0 | 0 | 0s | 0s | HTTP::Response::::error_as_HTMLHTTP::Response::error_as_HTML
0 | 0 | 0 | 0s | 0s | HTTP::Response::::filenameHTTP::Response::filename
0 | 0 | 0 | 0s | 0s | HTTP::Response::::fresh_untilHTTP::Response::fresh_until
0 | 0 | 0 | 0s | 0s | HTTP::Response::::freshness_lifetimeHTTP::Response::freshness_lifetime
0 | 0 | 0 | 0s | 0s | HTTP::Response::::is_errorHTTP::Response::is_error
0 | 0 | 0 | 0s | 0s | HTTP::Response::::is_freshHTTP::Response::is_fresh
0 | 0 | 0 | 0s | 0s | HTTP::Response::::is_infoHTTP::Response::is_info
0 | 0 | 0 | 0s | 0s | HTTP::Response::::is_redirectHTTP::Response::is_redirect
0 | 0 | 0 | 0s | 0s | HTTP::Response::::parseHTTP::Response::parse
0 | 0 | 0 | 0s | 0s | HTTP::Response::::status_lineHTTP::Response::status_line

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::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 use strict; # 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 use HTTP::Status (); # 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 | 15 | 116µs |  |  | my($class, $rc, $msg, $header, $content) = @_;
15 |  |  |  |  | my $self = $class->SUPER::new($header, $content); # spent 93µs making 3 calls to HTTP::Message::new, avg 31µs/call
16 |  |  |  |  | $self->code($rc); # spent 63µs making 3 calls to HTTP::Response::code, avg 21µs/call
17 |  |  |  |  | $self->message($msg); # spent 33µs making 3 calls to HTTP::Response::message, avg 11µs/call
18 |  |  |  |  | $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 sub code { shift->_elem('_rc', @_); } # 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 sub message { shift->_elem('_msg', @_); } # 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 sub previous { shift->_elem('_previous',@_); } # 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 sub request { shift->_elem('_request', @_); } # 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 sub redirects {
100 | 15 | 29µs |  |  | my $self = shift;
101 |  |  |  |  | my @r;
102 |  |  |  |  | my $r = $self;
103 |  |  |  |  | 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 |  |  |  |  | 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 sub is_success { HTTP::Status::is_success (shift->{'_rc'}); } # 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 |  |  |  |  |