← Index
NYTProf Performance Profile   « block view • line view • sub view »
For ddd2.pl
  Run on Tue May 25 16:52:24 2010
Reported on Tue May 25 16:56:51 2010

File /project/perl/lib/LWP/UserAgent.pm
Statements Executed 34195
Statement Execution Time 608ms
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
46111211ms147sLWP::UserAgent::::send_requestLWP::UserAgent::send_request
4611178.4ms148sLWP::UserAgent::::requestLWP::UserAgent::request
13833148.2ms66.7msLWP::UserAgent::::_request_sanity_checkLWP::UserAgent::_request_sanity_check
4611140.1ms148sLWP::UserAgent::::getLWP::UserAgent::get
4611137.4ms145msLWP::UserAgent::::prepare_requestLWP::UserAgent::prepare_request
4611131.9ms147sLWP::UserAgent::::simple_requestLWP::UserAgent::simple_request
4611131.0ms72.9msLWP::UserAgent::::_need_proxyLWP::UserAgent::_need_proxy
4611117.1ms17.1msLWP::UserAgent::::_process_colonic_headersLWP::UserAgent::_process_colonic_headers
4611112.2ms27.6msLWP::UserAgent::::protocols_allowedLWP::UserAgent::protocols_allowed
4611110.7ms23.8msLWP::UserAgent::::protocols_forbiddenLWP::UserAgent::protocols_forbidden
111263µs355µsLWP::UserAgent::::newLWP::UserAgent::new
11165µs79µsLWP::UserAgent::::agentLWP::UserAgent::agent
22248µs48µsLWP::UserAgent::::CORE:matchLWP::UserAgent::CORE:match (opcode)
0000s0sLWP::UserAgent::::BEGINLWP::UserAgent::BEGIN
0000s0sLWP::UserAgent::::_agentLWP::UserAgent::_agent
0000s0sLWP::UserAgent::::_new_responseLWP::UserAgent::_new_response
0000s0sLWP::UserAgent::::cloneLWP::UserAgent::clone
0000s0sLWP::UserAgent::::conn_cacheLWP::UserAgent::conn_cache
0000s0sLWP::UserAgent::::cookie_jarLWP::UserAgent::cookie_jar
0000s0sLWP::UserAgent::::credentialsLWP::UserAgent::credentials
0000s0sLWP::UserAgent::::default_headerLWP::UserAgent::default_header
0000s0sLWP::UserAgent::::default_headersLWP::UserAgent::default_headers
0000s0sLWP::UserAgent::::env_proxyLWP::UserAgent::env_proxy
0000s0sLWP::UserAgent::::fromLWP::UserAgent::from
0000s0sLWP::UserAgent::::get_basic_credentialsLWP::UserAgent::get_basic_credentials
0000s0sLWP::UserAgent::::headLWP::UserAgent::head
0000s0sLWP::UserAgent::::is_protocol_supportedLWP::UserAgent::is_protocol_supported
0000s0sLWP::UserAgent::::max_redirectLWP::UserAgent::max_redirect
0000s0sLWP::UserAgent::::max_sizeLWP::UserAgent::max_size
0000s0sLWP::UserAgent::::mirrorLWP::UserAgent::mirror
0000s0sLWP::UserAgent::::no_proxyLWP::UserAgent::no_proxy
0000s0sLWP::UserAgent::::parse_headLWP::UserAgent::parse_head
0000s0sLWP::UserAgent::::postLWP::UserAgent::post
0000s0sLWP::UserAgent::::proxyLWP::UserAgent::proxy
0000s0sLWP::UserAgent::::redirect_okLWP::UserAgent::redirect_ok
0000s0sLWP::UserAgent::::requests_redirectableLWP::UserAgent::requests_redirectable
0000s0sLWP::UserAgent::::timeoutLWP::UserAgent::timeout
0000s0sLWP::UserAgent::::use_alarmLWP::UserAgent::use_alarm
0000s0sLWP::UserAgent::::use_evalLWP::UserAgent::use_eval
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package LWP::UserAgent;
2
3# $Id: UserAgent.pm,v 2.33 2004/09/16 09:28:22 gisle Exp $
4
5395µs126µsuse strict;
# spent 26µs making 1 call to strict::import
63184µs1211µsuse vars qw(@ISA $VERSION);
# spent 211µs making 1 call to vars::import
7
817µsrequire LWP::MemberMixin;
9110µs@ISA = qw(LWP::MemberMixin);
10177µs134µs$VERSION = sprintf("%d.%03d", q$Revision: 2.33 $ =~ /(\d+)\.(\d+)/);
# spent 34µs making 1 call to LWP::UserAgent::CORE:match
11
12315.7msuse HTTP::Request ();
133445µsuse HTTP::Response ();
143449µsuse HTTP::Date ();
15
163426µsuse LWP ();
1736.37msuse LWP::Debug ();
183397µsuse LWP::Protocol ();
19
2033.53msuse Carp ();
21
2217µsif ($ENV{PERL_LWP_USE_HTTP_10}) {
23 require LWP::Protocol::http10;
24 LWP::Protocol::implementor('http', 'LWP::Protocol::http10');
25 eval {
26 require LWP::Protocol::https10;
27 LWP::Protocol::implementor('https', 'LWP::Protocol::https10');
28 };
29}
30
31
32
33sub new
34
# spent 355µs (263+92) within LWP::UserAgent::new which was called # once (263µs+92µs) by WWW::Google::PageRank::new at line 19 of WWW/Google/PageRank.pm
{
3536252µs my($class, %cnf) = @_;
36 LWP::Debug::trace('()');
# spent 13µs making 1 call to LWP::Debug::trace
37
38 my $agent = delete $cnf{agent};
39 $agent = $class->_agent unless defined $agent;
40
41 my $from = delete $cnf{from};
42 my $timeout = delete $cnf{timeout};
43 $timeout = 3*60 unless defined $timeout;
44 my $use_eval = delete $cnf{use_eval};
45 $use_eval = 1 unless defined $use_eval;
46 my $parse_head = delete $cnf{parse_head};
47 $parse_head = 1 unless defined $parse_head;
48 my $max_size = delete $cnf{max_size};
49 my $max_redirect = delete $cnf{max_redirect};
50 $max_redirect = 7 unless defined $max_redirect;
51 my $env_proxy = delete $cnf{env_proxy};
52
53 my $cookie_jar = delete $cnf{cookie_jar};
54 my $conn_cache = delete $cnf{conn_cache};
55 my $keep_alive = delete $cnf{keep_alive};
56
57 Carp::croak("Can't mix conn_cache and keep_alive")
58 if $conn_cache && $keep_alive;
59
60
61 my $protocols_allowed = delete $cnf{protocols_allowed};
62 my $protocols_forbidden = delete $cnf{protocols_forbidden};
63
64 my $requests_redirectable = delete $cnf{requests_redirectable};
65 $requests_redirectable = ['GET', 'HEAD']
66 unless defined $requests_redirectable;
67
68 # Actually ""s are just as good as 0's, but for concision we'll just say:
69 Carp::croak("protocols_allowed has to be an arrayref or 0, not \"$protocols_allowed\"!")
70 if $protocols_allowed and ref($protocols_allowed) ne 'ARRAY';
71 Carp::croak("protocols_forbidden has to be an arrayref or 0, not \"$protocols_forbidden\"!")
72 if $protocols_forbidden and ref($protocols_forbidden) ne 'ARRAY';
73 Carp::croak("requests_redirectable has to be an arrayref or 0, not \"$requests_redirectable\"!")
74 if $requests_redirectable and ref($requests_redirectable) ne 'ARRAY';
75
76
77 if (%cnf && $^W) {
78 Carp::carp("Unrecognized LWP::UserAgent options: @{[sort keys %cnf]}");
79 }
80
81 my $self = bless {
82 from => $from,
83 def_headers => undef,
84 timeout => $timeout,
85 use_eval => $use_eval,
86 parse_head => $parse_head,
87 max_size => $max_size,
88 max_redirect => $max_redirect,
89 proxy => {},
90 no_proxy => [],
91 protocols_allowed => $protocols_allowed,
92 protocols_forbidden => $protocols_forbidden,
93 requests_redirectable => $requests_redirectable,
94 }, $class;
95
96 $self->agent($agent) if $agent;
# spent 79µs making 1 call to LWP::UserAgent::agent
97 $self->cookie_jar($cookie_jar) if $cookie_jar;
98 $self->env_proxy if $env_proxy;
99
100 $self->protocols_allowed( $protocols_allowed ) if $protocols_allowed;
101 $self->protocols_forbidden($protocols_forbidden) if $protocols_forbidden;
102
103 if ($keep_alive) {
104 $conn_cache ||= { total_capacity => $keep_alive };
105 }
106 $self->conn_cache($conn_cache) if $conn_cache;
107
108 return $self;
109}
110
111
112# private method. check sanity of given $request
113
# spent 66.7ms (48.2+18.5) within LWP::UserAgent::_request_sanity_check which was called 1383 times, avg 48µs/call: # 461 times (17.6ms+6.76ms) by LWP::UserAgent::simple_request at line 270, avg 53µs/call # 461 times (15.8ms+6.16ms) by LWP::UserAgent::send_request at line 135, avg 48µs/call # 461 times (14.8ms+5.55ms) by LWP::UserAgent::prepare_request at line 241, avg 44µs/call
sub _request_sanity_check {
114276668.6ms my($self, $request) = @_;
115 # some sanity checking
116 if (defined $request) {
# spent 18.5ms making 2766 calls to UNIVERSAL::can, avg 7µs/call
117 if (ref $request) {
118 Carp::croak("You need a request object, not a " . ref($request) . " object")
119 if ref($request) eq 'ARRAY' or ref($request) eq 'HASH' or
120 !$request->can('method') or !$request->can('uri');
121 }
122 else {
123 Carp::croak("You need a request object, not '$request'");
124 }
125 }
126 else {
127 Carp::croak("No request object passed in");
128 }
129}
130
131
132sub send_request
133
# spent 147s (211ms+147) within LWP::UserAgent::send_request which was called 461 times, avg 319ms/call: # 461 times (211ms+147s) by LWP::UserAgent::simple_request at line 272, avg 319ms/call
{
1349681131ms my($self, $request, $arg, $size) = @_;
135 $self->_request_sanity_check($request);
# spent 21.9ms making 461 calls to LWP::UserAgent::_request_sanity_check, avg 48µs/call
136
137 my($method, $url) = ($request->method, $request->uri);
# spent 26.7ms making 461 calls to HTTP::Request::method, avg 58µs/call # spent 11.9ms making 461 calls to HTTP::Request::uri, avg 26µs/call
138
139 local($SIG{__DIE__}); # protect against user defined die handlers
140
141 # Check that we have a METHOD and a URL first
142 return _new_response($request, &HTTP::Status::RC_BAD_REQUEST, "Method missing")
143 unless $method;
14412.64ms return _new_response($request, &HTTP::Status::RC_BAD_REQUEST, "URL missing")
145 unless $url;
146 return _new_response($request, &HTTP::Status::RC_BAD_REQUEST, "URL must be absolute")
# spent 42.2ms making 461 calls to URI::scheme, avg 92µs/call
147 unless $url->scheme;
148
14915.68ms4615.62ms LWP::Debug::trace("$method $url");
# spent 5.62ms making 461 calls to LWP::Debug::trace, avg 12µs/call
150
151 # Locate protocol to use
152 my $scheme = '';
153 my $proxy = $self->_need_proxy($url);
# spent 72.9ms making 461 calls to LWP::UserAgent::_need_proxy, avg 158µs/call
1544617.77ms if (defined $proxy) {
155 $scheme = $proxy->scheme;
156 }
157 else {
158 $scheme = $url->scheme;
# spent 35.9ms making 461 calls to URI::scheme, avg 78µs/call
159 }
160
161 my $protocol;
162
163 {
164 # Honor object-specific restrictions by forcing protocol objects
165 # into class LWP::Protocol::nogo.
16692216.1ms my $x;
167 if($x = $self->protocols_allowed) {
# spent 27.6ms making 461 calls to LWP::UserAgent::protocols_allowed, avg 60µs/call # spent 23.8ms making 461 calls to LWP::UserAgent::protocols_forbidden, avg 52µs/call
168 if(grep lc($_) eq $scheme, @$x) {
169 LWP::Debug::trace("$scheme URLs are among $self\'s allowed protocols (@$x)");
170 }
171 else {
172 LWP::Debug::trace("$scheme URLs aren't among $self\'s allowed protocols (@$x)");
173 require LWP::Protocol::nogo;
174 $protocol = LWP::Protocol::nogo->new;
175 }
176 }
177 elsif ($x = $self->protocols_forbidden) {
178 if(grep lc($_) eq $scheme, @$x) {
179 LWP::Debug::trace("$scheme URLs are among $self\'s forbidden protocols (@$x)");
180 require LWP::Protocol::nogo;
181 $protocol = LWP::Protocol::nogo->new;
182 }
183 else {
184 LWP::Debug::trace("$scheme URLs aren't among $self\'s forbidden protocols (@$x)");
185 }
186 }
187 # else fall thru and create the protocol object normally
188 }
189
1909226.82ms unless($protocol) {
1914617.90ms461115ms $protocol = eval { LWP::Protocol::create($scheme, $self) };
# spent 115ms making 461 calls to LWP::Protocol::create, avg 250µs/call
192 if ($@) {
193 $@ =~ s/ at .* line \d+.*//s; # remove file/line number
194 my $response = _new_response($request, &HTTP::Status::RC_NOT_IMPLEMENTED, $@);
195 if ($scheme eq "https") {
196 $response->message($response->message . " (Crypt::SSLeay not installed)");
197 $response->content_type("text/plain");
198 $response->content(<<EOT);
199LWP will support https URLs if the Crypt::SSLeay module is installed.
200More information at <http://www.linpro.no/lwp/libwww-perl/README.SSL>.
201EOT
202 }
203 return $response;
204 }
205 }
206
207 # Extract fields that will be used below
208 my ($timeout, $cookie_jar, $use_eval, $parse_head, $max_size) =
209 @{$self}{qw(timeout cookie_jar use_eval parse_head max_size)};
210
211 my $response;
2129226.64ms if ($use_eval) {
213 # we eval, and turn dies into responses below
2144619.57ms eval {
215150.0ms461146s $response = $protocol->request($request, $proxy,
# spent 146s making 461 calls to LWP::Protocol::http::request, avg 318ms/call
216 $arg, $size, $timeout);
217 };
218 if ($@) {
219 $@ =~ s/ at .* line \d+.*//s; # remove file/line number
220 $response = _new_response($request,
221 &HTTP::Status::RC_INTERNAL_SERVER_ERROR,
222 $@);
223 }
224 }
225 else {
226 $response = $protocol->request($request, $proxy,
227 $arg, $size, $timeout);
228 # XXX: Should we die unless $response->is_success ???
229 }
230
231 $response->request($request); # record request for reference
# spent 35.0ms making 461 calls to HTTP::Response::request, avg 76µs/call
232 $cookie_jar->extract_cookies($response) if $cookie_jar;
233 $response->header("Client-Date" => HTTP::Date::time2str(time));
# spent 122ms making 461 calls to HTTP::Message::__ANON__[(eval 0)[HTTP/Message.pm:371]:1], avg 266µs/call # spent 23.8ms making 461 calls to HTTP::Date::time2str, avg 52µs/call
234 return $response;
235}
236
237
238sub prepare_request
239
# spent 145ms (37.4+108) within LWP::UserAgent::prepare_request which was called 461 times, avg 315µs/call: # 461 times (37.4ms+108ms) by LWP::UserAgent::simple_request at line 271, avg 315µs/call
{
240414936.2ms my($self, $request) = @_;
241 $self->_request_sanity_check($request);
# spent 20.4ms making 461 calls to LWP::UserAgent::_request_sanity_check, avg 44µs/call
242
243 # Extract fields that will be used below
244 my ($agent, $from, $cookie_jar, $max_size, $def_headers) =
245 @{$self}{qw(agent from cookie_jar max_size def_headers)};
246
247 # Set User-Agent and From headers if they are defined
248 $request->init_header('User-Agent' => $agent) if $agent;
# spent 86.9ms making 460 calls to HTTP::Message::__ANON__[(eval 0)[HTTP/Message.pm:371]:1], avg 189µs/call # spent 185µs making 1 call to HTTP::Message::AUTOLOAD
249 $request->init_header('From' => $from) if $from;
250 if (defined $max_size) {
251 my $last = $max_size - 1;
252 $last = 0 if $last < 0; # there is no way to actually request no content
253 $request->init_header('Range' => "bytes=0-$last");
254 }
255 $cookie_jar->add_cookie_header($request) if $cookie_jar;
256
257 if ($def_headers) {
258 for my $h ($def_headers->header_field_names) {
259 $request->init_header($h => [$def_headers->header($h)]);
260 }
261 }
262
263 return($request);
264}
265
266
267sub simple_request
268
# spent 147s (31.9ms+147) within LWP::UserAgent::simple_request which was called 461 times, avg 320ms/call: # 461 times (31.9ms+147s) by LWP::UserAgent::request at line 282, avg 320ms/call
{
269184430.6ms my($self, $request, $arg, $size) = @_;
270 $self->_request_sanity_check($request);
# spent 24.3ms making 461 calls to LWP::UserAgent::_request_sanity_check, avg 53µs/call
271 my $new_request = $self->prepare_request($request);
# spent 145ms making 461 calls to LWP::UserAgent::prepare_request, avg 315µs/call
272 return($self->send_request($new_request, $arg, $size));
# spent 147s making 461 calls to LWP::UserAgent::send_request, avg 319ms/call
273}
274
275
276sub request
277
# spent 148s (78.4ms+148) within LWP::UserAgent::request which was called 461 times, avg 320ms/call: # 461 times (78.4ms+148s) by LWP::UserAgent::get at line 419, avg 320ms/call
{
278368891.6ms my($self, $request, $arg, $size, $previous) = @_;
279
280 LWP::Debug::trace('()');
# spent 5.85ms making 461 calls to LWP::Debug::trace, avg 13µs/call
281
282 my $response = $self->simple_request($request, $arg, $size);
# spent 147s making 461 calls to LWP::UserAgent::simple_request, avg 320ms/call
283
284 my $code = $response->code;
# spent 29.1ms making 461 calls to HTTP::Response::code, avg 63µs/call
285 $response->previous($previous) if defined $previous;
286
287 LWP::Debug::debug('Simple response: ' .
# spent 6.74ms making 461 calls to HTTP::Status::status_message, avg 15µs/call # spent 5.85ms making 461 calls to LWP::Debug::debug, avg 13µs/call
288 (HTTP::Status::status_message($code) ||
289 "Unknown code $code"));
290
291 if ($code == &HTTP::Status::RC_MOVED_PERMANENTLY or
# spent 3.17ms making 461 calls to HTTP::Status::RC_MOVED_PERMANENTLY, avg 7µs/call # spent 2.79ms making 461 calls to HTTP::Status::RC_FOUND, avg 6µs/call # spent 2.75ms making 461 calls to HTTP::Status::RC_PROXY_AUTHENTICATION_REQUIRED, avg 6µs/call # spent 2.72ms making 461 calls to HTTP::Status::RC_SEE_OTHER, avg 6µs/call # spent 2.66ms making 461 calls to HTTP::Status::RC_TEMPORARY_REDIRECT, avg 6µs/call # spent 2.64ms making 461 calls to HTTP::Status::RC_UNAUTHORIZED, avg 6µs/call
292 $code == &HTTP::Status::RC_FOUND or
293 $code == &HTTP::Status::RC_SEE_OTHER or
294 $code == &HTTP::Status::RC_TEMPORARY_REDIRECT)
295 {
296 my $referral = $request->clone;
297
298 # These headers should never be forwarded
299 $referral->remove_header('Host', 'Cookie');
300
301 if ($referral->header('Referer') &&
302 $request->url->scheme eq 'https' &&
303 $referral->url->scheme eq 'http')
304 {
305 # RFC 2616, section 15.1.3.
306 LWP::Debug::trace("https -> http redirect, suppressing Referer");
307 $referral->remove_header('Referer');
308 }
309
310 if ($code == &HTTP::Status::RC_SEE_OTHER ||
311 $code == &HTTP::Status::RC_FOUND)
312 {
313 my $method = uc($referral->method);
314 unless ($method eq "GET" || $method eq "HEAD") {
315 $referral->method("GET");
316 $referral->content("");
317 $referral->remove_content_headers;
318 }
319 }
320
321 # And then we update the URL based on the Location:-header.
322 my $referral_uri = $response->header('Location');
323 {
324 # Some servers erroneously return a relative URL for redirects,
325 # so make it absolute if it not already is.
326 local $URI::ABS_ALLOW_RELATIVE_SCHEME = 1;
327 my $base = $response->base;
328 $referral_uri = "" unless defined $referral_uri;
329 $referral_uri = $HTTP::URI_CLASS->new($referral_uri, $base)
330 ->abs($base);
331 }
332 $referral->url($referral_uri);
333
334 # Check for loop in the redirects, we only count
335 my $count = 0;
336 my $r = $response;
337 while ($r) {
338 if (++$count > $self->{max_redirect}) {
339 $response->header("Client-Warning" =>
340 "Redirect loop detected (max_redirect = $self->{max_redirect})");
341 return $response;
342 }
343 $r = $r->previous;
344 }
345
346 return $response unless $self->redirect_ok($referral, $response);
347 return $self->request($referral, $arg, $size, $response);
348
349 }
350 elsif ($code == &HTTP::Status::RC_UNAUTHORIZED ||
351 $code == &HTTP::Status::RC_PROXY_AUTHENTICATION_REQUIRED
352 )
353 {
354 my $proxy = ($code == &HTTP::Status::RC_PROXY_AUTHENTICATION_REQUIRED);
355 my $ch_header = $proxy ? "Proxy-Authenticate" : "WWW-Authenticate";
356 my @challenge = $response->header($ch_header);
357 unless (@challenge) {
358 $response->header("Client-Warning" =>
359 "Missing Authenticate header");
360 return $response;
361 }
362
363 require HTTP::Headers::Util;
364 CHALLENGE: for my $challenge (@challenge) {
365 $challenge =~ tr/,/;/; # "," is used to separate auth-params!!
366 ($challenge) = HTTP::Headers::Util::split_header_words($challenge);
367 my $scheme = lc(shift(@$challenge));
368 shift(@$challenge); # no value
369 $challenge = { @$challenge }; # make rest into a hash
370 for (keys %$challenge) { # make sure all keys are lower case
371 $challenge->{lc $_} = delete $challenge->{$_};
372 }
373
374 unless ($scheme =~ /^([a-z]+(?:-[a-z]+)*)$/) {
375 $response->header("Client-Warning" =>
376 "Bad authentication scheme '$scheme'");
377 return $response;
378 }
379 $scheme = $1; # untainted now
380 my $class = "LWP::Authen::\u$scheme";
381 $class =~ s/-/_/g;
382
38334.57ms1106µs no strict 'refs';
# spent 106µs making 1 call to strict::unimport
384 unless (%{"$class\::"}) {
385 # try to load it
386 eval "require $class";
387 if ($@) {
388 if ($@ =~ /^Can\'t locate/) {
389 $response->header("Client-Warning" =>
390 "Unsupported authentication scheme '$scheme'");
391 }
392 else {
393 $response->header("Client-Warning" => $@);
394 }
395 next CHALLENGE;
396 }
397 }
398 unless ($class->can("authenticate")) {
399 $response->header("Client-Warning" =>
400 "Unsupported authentication scheme '$scheme'");
401 next CHALLENGE;
402 }
403 return $class->authenticate($self, $proxy, $challenge, $response,
404 $request, $arg, $size);
405 }
406 return $response;
407 }
408 return $response;
409}
410
411
412#
413# Now the shortcuts...
414#
415
# spent 148s (40.1ms+148) within LWP::UserAgent::get which was called 461 times, avg 321ms/call: # 461 times (40.1ms+148s) by WWW::Google::PageRank::get at line 36 of WWW/Google/PageRank.pm, avg 321ms/call
sub get {
416184435.1ms require HTTP::Request::Common;
417 my($self, @parameters) = @_;
418 my @suff = $self->_process_colonic_headers(\@parameters,1);
# spent 17.1ms making 461 calls to LWP::UserAgent::_process_colonic_headers, avg 37µs/call
419 return $self->request( HTTP::Request::Common::GET( @parameters ), @suff );
# spent 148s making 461 calls to LWP::UserAgent::request, avg 320ms/call # spent 335ms making 461 calls to HTTP::Request::Common::GET, avg 726µs/call
420}
421
422
423sub post {
424 require HTTP::Request::Common;
425 my($self, @parameters) = @_;
426 my @suff = $self->_process_colonic_headers(\@parameters,2);
427 return $self->request( HTTP::Request::Common::POST( @parameters ), @suff );
428}
429
430
431sub head {
432 require HTTP::Request::Common;
433 my($self, @parameters) = @_;
434 my @suff = $self->_process_colonic_headers(\@parameters,1);
435 return $self->request( HTTP::Request::Common::HEAD( @parameters ), @suff );
436}
437
438
439
# spent 17.1ms within LWP::UserAgent::_process_colonic_headers which was called 461 times, avg 37µs/call: # 461 times (17.1ms+0s) by LWP::UserAgent::get at line 418, avg 37µs/call
sub _process_colonic_headers {
440 # Process :content_cb / :content_file / :read_size_hint headers.
441230518.9ms my($self, $args, $start_index) = @_;
442
443 my($arg, $size);
444 for(my $i = $start_index; $i < @$args; $i += 2) {
445 next unless defined $args->[$i];
446
447 #printf "Considering %s => %s\n", $args->[$i], $args->[$i + 1];
448
449 if($args->[$i] eq ':content_cb') {
450 # Some sanity-checking...
451 $arg = $args->[$i + 1];
452 Carp::croak("A :content_cb value can't be undef") unless defined $arg;
453 Carp::croak("A :content_cb value must be a coderef")
454 unless ref $arg and UNIVERSAL::isa($arg, 'CODE');
455
456 }
457 elsif ($args->[$i] eq ':content_file') {
458 $arg = $args->[$i + 1];
459
460 # Some sanity-checking...
461 Carp::croak("A :content_file value can't be undef")
462 unless defined $arg;
463 Carp::croak("A :content_file value can't be a reference")
464 if ref $arg;
465 Carp::croak("A :content_file value can't be \"\"")
466 unless length $arg;
467
468 }
469 elsif ($args->[$i] eq ':read_size_hint') {
470 $size = $args->[$i + 1];
471 # Bother checking it?
472
473 }
474 else {
475 next;
476 }
477 splice @$args, $i, 2;
478 $i -= 2;
479 }
480
481 # And return a suitable suffix-list for request(REQ,...)
482
483 return unless defined $arg;
484 return $arg, $size if defined $size;
485 return $arg;
486}
487
488
489#
490# This whole allow/forbid thing is based on man 1 at's way of doing things.
491#
492sub is_protocol_supported
493{
494 my($self, $scheme) = @_;
495 if (ref $scheme) {
496 # assume we got a reference to an URI object
497 $scheme = $scheme->scheme;
498 }
499 else {
500 Carp::croak("Illegal scheme '$scheme' passed to is_protocol_supported")
501 if $scheme =~ /\W/;
502 $scheme = lc $scheme;
503 }
504
505 my $x;
506 if(ref($self) and $x = $self->protocols_allowed) {
507 return 0 unless grep lc($_) eq $scheme, @$x;
508 }
509 elsif (ref($self) and $x = $self->protocols_forbidden) {
510 return 0 if grep lc($_) eq $scheme, @$x;
511 }
512
513 local($SIG{__DIE__}); # protect against user defined die handlers
514 $x = LWP::Protocol::implementor($scheme);
515 return 1 if $x and $x ne 'LWP::Protocol::nogo';
516 return 0;
517}
518
519
52046111.4ms46115.4ms
# spent 27.6ms (12.2+15.4) within LWP::UserAgent::protocols_allowed which was called 461 times, avg 60µs/call: # 461 times (12.2ms+15.4ms) by LWP::UserAgent::send_request at line 167, avg 60µs/call
sub protocols_allowed { shift->_elem('protocols_allowed' , @_) }
# spent 15.4ms making 461 calls to LWP::MemberMixin::_elem, avg 33µs/call
5214619.70ms46113.1ms
# spent 23.8ms (10.7+13.1) within LWP::UserAgent::protocols_forbidden which was called 461 times, avg 52µs/call: # 461 times (10.7ms+13.1ms) by LWP::UserAgent::send_request at line 167, avg 52µs/call
sub protocols_forbidden { shift->_elem('protocols_forbidden' , @_) }
# spent 13.1ms making 461 calls to LWP::MemberMixin::_elem, avg 28µs/call
522sub requests_redirectable { shift->_elem('requests_redirectable', @_) }
523
524
525sub redirect_ok
526{
527 # RFC 2616, section 10.3.2 and 10.3.3 say:
528 # If the 30[12] status code is received in response to a request other
529 # than GET or HEAD, the user agent MUST NOT automatically redirect the
530 # request unless it can be confirmed by the user, since this might
531 # change the conditions under which the request was issued.
532
533 # Note that this routine used to be just:
534 # return 0 if $_[1]->method eq "POST"; return 1;
535
536 my($self, $new_request, $response) = @_;
537 my $method = $response->request->method;
538 return 0 unless grep $_ eq $method,
539 @{ $self->requests_redirectable || [] };
540
541 if ($new_request->url->scheme eq 'file') {
542 $response->header("Client-Warning" =>
543 "Can't redirect to a file:// URL!");
544 return 0;
545 }
546
547 # Otherwise it's apparently okay...
548 return 1;
549}
550
551
552sub credentials
553{
554 my($self, $netloc, $realm, $uid, $pass) = @_;
555 @{ $self->{'basic_authentication'}{lc($netloc)}{$realm} } =
556 ($uid, $pass);
557}
558
559
560sub get_basic_credentials
561{
562 my($self, $realm, $uri, $proxy) = @_;
563 return if $proxy;
564
565 my $host_port = lc($uri->host_port);
566 if (exists $self->{'basic_authentication'}{$host_port}{$realm}) {
567 return @{ $self->{'basic_authentication'}{$host_port}{$realm} };
568 }
569
570 return (undef, undef);
571}
572
573
574
# spent 79µs (65+14) within LWP::UserAgent::agent which was called # once (65µs+14µs) by LWP::UserAgent::new at line 96
sub agent {
575434µs my $self = shift;
576 my $old = $self->{agent};
577347µs if (@_) {
578 my $agent = shift;
579 $agent .= $self->_agent if $agent && $agent =~ /\s+$/;
# spent 14µs making 1 call to LWP::UserAgent::CORE:match
580 $self->{agent} = $agent;
581 }
582 $old;
583}
584
585
586sub _agent { "libwww-perl/$LWP::VERSION" }
587
588sub timeout { shift->_elem('timeout', @_); }
589sub from { shift->_elem('from', @_); }
590sub parse_head { shift->_elem('parse_head', @_); }
591sub max_size { shift->_elem('max_size', @_); }
592sub max_redirect { shift->_elem('max_redirect', @_); }
593
594
595sub cookie_jar {
596 my $self = shift;
597 my $old = $self->{cookie_jar};
598 if (@_) {
599 my $jar = shift;
600 if (ref($jar) eq "HASH") {
601 require HTTP::Cookies;
602 $jar = HTTP::Cookies->new(%$jar);
603 }
604 $self->{cookie_jar} = $jar;
605 }
606 $old;
607}
608
609sub default_headers {
610 my $self = shift;
611 my $old = $self->{def_headers} ||= HTTP::Headers->new;
612 if (@_) {
613 $self->{def_headers} = shift;
614 }
615 return $old;
616}
617
618sub default_header {
619 my $self = shift;
620 return $self->default_headers->header(@_);
621}
622
623
624sub conn_cache {
625 my $self = shift;
626 my $old = $self->{conn_cache};
627 if (@_) {
628 my $cache = shift;
629 if (ref($cache) eq "HASH") {
630 require LWP::ConnCache;
631 $cache = LWP::ConnCache->new(%$cache);
632 }
633 $self->{conn_cache} = $cache;
634 }
635 $old;
636}
637
638
639# depreciated
640sub use_eval { shift->_elem('use_eval', @_); }
641sub use_alarm
642{
643 Carp::carp("LWP::UserAgent->use_alarm(BOOL) is a no-op")
644 if @_ > 1 && $^W;
645 "";
646}
647
648
649sub clone
650{
651 my $self = shift;
652 my $copy = bless { %$self }, ref $self; # copy most fields
653
654 # elements that are references must be handled in a special way
655 $copy->{'proxy'} = { %{$self->{'proxy'}} };
656 $copy->{'no_proxy'} = [ @{$self->{'no_proxy'}} ]; # copy array
657
658 # remove reference to objects for now
659 delete $copy->{cookie_jar};
660 delete $copy->{conn_cache};
661
662 $copy;
663}
664
665
666sub mirror
667{
668 my($self, $url, $file) = @_;
669
670 LWP::Debug::trace('()');
671 my $request = HTTP::Request->new('GET', $url);
672
673 if (-e $file) {
674 my($mtime) = (stat($file))[9];
675 if($mtime) {
676 $request->header('If-Modified-Since' =>
677 HTTP::Date::time2str($mtime));
678 }
679 }
680 my $tmpfile = "$file-$$";
681
682 my $response = $self->request($request, $tmpfile);
683 if ($response->is_success) {
684
685 my $file_length = (stat($tmpfile))[7];
686 my($content_length) = $response->header('Content-length');
687
688 if (defined $content_length and $file_length < $content_length) {
689 unlink($tmpfile);
690 die "Transfer truncated: " .
691 "only $file_length out of $content_length bytes received\n";
692 }
693 elsif (defined $content_length and $file_length > $content_length) {
694 unlink($tmpfile);
695 die "Content-length mismatch: " .
696 "expected $content_length bytes, got $file_length\n";
697 }
698 else {
699 # OK
700 if (-e $file) {
701 # Some dosish systems fail to rename if the target exists
702 chmod 0777, $file;
703 unlink $file;
704 }
705 rename($tmpfile, $file) or
706 die "Cannot rename '$tmpfile' to '$file': $!\n";
707
708 if (my $lm = $response->last_modified) {
709 # make sure the file has the same last modification time
710 utime $lm, $lm, $file;
711 }
712 }
713 }
714 else {
715 unlink($tmpfile);
716 }
717 return $response;
718}
719
720
721sub proxy
722{
723 my $self = shift;
724 my $key = shift;
725
726 LWP::Debug::trace("$key @_");
727
728 return map $self->proxy($_, @_), @$key if ref $key;
729
730 my $old = $self->{'proxy'}{$key};
731 $self->{'proxy'}{$key} = shift if @_;
732 return $old;
733}
734
735
736sub env_proxy {
737 my ($self) = @_;
738 my($k,$v);
739 while(($k, $v) = each %ENV) {
740 if ($ENV{REQUEST_METHOD}) {
741 # Need to be careful when called in the CGI environment, as
742 # the HTTP_PROXY variable is under control of that other guy.
743 next if $k =~ /^HTTP_/;
744 $k = "HTTP_PROXY" if $k eq "CGI_HTTP_PROXY";
745 }
746 $k = lc($k);
747 next unless $k =~ /^(.*)_proxy$/;
748 $k = $1;
749 if ($k eq 'no') {
750 $self->no_proxy(split(/\s*,\s*/, $v));
751 }
752 else {
753 $self->proxy($k, $v);
754 }
755 }
756}
757
758
759sub no_proxy {
760 my($self, @no) = @_;
761 if (@no) {
762 push(@{ $self->{'no_proxy'} }, @no);
763 }
764 else {
765 $self->{'no_proxy'} = [];
766 }
767}
768
769
770# Private method which returns the URL of the Proxy configured for this
771# URL, or undefined if none is configured.
772sub _need_proxy
773
# spent 72.9ms (31.0+41.9) within LWP::UserAgent::_need_proxy which was called 461 times, avg 158µs/call: # 461 times (31.0ms+41.9ms) by LWP::UserAgent::send_request at line 153, avg 158µs/call
{
774276629.3ms my($self, $url) = @_;
775 $url = $HTTP::URI_CLASS->new($url) unless ref $url;
776
777 my $scheme = $url->scheme || return;
# spent 36.5ms making 461 calls to URI::scheme, avg 79µs/call
778 if (my $proxy = $self->{'proxy'}{$scheme}) {
779 if (@{ $self->{'no_proxy'} }) {
780 if (my $host = eval { $url->host }) {
781 for my $domain (@{ $self->{'no_proxy'} }) {
782 if ($host =~ /\Q$domain\E$/) {
783 LWP::Debug::trace("no_proxy configured");
784 return;
785 }
786 }
787 }
788 }
789 LWP::Debug::debug("Proxied to $proxy");
790 return $HTTP::URI_CLASS->new($proxy);
791 }
792 LWP::Debug::debug('Not proxied');
# spent 5.47ms making 461 calls to LWP::Debug::debug, avg 12µs/call
793 undef;
794}
795
796
797sub _new_response {
798 my($request, $code, $message) = @_;
799 my $response = HTTP::Response->new($code, $message);
800 $response->request($request);
801 $response->header("Client-Date" => HTTP::Date::time2str(time));
802 $response->header("Client-Warning" => "Internal response");
803 $response->header("Content-Type" => "text/plain");
804 $response->content("$code $message\n");
805 return $response;
806}
807
808
809129µs1;
810
811__END__
812
813=head1 NAME
814
815LWP::UserAgent - Web user agent class
816
817=head1 SYNOPSIS
818
819 require LWP::UserAgent;
820
821 my $ua = LWP::UserAgent->new;
822 $ua->timeout(10);
823 $ua->env_proxy;
824
825 my $response = $ua->get('http://search.cpan.org/');
826
827 if ($response->is_success) {
828 print $response->content; # or whatever
829 }
830 else {
831 die $response->status_line;
832 }
833
834=head1 DESCRIPTION
835
836The C<LWP::UserAgent> is a class implementing a web user agent.
837C<LWP::UserAgent> objects can be used to dispatch web requests.
838
839In normal use the application creates an C<LWP::UserAgent> object, and
840then configures it with values for timeouts, proxies, name, etc. It
841then creates an instance of C<HTTP::Request> for the request that
842needs to be performed. This request is then passed to one of the
843request method the UserAgent, which dispatches it using the relevant
844protocol, and returns a C<HTTP::Response> object. There are
845convenience methods for sending the most common request types: get(),
846head() and post(). When using these methods then the creation of the
847request object is hidden as shown in the synopsis above.
848
849The basic approach of the library is to use HTTP style communication
850for all protocol schemes. This means that you will construct
851C<HTTP::Request> objects and receive C<HTTP::Response> objects even
852for non-HTTP resources like I<gopher> and I<ftp>. In order to achieve
853even more similarity to HTTP style communications, gopher menus and
854file directories are converted to HTML documents.
855
856=head1 CONSTRUCTOR METHODS
857
858The following constructor methods are available:
859
860=over 4
861
862=item $ua = LWP::UserAgent->new( %options )
863
864This method constructs a new C<LWP::UserAgent> object and returns it.
865Key/value pair arguments may be provided to set up the initial state.
866The following options correspond to attribute methods described below:
867
868 KEY DEFAULT
869 ----------- --------------------
870 agent "libwww-perl/#.##"
871 from undef
872 conn_cache undef
873 cookie_jar undef
874 default_headers HTTP::Headers->new
875 max_size undef
876 max_redirect 7
877 parse_head 1
878 protocols_allowed undef
879 protocols_forbidden undef
880 requests_redirectable ['GET', 'HEAD']
881 timeout 180
882
883The following additional options are also accepted: If the
884C<env_proxy> option is passed in with a TRUE value, then proxy
885settings are read from environment variables (see env_proxy() method
886below). If the C<keep_alive> option is passed in, then a
887C<LWP::ConnCache> is set up (see conn_cache() method below). The
888C<keep_alive> value is passed on as the C<total_capacity> for the
889connection cache.
890
891=item $ua->clone
892
893Returns a copy of the LWP::UserAgent object.
894
895=back
896
897=head1 ATTRIBUTES
898
899The settings of the configuration attributes modify the behaviour of the
900C<LWP::UserAgent> when it dispatches requests. Most of these can also
901be initialized by options passed to the constructor method.
902
903The following attributes methods are provided. The attribute value is
904left unchanged if no argument is given. The return value from each
905method is the old attribute value.
906
907=over
908
909=item $ua->agent
910
911=item $ua->agent( $product_id )
912
913Get/set the product token that is used to identify the user agent on
914the network. The agent value is sent as the "User-Agent" header in
915the requests. The default is the string returned by the _agent()
916method (see below).
917
918If the $product_id ends with space then the _agent() string is
919appended to it.
920
921The user agent string should be one or more simple product identifiers
922with an optional version number separated by the "/" character.
923Examples are:
924
925 $ua->agent('Checkbot/0.4 ' . $ua->_agent);
926 $ua->agent('Checkbot/0.4 '); # same as above
927 $ua->agent('Mozilla/5.0');
928 $ua->agent(""); # don't identify
929
930=item $ua->_agent
931
932Returns the default agent identifier. This is a string of the form
933"libwww-perl/#.##", where "#.##" is substituted with the version number
934of this library.
935
936=item $ua->from
937
938=item $ua->from( $email_address )
939
940Get/set the e-mail address for the human user who controls
941the requesting user agent. The address should be machine-usable, as
942defined in RFC 822. The C<from> value is send as the "From" header in
943the requests. Example:
944
945 $ua->from('gaas@cpan.org');
946
947The default is to not send a "From" header. See the default_headers()
948method for the more general interface that allow any header to be defaulted.
949
950=item $ua->cookie_jar
951
952=item $ua->cookie_jar( $cookie_jar_obj )
953
954Get/set the cookie jar object to use. The only requirement is that
955the cookie jar object must implement the extract_cookies($request) and
956add_cookie_header($response) methods. These methods will then be
957invoked by the user agent as requests are sent and responses are
958received. Normally this will be a C<HTTP::Cookies> object or some
959subclass.
960
961The default is to have no cookie_jar, i.e. never automatically add
962"Cookie" headers to the requests.
963
964Shortcut: If a reference to a plain hash is passed in as the
965$cookie_jar_object, then it is replaced with an instance of
966C<HTTP::Cookies> that is initialized based on the hash. This form also
967automatically loads the C<HTTP::Cookies> module. It means that:
968
969 $ua->cookie_jar({ file => "$ENV{HOME}/.cookies.txt" });
970
971is really just a shortcut for:
972
973 require HTTP::Cookies;
974 $ua->cookie_jar(HTTP::Cookies->new(file => "$ENV{HOME}/.cookies.txt"));
975
976=item $ua->default_headers
977
978=item $ua->default_headers( $headers_obj )
979
980Get/set the headers object that will provide default header values for
981any requests sent. By default this will be an empty C<HTTP::Headers>
982object. Example:
983
984 $ua->default_headers->push_header('Accept-Language' => "no, en");
985
986=item $ua->default_header( $field )
987
988=item $ua->default_header( $field => $value )
989
990This is just a short-cut for $ua->default_headers->header( $field =>
991$value ). Example:
992
993 $ua->default_header('Accept-Language' => "no, en");
994
995=item $ua->conn_cache
996
997=item $ua->conn_cache( $cache_obj )
998
999Get/set the C<LWP::ConnCache> object to use. See L<LWP::ConnCache>
1000for details.
1001
1002=item $ua->credentials( $netloc, $realm, $uname, $pass )
1003
1004Set the user name and password to be used for a realm. It is often more
1005useful to specialize the get_basic_credentials() method instead.
1006
1007=item $ua->max_size
1008
1009=item $ua->max_size( $bytes )
1010
1011Get/set the size limit for response content. The default is C<undef>,
1012which means that there is no limit. If the returned response content
1013is only partial, because the size limit was exceeded, then a
1014"Client-Aborted" header will be added to the response. The content
1015might end up longer than C<max_size> as we abort once appending a
1016chunk of data makes the length exceed the limit. The "Content-Length"
1017header, if present, will indicate the length of the full content and
1018will normally not be the same as C<< length($res->content) >>.
1019
1020=item $ua->max_redirect
1021
1022=item $ua->max_redirect( $n )
1023
1024This reads or sets the object's limit of how many times it will obey
1025redirection responses in a given request cycle.
1026
1027By default, the value is 7. This means that if you call request()
1028method and the response is a redirect elsewhere which is in turn a
1029redirect, and so on seven times, then LWP gives up after that seventh
1030request.
1031
1032=item $ua->parse_head
1033
1034=item $ua->parse_head( $boolean )
1035
1036Get/set a value indicating whether we should initialize response
1037headers from the E<lt>head> section of HTML documents. The default is
1038TRUE. Do not turn this off, unless you know what you are doing.
1039
1040=item $ua->protocols_allowed
1041
1042=item $ua->protocols_allowed( \@protocols )
1043
1044This reads (or sets) this user agent's list of protocols that the
1045request methods will exclusively allow. The protocol names are case
1046insensitive.
1047
1048For example: C<$ua-E<gt>protocols_allowed( [ 'http', 'https'] );>
1049means that this user agent will I<allow only> those protocols,
1050and attempts to use this user agent to access URLs with any other
1051schemes (like "ftp://...") will result in a 500 error.
1052
1053To delete the list, call: C<$ua-E<gt>protocols_allowed(undef)>
1054
1055By default, an object has neither a C<protocols_allowed> list, nor a
1056C<protocols_forbidden> list.
1057
1058Note that having a C<protocols_allowed> list causes any
1059C<protocols_forbidden> list to be ignored.
1060
1061=item $ua->protocols_forbidden
1062
1063=item $ua->protocols_forbidden( \@protocols )
1064
1065This reads (or sets) this user agent's list of protocols that the
1066request method will I<not> allow. The protocol names are case
1067insensitive.
1068
1069For example: C<$ua-E<gt>protocols_forbidden( [ 'file', 'mailto'] );>
1070means that this user agent will I<not> allow those protocols, and
1071attempts to use this user agent to access URLs with those schemes
1072will result in a 500 error.
1073
1074To delete the list, call: C<$ua-E<gt>protocols_forbidden(undef)>
1075
1076=item $ua->requests_redirectable
1077
1078=item $ua->requests_redirectable( \@requests )
1079
1080This reads or sets the object's list of request names that
1081C<$ua-E<gt>redirect_ok(...)> will allow redirection for. By
1082default, this is C<['GET', 'HEAD']>, as per RFC 2616. To
1083change to include 'POST', consider:
1084
1085 push @{ $ua->requests_redirectable }, 'POST';
1086
1087=item $ua->timeout
1088
1089=item $ua->timeout( $secs )
1090
1091Get/set the timeout value in seconds. The default timeout() value is
1092180 seconds, i.e. 3 minutes.
1093
1094The requests is aborted if no activity on the connection to the server
1095is observed for C<timeout> seconds. This means that the time it takes
1096for the complete transaction and the request() method to actually
1097return might be longer.
1098
1099=back
1100
1101=head2 Proxy attributes
1102
1103The following methods set up when requests should be passed via a
1104proxy server.
1105
1106=over
1107
1108=item $ua->proxy(\@schemes, $proxy_url)
1109
1110=item $ua->proxy($scheme, $proxy_url)
1111
1112Set/retrieve proxy URL for a scheme:
1113
1114 $ua->proxy(['http', 'ftp'], 'http://proxy.sn.no:8001/');
1115 $ua->proxy('gopher', 'http://proxy.sn.no:8001/');
1116
1117The first form specifies that the URL is to be used for proxying of
1118access methods listed in the list in the first method argument,
1119i.e. 'http' and 'ftp'.
1120
1121The second form shows a shorthand form for specifying
1122proxy URL for a single access scheme.
1123
1124=item $ua->no_proxy( $domain, ... )
1125
1126Do not proxy requests to the given domains. Calling no_proxy without
1127any domains clears the list of domains. Eg:
1128
1129 $ua->no_proxy('localhost', 'no', ...);
1130
1131=item $ua->env_proxy
1132
1133Load proxy settings from *_proxy environment variables. You might
1134specify proxies like this (sh-syntax):
1135
1136 gopher_proxy=http://proxy.my.place/
1137 wais_proxy=http://proxy.my.place/
1138 no_proxy="localhost,my.domain"
1139 export gopher_proxy wais_proxy no_proxy
1140
1141csh or tcsh users should use the C<setenv> command to define these
1142environment variables.
1143
1144On systems with case insensitive environment variables there exists a
1145name clash between the CGI environment variables and the C<HTTP_PROXY>
1146environment variable normally picked up by env_proxy(). Because of
1147this C<HTTP_PROXY> is not honored for CGI scripts. The
1148C<CGI_HTTP_PROXY> environment variable can be used instead.
1149
1150=back
1151
1152=head1 REQUEST METHODS
1153
1154The methods described in this section are used to dispatch requests
1155via the user agent. The following request methods are provided:
1156
1157=over
1158
1159=item $ua->get( $url )
1160
1161=item $ua->get( $url , $field_name => $value, ... )
1162
1163This method will dispatch a C<GET> request on the given $url. Further
1164arguments can be given to initialize the headers of the request. These
1165are given as separate name/value pairs. The return value is a
1166response object. See L<HTTP::Response> for a description of the
1167interface it provides.
1168
1169Fields names that start with ":" are special. These will not
1170initialize headers of the request but will determine how the response
1171content is treated. The following special field names are recognized:
1172
1173 :content_file => $filename
1174 :content_cb => \&callback
1175 :read_size_hint => $bytes
1176
1177If a $filename is provided with the C<:content_file> option, then the
1178response content will be saved here instead of in the response
1179object. If a callback is provided with the C<:content_cb> option then
1180this function will be called for each chunk of the response content as
1181it is received from the server. If neither of these options are
1182given, then the response content will accumulate in the response
1183object itself. This might not be suitable for very large response
1184bodies. Only one of C<:content_file> or C<:content_cb> can be
1185specified. The content of unsuccessful responses will always
1186accumulate in the response object itself, regardless of the
1187C<:content_file> or C<:content_cb> options passed in.
1188
1189The C<:read_size_hint> option is passed to the protocol module which
1190will try to read data from the server in chunks of this size. A
1191smaller value for the C<:read_size_hint> will result in a higher
1192number of callback invocations.
1193
1194The callback function is called with 3 arguments: a chunk of data, a
1195reference to the response object, and a reference to the protocol
1196object. The callback can abort the request by invoking die(). The
1197exception message will show up as the "X-Died" header field in the
1198response returned by the get() function.
1199
1200=item $ua->head( $url )
1201
1202=item $ua->head( $url , $field_name => $value, ... )
1203
1204This method will dispatch a C<HEAD> request on the given $url.
1205Otherwise it works like the get() method described above.
1206
1207=item $ua->post( $url, \%form )
1208
1209=item $ua->post( $url, \@form )
1210
1211=item $ua->post( $url, \%form, $field_name => $value, ... )
1212
1213This method will dispatch a C<POST> request on the given $url, with
1214%form or @form providing the key/value pairs for the fill-in form
1215content. Additional headers and content options are the same as for
1216the get() method.
1217
1218This method will use the POST() function from C<HTTP::Request::Common>
1219to build the request. See L<HTTP::Request::Common> for a details on
1220how to pass form content and other advanced features.
1221
1222=item $ua->mirror( $url, $filename )
1223
1224This method will get the document identified by $url and store it in
1225file called $filename. If the file already exists, then the request
1226will contain an "If-Modified-Since" header matching the modification
1227time of the file. If the document on the server has not changed since
1228this time, then nothing happens. If the document has been updated, it
1229will be downloaded again. The modification time of the file will be
1230forced to match that of the server.
1231
1232The return value is the the response object.
1233
1234=item $ua->request( $request )
1235
1236=item $ua->request( $request, $content_file )
1237
1238=item $ua->request( $request, $content_cb )
1239
1240=item $ua->request( $request, $content_cb, $read_size_hint )
1241
1242This method will dispatch the given $request object. Normally this
1243will be an instance of the C<HTTP::Request> class, but any object with
1244a similar interface will do. The return value is a response object.
1245See L<HTTP::Request> and L<HTTP::Response> for a description of the
1246interface provided by these classes.
1247
1248The request() method will process redirects and authentication
1249responses transparently. This means that it may actually send several
1250simple requests via the simple_request() method described below.
1251
1252The request methods described above; get(), head(), post() and
1253mirror(), will all dispatch the request they build via this method.
1254They are convenience methods that simply hides the creation of the
1255request object for you.
1256
1257The $content_file, $content_cb and $read_size_hint all correspond to
1258options described with the get() method above.
1259
1260You are allowed to use a CODE reference as C<content> in the request
1261object passed in. The C<content> function should return the content
1262when called. The content can be returned in chunks. The content
1263function will be invoked repeatedly until it return an empty string to
1264signal that there is no more content.
1265
1266=item $ua->simple_request( $request )
1267
1268=item $ua->simple_request( $request, $content_file )
1269
1270=item $ua->simple_request( $request, $content_cb )
1271
1272=item $ua->simple_request( $request, $content_cb, $read_size_hint )
1273
1274This method dispatches a single request and returns the response
1275received. Arguments are the same as for request() described above.
1276
1277The difference from request() is that simple_request() will not try to
1278handle redirects or authentication responses. The request() method
1279will in fact invoke this method for each simple request it sends.
1280
1281=item $ua->is_protocol_supported( $scheme )
1282
1283You can use this method to test whether this user agent object supports the
1284specified C<scheme>. (The C<scheme> might be a string (like 'http' or
1285'ftp') or it might be an URI object reference.)
1286
1287Whether a scheme is supported, is determined by the user agent's
1288C<protocols_allowed> or C<protocols_forbidden> lists (if any), and by
1289the capabilities of LWP. I.e., this will return TRUE only if LWP
1290supports this protocol I<and> it's permitted for this particular
1291object.
1292
1293=back
1294
1295=head2 Callback methods
1296
1297The following methods will be invoked as requests are processed. These
1298methods are documented here because subclasses of C<LWP::UserAgent>
1299might want to override their behaviour.
1300
1301=over
1302
1303=item $ua->prepare_request( $request )
1304
1305This method is invoked by simple_request(). Its task is to modify the
1306given $request object by setting up various headers based on the
1307attributes of the user agent. The return value should normally be the
1308$request object passed in. If a different request object is returned
1309it will be the one actually processed.
1310
1311The headers affected by the base implementation are; "User-Agent",
1312"From", "Range" and "Cookie".
1313
1314=item $ua->redirect_ok( $prospective_request, $response )
1315
1316This method is called by request() before it tries to follow a
1317redirection to the request in $response. This should return a TRUE
1318value if this redirection is permissible. The $prospective_request
1319will be the request to be sent if this method returns TRUE.
1320
1321The base implementation will return FALSE unless the method
1322is in the object's C<requests_redirectable> list,
1323FALSE if the proposed redirection is to a "file://..."
1324URL, and TRUE otherwise.
1325
1326=item $ua->get_basic_credentials( $realm, $uri, $isproxy )
1327
1328This is called by request() to retrieve credentials for documents
1329protected by Basic or Digest Authentication. The arguments passed in
1330is the $realm provided by the server, the $uri requested and a boolean
1331flag to indicate if this is authentication against a proxy server.
1332
1333The method should return a username and password. It should return an
1334empty list to abort the authentication resolution attempt. Subclasses
1335can override this method to prompt the user for the information. An
1336example of this can be found in C<lwp-request> program distributed
1337with this library.
1338
1339The base implementation simply checks a set of pre-stored member
1340variables, set up with the credentials() method.
1341
1342=back
1343
1344=head1 SEE ALSO
1345
1346See L<LWP> for a complete overview of libwww-perl5. See L<lwpcook>
1347and the scripts F<lwp-request> and F<lwp-download> for examples of
1348usage.
1349
1350See L<HTTP::Request> and L<HTTP::Response> for a description of the
1351message objects dispatched and received. See L<HTTP::Request::Common>
1352and L<HTML::Form> for other ways to build request objects.
1353
1354See L<WWW::Mechanize> and L<WWW::Search> for examples of more
1355specialized user agents based on C<LWP::UserAgent>.
1356
1357=head1 COPYRIGHT
1358
1359Copyright 1995-2004 Gisle Aas.
1360
1361This library is free software; you can redistribute it and/or
1362modify it under the same terms as Perl itself.
# spent 48µs within LWP::UserAgent::CORE:match which was called 2 times, avg 24µs/call: # once (34µs+0s) by WWW::Google::PageRank::BEGIN at line 10 of LWP/UserAgent.pm # once (14µs+0s) by LWP::UserAgent::agent at line 579 of LWP/UserAgent.pm
sub LWP::UserAgent::CORE:match; # xsub
Report produced by the NYTProf 3.11 Perl profiler, developed by Tim Bunce and Adam Kaplan.