HTTP::Response::base fails if the response has no request

--------------040607050505010804030008
Content-Type: text/plain; charset=us-ascii; format=flowed
Content-Transfer-Encoding: 7bit

Once more I'd like to suggest a patch for HTTP::Response.

When working with my homegrown responses I found that the base method
fails fatally if the response doesn't have a request inside:

Can't call method "uri" on an undefined value at
/usr/lib/perl5/site_perl/5.8.5/HTTP/Response.pm line 78.

I can work around this by defining a fake request for my responses,
but I'd prefer if HTTP::Response::base would simply return undef if
it finds neither a base-defining header nor an embedded request.

Patches for lib/HTTP/Response.pm and t/base/message-old.t attached.
--
Cheers,
haj


--------------040607050505010804030008
Content-Type: text/plain;
name="response.diff"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
filename="response.diff"

--- lib/HTTP/Response.pm.1.50 2004-12-02 21:36:42.437500000 +0100
+++ lib/HTTP/Response.pm 2004-12-06 23:11:47.000000000 +0100
@@ -76,7 +82,13 @@
$self->header('Content-Location') || # HTTP/1.1
$self->header('Base'); # HTTP/1.0
- return $HTTP::URI_CLASS->new_abs($base, $self->request->uri);
- # So yes, if $base is undef, the return value is effectively
- # just a copy of $self->request->uri.
+ if ($self->request) {
+ return $HTTP::URI_CLASS->new_abs($base, $self->request->uri);
+ # So yes, if $base is undef, the return value is effectively
+ # just a copy of $self->request->uri.
+ } else {
+ return $base;
+ # If, on the other hand, $self->request is undef, the return
+ # value is $base as found in the headers.
+ }
}

@@ -367,4 +379,6 @@
=back

+If neither of these sources provide a URI, undef is returned.
+
When the LWP protocol modules produce the HTTP::Response object, then
any base URI embedded in the document (step 1) will already have

--------------040607050505010804030008
Content-Type: text/plain;
name="message-old.diff"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
filename="message-old.diff"

--- t/base/message-old.t~ 2004-04-09 10:50:21.000000000 +0200
+++ t/base/message-old.t 2004-12-06 22:53:21.663750000 +0100
@@ -8,5 +8,5 @@
use Test qw(plan ok);

-plan tests => 19;
+plan tests => 20;

require HTTP::Request;
@@ -63,4 +63,5 @@
# Check the base method:
$res = HTTP::Response->new(200, "This message");
+ok($res->base, undef);
$res->request($req);
$res->content_type("image/gif");

--------------040607050505010804030008--

Re: HTTP::Response::base fails if the response has no request

Harald Joerg writes:

> Once more I'd like to suggest a patch for HTTP::Response.
>
> When working with my homegrown responses I found that the base method
> fails fatally if the response doesn't have a request inside:
>
> Can't call method "uri" on an undefined value at
> /usr/lib/perl5/site_perl/5.8.5/HTTP/Response.pm line 78.
>
> I can work around this by defining a fake request for my responses,
> but I'd prefer if HTTP::Response::base would simply return undef if
> it finds neither a base-defining header nor an embedded request.

Seems fine. I tweaked your patch into this one before I applied it.
Thanks!

Regards,
Gisle

Index: lib/HTTP/Response.pm
============================================================ =======
RCS file: /cvsroot/libwww-perl/lwp5/lib/HTTP/Response.pm,v
retrieving revision 1.50
retrieving revision 1.51
diff -u -p -r1.50 -r1.51
--- lib/HTTP/Response.pm 30 Nov 2004 12:00:22 -0000 1.50
+++ lib/HTTP/Response.pm 11 Dec 2004 14:30:00 -0000 1.51
@@ -75,9 +75,20 @@ sub base
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
- return $HTTP::URI_CLASS->new_abs($base, $self->request->uri);
- # So yes, if $base is undef, the return value is effectively
- # just a copy of $self->request->uri.
+ 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;
}


@@ -366,6 +377,9 @@ received some redirect responses first.

=back

+If neither of these sources provide an absolute URI, undef is
+returned.
+
When the LWP protocol modules produce the HTTP::Response object, then
any base URI embedded in the document (step 1) will already have
initialized the "Content-Base:" header. This means that this method