##
$>perl -MLWP::Debug=+ -MLWP::Simple -we"print
getstore('http://wire.ap.org/APnews/center_minor.html?FRONTID=SCIENCE','file.tx
t')"
LWP::UserAgent::new: ()
LWP::UserAgent::request: ()
LWP::UserAgent::simple_request: GET http://wire.ap.org/APnews/center_minor.html?
FRONTID=SCIENCE
LWP::UserAgent::_need_proxy: Not proxied
LWP::Protocol::http::request: ()
LWP::Protocol::http::request: GET /APnews/center_minor.html?FRONTID=SCIENCE HTTP
/1.0
Host: wire.ap.org
User-Agent: LWP::Simple/5.51
LWP::Protocol::http::request: reading response
LWP::Protocol::http::request: HTTP/1.1 302 Found
Date: Sun, 27 Jan 2002 10:36:34 GMT
Server: Apache/1.3.12 (Unix) mod_perl/1.23
Location: /public_pages/WirePortal.pcgi
Connection: close
Content-Type: text/html; charset=iso-8859-1
302 Found
Found
The document has moved here.
Apache/1.3.12 Server at wire.ap.org Port 80
LWP::Protocol::http::request: HTTP/1.1 302 Found
LWP::Protocol::collect: read 277 bytes
LWP::UserAgent::request: Simple response: Found
LWP::UserAgent::request: ()
LWP::UserAgent::simple_request: GET http://wire.ap.org/public_pages/WirePortal.p
cgi
LWP::UserAgent::_need_proxy: Not proxied
LWP::Protocol::http::request: ()
LWP::Protocol::http::request: GET /public_pages/WirePortal.pcgi HTTP/1.0
Host: wire.ap.org
User-Agent: LWP::Simple/5.51
LWP::Protocol::http::request: reading response
LWP::Protocol::http::request: HTTP/1.1 200 OK
Connection: close
Date: Sun, 27 Jan 2002 08:31:02 GMT
Server: Apache/1.3.12 (Unix) mod_perl/1.23
Content-MD5: MA6SFpj03gSVT0/n/+ZEnA
Content-Type: text/html; charset=ISO-8859-1
Title: Testing JavaScript
Testing JavaScript
LWP::Protocol::http::request: HTTP/1.1 200 OK
LWP::Protocol::collect: read 478 bytes
LWP::UserAgent::request: Simple response: OK
200
####
LWP::Debug::debug('Simple response: ' .
(HTTP::Status::status_message($code) ||
"Unknown code $code"));
####
=item $ua->request($request, $arg [, $size])
Process a request, including redirects and security. This method may
actually send several different simple requests.
The arguments are the same as for C.
=cut
sub request
{
my($self, $request, $arg, $size, $previous) = @_;
LWP::Debug::trace('()');
my $response = $self->simple_request($request, $arg, $size);
my $code = $response->code;
$response->previous($previous) if defined $previous;
LWP::Debug::debug('Simple response: ' .
(HTTP::Status::status_message($code) ||
"Unknown code $code"));
if ($code == &HTTP::Status::RC_MOVED_PERMANENTLY or
$code == &HTTP::Status::RC_MOVED_TEMPORARILY) {
# Make a copy of the request and initialize it with the new URI
my $referral = $request->clone;
# And then we update the URL based on the Location:-header.
my $referral_uri = $response->header('Location');
{
# Some servers erroneously return a relative URL for redirects,
# so make it absolute if it not already is.
local $URI::ABS_ALLOW_RELATIVE_SCHEME = 1;
my $base = $response->base;
$referral_uri = $HTTP::URI_CLASS->new($referral_uri, $base)
->abs($base);
}
$referral->url($referral_uri);
return $response unless $self->redirect_ok($referral);
# Check for loop in the redirects
my $count = 0;
my $r = $response;
while ($r) {
if (++$count > 13 ||
$r->request->url->as_string eq $referral_uri->as_string) {
$response->header("Client-Warning" =>
"Redirect loop detected");
return $response;
}
$r = $r->previous;
}
return $self->request($referral, $arg, $size, $response);
} elsif ($code == &HTTP::Status::RC_UNAUTHORIZED ||
$code == &HTTP::Status::RC_PROXY_AUTHENTICATION_REQUIRED
)
{
my $proxy = ($code == &HTTP::Status::RC_PROXY_AUTHENTICATION_REQUIRED);
my $ch_header = $proxy ? "Proxy-Authenticate" : "WWW-Authenticate";
my @challenge = $response->header($ch_header);
unless (@challenge) {
$response->header("Client-Warning" =>
"Missing Authenticate header");
return $response;
}
require HTTP::Headers::Util;
CHALLENGE: for my $challenge (@challenge) {
$challenge =~ tr/,/;/; # "," is used to separate auth-params!!
($challenge) = HTTP::Headers::Util::split_header_words($challenge);
my $scheme = lc(shift(@$challenge));
shift(@$challenge); # no value
$challenge = { @$challenge }; # make rest into a hash
for (keys %$challenge) { # make sure all keys are lower case
$challenge->{lc $_} = delete $challenge->{$_};
}
unless ($scheme =~ /^([a-z]+(?:-[a-z]+)*)$/) {
$response->header("Client-Warning" =>
"Bad authentication scheme '$scheme'");
return $response;
}
$scheme = $1; # untainted now
my $class = "LWP::Authen::\u$scheme";
$class =~ s/-/_/g;
no strict 'refs';
unless (%{"$class\::"}) {
# try to load it
eval "require $class";
if ($@) {
if ($@ =~ /^Can\'t locate/) {
$response->header("Client-Warning" =>
"Unsupported authentication scheme '$scheme'");
} else {
$response->header("Client-Warning" => $@);
}
next CHALLENGE;
}
}
return $class->authenticate($self, $proxy, $challenge, $response,
$request, $arg, $size);
}
return $response;
}
return $response;
}