| 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 | HTTP::Response::BEGIN@8 |
| 3 | 1 | 1 | 126µs | 314µs | HTTP::Response::new |
| 9 | 3 | 3 | 68µs | 105µs | HTTP::Response::code |
| 9 | 3 | 3 | 63µs | 100µs | HTTP::Response::request |
| 3 | 1 | 1 | 33µs | 60µs | HTTP::Response::redirects |
| 3 | 1 | 1 | 21µs | 33µs | HTTP::Response::message |
| 3 | 1 | 1 | 21µs | 35µs | HTTP::Response::is_success |
| 3 | 1 | 1 | 18µs | 27µs | HTTP::Response::previous |
| 1 | 1 | 1 | 17µs | 22µs | HTTP::Response::BEGIN@7 |
| 0 | 0 | 0 | 0s | 0s | HTTP::Response::as_string |
| 0 | 0 | 0 | 0s | 0s | HTTP::Response::base |
| 0 | 0 | 0 | 0s | 0s | HTTP::Response::clone |
| 0 | 0 | 0 | 0s | 0s | HTTP::Response::current_age |
| 0 | 0 | 0 | 0s | 0s | HTTP::Response::dump |
| 0 | 0 | 0 | 0s | 0s | HTTP::Response::error_as_HTML |
| 0 | 0 | 0 | 0s | 0s | HTTP::Response::filename |
| 0 | 0 | 0 | 0s | 0s | HTTP::Response::fresh_until |
| 0 | 0 | 0 | 0s | 0s | HTTP::Response::freshness_lifetime |
| 0 | 0 | 0 | 0s | 0s | HTTP::Response::is_error |
| 0 | 0 | 0 | 0s | 0s | HTTP::Response::is_fresh |
| 0 | 0 | 0 | 0s | 0s | HTTP::Response::is_info |
| 0 | 0 | 0 | 0s | 0s | HTTP::Response::is_redirect |
| 0 | 0 | 0 | 0s | 0s | HTTP::Response::parse |
| 0 | 0 | 0 | 0s | 0s | HTTP::Response::status_line |
| 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 |