package HTTP::Response;
require HTTP::Message;
@ISA = qw(HTTP::Message);
$VERSION = "5.818";
use strict;
use HTTP::Status ();
sub new
{
my($class, $rc, $msg, $header, $content) = @_;
my $self = $class->SUPER::new($header, $content);
$self->code($rc);
$self->message($msg);
$self;
}
sub parse
{
my($class, $str) = @_;
my $status_line;
if ($str =~ s/^(.*)\n//) {
$status_line = $1;
}
else {
$status_line = $str;
$str = "";
}
my $self = $class->SUPER::parse($str);
my($protocol, $code, $message);
if ($status_line =~ /^\d{3} /) {
# Looks like a response created by HTTP::Response->new
($code, $message) = split(' ', $status_line, 2);
} else {
($protocol, $code, $message) = split(' ', $status_line, 3);
}
$self->protocol($protocol) if $protocol;
$self->code($code) if defined($code);
$self->message($message) if defined($message);
$self;
}
sub clone
{
my $self = shift;
my $clone = bless $self->SUPER::clone, ref($self);
$clone->code($self->code);
$clone->message($self->message);
$clone->request($self->request->clone) if $self->request;
# we don't clone previous
$clone;
}
sub code { shift->_elem('_rc', @_); }
sub message { shift->_elem('_msg', @_); }
sub previous { shift->_elem('_previous',@_); }
sub request { shift->_elem('_request', @_); }
sub status_line
{
my $self = shift;
my $code = $self->{'_rc'} || "000";
my $mess = $self->{'_msg'} || HTTP::Status::status_message($code) || "Unknown code";
return "$code $mess";
}
sub base
{
my $self = shift;
my $base = $self->header('Content-Base') || # used to be HTTP/1.1
$self->header('Content-Location') || # HTTP/1.1
$self->header('Base'); # HTTP/1.0
if ($base && $base =~ /^$URI::scheme_re:/o) {
# already absolute
return $HTTP::URI_CLASS->new($base);
}
my $req = $self->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;
}
sub filename
{
=1= |