This patch improves the way LWP::Simple::get deals with non-absolute
redirects. When this happens it is really the server that does not
know how to speak HTTP, but anyway...
Index: lib/LWP/Simple.pm
===================================================================
RCS file: /cvsroot/libwww-perl/lwp5/lib/LWP/Simple.pm,v
retrieving revision 1.34
diff -u -p -u -r1.34 Simple.pm
--- Simple.pm 2001/04/10 17:16:34 1.34
+++ Simple.pm 2001/07/21 03:07:41
@@ -281,6 +281,12 @@ sub _get
return _trivial_http_get($host, $port, $path);
} else {
_init_ua() unless $ua;
+ if (@_ && $url !~ /^\w+:/) {
+ # non-absolute redirect from &_trivial_http_get
+ my($host, $port, $path) = @_;
+ require URI;
+ $url = URI->new_abs($url, "http://$host:$port$path");
+ }
my $request = HTTP::Request->new(GET => $url);
my $response = $ua->request($request);
return $response->is_success ? $response->content : undef;
@@ -320,7 +326,7 @@ sub _trivial_http_get
# redirect
my $url = $1;
return undef if $loop_check{$url}++;
- return _get($url);
+ return _get($url, $host, $port, $path);
}
return undef unless $code =~ /^2/;
$buf =~ s/.+?\015?\012\015?\012//s; # zap header