use v6-alpha; use HTTP::Status (); use HTTP::Message; class HTTP::Response[?::URI_CLASS = URI] { is HTTP::Message; has $.code is rw; has $.message is rw; has $.previous is rw; has $.request is rw; submethod BUILD (:$.code, :$.message) { } method parse (Str $str is copy) { my $status_line; if ($str ~~ s/^(.*)\n//) { $status_line = $0; } else { $status_line = $str; $str = ""; } my $self = self.SUPER::parse($str); given ($self) { my ($protocol, $code, $message); if ($status_line ~~ /^\d**{3}/) { # Looks like a response created by HTTP::Response.new ($code, $message) = $status_line.split(' ', 2); } else { ($protocol, $code, $message) = $status_line.split(' ', 3); } .protocol($protocol) if $protocol.defined; .code($code) if $code.defined; .message($message) if $message.defined; } $self; } method status_line () { my $code = .code // "000"; my $mess = $.message // HTTP::Status::status_message($code) // "?"; "$code $mess"; } method base () { my $base = $.header('Content-Base') // # used to be HTTP/1.1 $.header('Content-Location') // # HTTP/1.1 $.header('Base'); # HTTP/1.0 require URI; if ($base.defined && $base ~~ /^ \:/) { # already absolute return $HTTP::URI_CLASS.new($base); } my $req = $.request; if ($req) { # if $base is undef here, the return value is effectively # just a copy of $self.request.uri. return $HTTP::URI_CLASS.new_abs($base, $req.uri); } # can't find an absolute base. return undef; } method as_string (Str $newline = "\n") { my $code = $.code; my $status_message = HTTP::Status::status_message($code) // "Unknown code"; my $message = $.message // ""; my $status_line = "$code"; my $proto = $.protocol; $status_line = "$proto $status_line" if $proto.defined; $status_line ~= " ($status_message)" if $status_message ne $message; $status_line ~= " $message"; return ($status_line, self.SUPER::as_string($newline)).join($newline); } method is_info () { HTTP::Status::is_info ($.code); } method is_success () { HTTP::Status::is_success ($.code); } method is_redirect () { HTTP::Status::is_redirect ($.code); } method is_error () { HTTP::Status::is_error ($.code); } method error_as_HTML () { my $title = "An Error Occurred"; my $body = $.status_line; return " $title

$title

$body "; } method current_age () { my $response_time = $.client_date; my $date = $.date; my $age = 0; if ($response_time && $date) { $age = $response_time - $date; # apparent_age $age = 0 if $age < 0; } my $age_v = $.header('Age'); if ($age_v && $age_v > $age) { $age = $age_v; # corrected_received_age } my $request = $.request; if ($request) { my $request_time = $request.date; if ($request_time) { # Add response_delay to age to get 'corrected_initial_age' $age += ($response_time - $request_time); } } if ($response_time) { $age += time - $response_time; } return $age; } method freshness_lifetime () { my @cc = $.header('Cache-Control'); # First look for the Cache-Control: max-age=n header if (@cc) { for @cc -> $cc { for $cc.split(/\s*,\s*/) -> $cc_dir { if ($cc_dir ~~ rx:i/max-age\s*=\s*(\d+)/) { return $0; } } } } # Next possibility is to look at the "Expires" header my $date = $.date // $.client_date // time; my $expires = $.expires; unless ($expires.defined) { # Must apply heuristic expiration my $last_modified = $.last_modified; if ($last_modified.defined) { my $h_exp = ($date - $last_modified) * 0.10; # 10% since last-mod if ($h_exp < 60) { return 60; # minimum } elsif ($h_exp > (24 * 3600)) { # Should give a warning if more than 24 hours according to # RFC 2616 section 13.2.4, but I don't know how to do it # from this function interface, so I just make this the # maximum value. return 24 * 3600; } return $h_exp; } else { return 3600; # 1 hour is fallback when all else fails } } return $expires - $date; } method is_fresh () { $.freshness_lifetime > $.current_age } method fresh_until () { $.freshness_lifetime - $.current_age + time } } 1;