develooper Front page | perl.libwww | Postings from July 2001

[PATCH] LWP::Simple::get non-absolute redirects.

From:
Gisle Aas
Date:
July 20, 2001 20:26
Subject:
[PATCH] LWP::Simple::get non-absolute redirects.
Message ID:
lrwv53otdt.fsf@caliper.ActiveState.com
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



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About