"Fossies" - the Fresh Open Source Software Archive

Member "libwww-perl-6.43/lib/LWP/UserAgent.pm" (26 Nov 2019, 72136 Bytes) of package /linux/www/libwww-perl-6.43.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "UserAgent.pm" see the Fossies "Dox" file reference documentation and the latest Fossies "Diffs" side-by-side code changes report: 6.42_vs_6.43.

    1 package LWP::UserAgent;
    2 
    3 use strict;
    4 
    5 use base qw(LWP::MemberMixin);
    6 
    7 use Carp ();
    8 use HTTP::Request ();
    9 use HTTP::Response ();
   10 use HTTP::Date ();
   11 
   12 use LWP ();
   13 use LWP::Protocol ();
   14 
   15 use Scalar::Util qw(blessed);
   16 use Try::Tiny qw(try catch);
   17 
   18 our $VERSION = '6.43';
   19 
   20 sub new
   21 {
   22     # Check for common user mistake
   23     Carp::croak("Options to LWP::UserAgent should be key/value pairs, not hash reference")
   24         if ref($_[1]) eq 'HASH';
   25 
   26     my($class, %cnf) = @_;
   27 
   28     my $agent = delete $cnf{agent};
   29     my $from  = delete $cnf{from};
   30     my $def_headers = delete $cnf{default_headers};
   31     my $timeout = delete $cnf{timeout};
   32     $timeout = 3*60 unless defined $timeout;
   33     my $local_address = delete $cnf{local_address};
   34     my $ssl_opts = delete $cnf{ssl_opts} || {};
   35     unless (exists $ssl_opts->{verify_hostname}) {
   36     # The processing of HTTPS_CA_* below is for compatibility with Crypt::SSLeay
   37     if (exists $ENV{PERL_LWP_SSL_VERIFY_HOSTNAME}) {
   38         $ssl_opts->{verify_hostname} = $ENV{PERL_LWP_SSL_VERIFY_HOSTNAME};
   39     }
   40     elsif ($ENV{HTTPS_CA_FILE} || $ENV{HTTPS_CA_DIR}) {
   41         # Crypt-SSLeay compatibility (verify peer certificate; but not the hostname)
   42         $ssl_opts->{verify_hostname} = 0;
   43         $ssl_opts->{SSL_verify_mode} = 1;
   44     }
   45     else {
   46         $ssl_opts->{verify_hostname} = 1;
   47     }
   48     }
   49     unless (exists $ssl_opts->{SSL_ca_file}) {
   50     if (my $ca_file = $ENV{PERL_LWP_SSL_CA_FILE} || $ENV{HTTPS_CA_FILE}) {
   51         $ssl_opts->{SSL_ca_file} = $ca_file;
   52     }
   53     }
   54     unless (exists $ssl_opts->{SSL_ca_path}) {
   55     if (my $ca_path = $ENV{PERL_LWP_SSL_CA_PATH} || $ENV{HTTPS_CA_DIR}) {
   56         $ssl_opts->{SSL_ca_path} = $ca_path;
   57     }
   58     }
   59     my $use_eval = delete $cnf{use_eval};
   60     $use_eval = 1 unless defined $use_eval;
   61     my $parse_head = delete $cnf{parse_head};
   62     $parse_head = 1 unless defined $parse_head;
   63     my $send_te = delete $cnf{send_te};
   64     $send_te = 1 unless defined $send_te;
   65     my $show_progress = delete $cnf{show_progress};
   66     my $max_size = delete $cnf{max_size};
   67     my $max_redirect = delete $cnf{max_redirect};
   68     $max_redirect = 7 unless defined $max_redirect;
   69     my $env_proxy = exists $cnf{env_proxy} ? delete $cnf{env_proxy} : $ENV{PERL_LWP_ENV_PROXY};
   70     my $no_proxy = exists $cnf{no_proxy} ? delete $cnf{no_proxy} : [];
   71     Carp::croak(qq{no_proxy must be an arrayref, not $no_proxy!}) if ref $no_proxy ne 'ARRAY';
   72 
   73     my $cookie_jar = delete $cnf{cookie_jar};
   74     my $conn_cache = delete $cnf{conn_cache};
   75     my $keep_alive = delete $cnf{keep_alive};
   76 
   77     Carp::croak("Can't mix conn_cache and keep_alive")
   78       if $conn_cache && $keep_alive;
   79 
   80     my $protocols_allowed   = delete $cnf{protocols_allowed};
   81     my $protocols_forbidden = delete $cnf{protocols_forbidden};
   82 
   83     my $requests_redirectable = delete $cnf{requests_redirectable};
   84     $requests_redirectable = ['GET', 'HEAD']
   85       unless defined $requests_redirectable;
   86 
   87     # Actually ""s are just as good as 0's, but for concision we'll just say:
   88     Carp::croak("protocols_allowed has to be an arrayref or 0, not \"$protocols_allowed\"!")
   89       if $protocols_allowed and ref($protocols_allowed) ne 'ARRAY';
   90     Carp::croak("protocols_forbidden has to be an arrayref or 0, not \"$protocols_forbidden\"!")
   91       if $protocols_forbidden and ref($protocols_forbidden) ne 'ARRAY';
   92     Carp::croak("requests_redirectable has to be an arrayref or 0, not \"$requests_redirectable\"!")
   93       if $requests_redirectable and ref($requests_redirectable) ne 'ARRAY';
   94 
   95     if (%cnf && $^W) {
   96     Carp::carp("Unrecognized LWP::UserAgent options: @{[sort keys %cnf]}");
   97     }
   98 
   99     my $self = bless {
  100         def_headers           => $def_headers,
  101         timeout               => $timeout,
  102         local_address         => $local_address,
  103         ssl_opts              => $ssl_opts,
  104         use_eval              => $use_eval,
  105         show_progress         => $show_progress,
  106         max_size              => $max_size,
  107         max_redirect          => $max_redirect,
  108         # We set proxy later as we do validation on the values
  109         proxy                 => {},
  110         no_proxy              => [ @{ $no_proxy } ],
  111         protocols_allowed     => $protocols_allowed,
  112         protocols_forbidden   => $protocols_forbidden,
  113         requests_redirectable => $requests_redirectable,
  114         send_te               => $send_te,
  115     }, $class;
  116 
  117     $self->agent(defined($agent) ? $agent : $class->_agent)
  118         if defined($agent) || !$def_headers || !$def_headers->header("User-Agent");
  119     $self->from($from) if $from;
  120     $self->cookie_jar($cookie_jar) if $cookie_jar;
  121     $self->parse_head($parse_head);
  122     $self->env_proxy if $env_proxy;
  123 
  124     if (exists $cnf{proxy}) {
  125         Carp::croak(qq{proxy must be an arrayref, not $cnf{proxy}!})
  126             if ref $cnf{proxy} ne 'ARRAY';
  127         $self->proxy($cnf{proxy});
  128     }
  129 
  130     $self->protocols_allowed(  $protocols_allowed  ) if $protocols_allowed;
  131     $self->protocols_forbidden($protocols_forbidden) if $protocols_forbidden;
  132 
  133     if ($keep_alive) {
  134     $conn_cache ||= { total_capacity => $keep_alive };
  135     }
  136     $self->conn_cache($conn_cache) if $conn_cache;
  137 
  138     return $self;
  139 }
  140 
  141 
  142 sub send_request
  143 {
  144     my($self, $request, $arg, $size) = @_;
  145     my($method, $url) = ($request->method, $request->uri);
  146     my $scheme = $url->scheme;
  147 
  148     local($SIG{__DIE__});  # protect against user defined die handlers
  149 
  150     $self->progress("begin", $request);
  151 
  152     my $response = $self->run_handlers("request_send", $request);
  153 
  154     unless ($response) {
  155         my $protocol;
  156 
  157         {
  158             # Honor object-specific restrictions by forcing protocol objects
  159             #  into class LWP::Protocol::nogo.
  160             my $x;
  161             if($x = $self->protocols_allowed) {
  162                 if (grep lc($_) eq $scheme, @$x) {
  163                 }
  164                 else {
  165                     require LWP::Protocol::nogo;
  166                     $protocol = LWP::Protocol::nogo->new;
  167                 }
  168             }
  169             elsif ($x = $self->protocols_forbidden) {
  170                 if(grep lc($_) eq $scheme, @$x) {
  171                     require LWP::Protocol::nogo;
  172                     $protocol = LWP::Protocol::nogo->new;
  173                 }
  174             }
  175             # else fall thru and create the protocol object normally
  176         }
  177 
  178         # Locate protocol to use
  179         my $proxy = $request->{proxy};
  180         if ($proxy) {
  181             $scheme = $proxy->scheme;
  182         }
  183 
  184         unless ($protocol) {
  185             try {
  186                 $protocol = LWP::Protocol::create($scheme, $self);
  187             }
  188             catch {
  189                 my $error = $_;
  190                 $error =~ s/ at .* line \d+.*//s;  # remove file/line number
  191                 $response =  _new_response($request, HTTP::Status::RC_NOT_IMPLEMENTED, $error);
  192                 if ($scheme eq "https") {
  193                     $response->message($response->message . " (LWP::Protocol::https not installed)");
  194                     $response->content_type("text/plain");
  195                     $response->content(<<EOT);
  196 LWP will support https URLs if the LWP::Protocol::https module
  197 is installed.
  198 EOT
  199                 }
  200             };
  201         }
  202 
  203         if (!$response && $self->{use_eval}) {
  204             # we eval, and turn dies into responses below
  205             try {
  206                 $response = $protocol->request($request, $proxy, $arg, $size, $self->{timeout}) || die "No response returned by $protocol";
  207             }
  208             catch {
  209                 my $error = $_;
  210                 if (blessed($error) && $error->isa("HTTP::Response")) {
  211                     $response = $error;
  212                     $response->request($request);
  213                 }
  214                 else {
  215                     my $full = $error;
  216                     (my $status = $error) =~ s/\n.*//s;
  217                     $status =~ s/ at .* line \d+.*//s;  # remove file/line number
  218                     my $code = ($status =~ s/^(\d\d\d)\s+//) ? $1 : HTTP::Status::RC_INTERNAL_SERVER_ERROR;
  219                     $response = _new_response($request, $code, $status, $full);
  220                 }
  221             };
  222         }
  223         elsif (!$response) {
  224             $response = $protocol->request($request, $proxy,
  225                                            $arg, $size, $self->{timeout});
  226             # XXX: Should we die unless $response->is_success ???
  227         }
  228     }
  229 
  230     $response->request($request);  # record request for reference
  231     $response->header("Client-Date" => HTTP::Date::time2str(time));
  232 
  233     $self->run_handlers("response_done", $response);
  234 
  235     $self->progress("end", $response);
  236     return $response;
  237 }
  238 
  239 
  240 sub prepare_request
  241 {
  242     my($self, $request) = @_;
  243     die "Method missing" unless $request->method;
  244     my $url = $request->uri;
  245     die "URL missing" unless $url;
  246     die "URL must be absolute" unless $url->scheme;
  247 
  248     $self->run_handlers("request_preprepare", $request);
  249 
  250     if (my $def_headers = $self->{def_headers}) {
  251     for my $h ($def_headers->header_field_names) {
  252         $request->init_header($h => [$def_headers->header($h)]);
  253     }
  254     }
  255 
  256     $self->run_handlers("request_prepare", $request);
  257 
  258     return $request;
  259 }
  260 
  261 
  262 sub simple_request
  263 {
  264     my($self, $request, $arg, $size) = @_;
  265 
  266     # sanity check the request passed in
  267     if (defined $request) {
  268     if (ref $request) {
  269         Carp::croak("You need a request object, not a " . ref($request) . " object")
  270           if ref($request) eq 'ARRAY' or ref($request) eq 'HASH' or
  271          !$request->can('method') or !$request->can('uri');
  272     }
  273     else {
  274         Carp::croak("You need a request object, not '$request'");
  275     }
  276     }
  277     else {
  278         Carp::croak("No request object passed in");
  279     }
  280 
  281     my $error;
  282     try {
  283         $request = $self->prepare_request($request);
  284     }
  285     catch {
  286         $error = $_;
  287         $error =~ s/ at .* line \d+.*//s;  # remove file/line number
  288     };
  289 
  290     if ($error) {
  291         return _new_response($request, HTTP::Status::RC_BAD_REQUEST, $error);
  292     }
  293     return $self->send_request($request, $arg, $size);
  294 }
  295 
  296 
  297 sub request {
  298     my ($self, $request, $arg, $size, $previous) = @_;
  299 
  300     my $response = $self->simple_request($request, $arg, $size);
  301     $response->previous($previous) if $previous;
  302 
  303     if ($response->redirects >= $self->{max_redirect}) {
  304         $response->header("Client-Warning" =>
  305                 "Redirect loop detected (max_redirect = $self->{max_redirect})"
  306         );
  307         return $response;
  308     }
  309 
  310     if (my $req = $self->run_handlers("response_redirect", $response)) {
  311         return $self->request($req, $arg, $size, $response);
  312     }
  313 
  314     my $code = $response->code;
  315 
  316     if (   $code == HTTP::Status::RC_MOVED_PERMANENTLY
  317         or $code == HTTP::Status::RC_FOUND
  318         or $code == HTTP::Status::RC_SEE_OTHER
  319         or $code == HTTP::Status::RC_TEMPORARY_REDIRECT)
  320     {
  321         my $referral = $request->clone;
  322 
  323         # These headers should never be forwarded
  324         $referral->remove_header('Host', 'Cookie');
  325 
  326         if (   $referral->header('Referer')
  327             && $request->uri->scheme eq 'https'
  328             && $referral->uri->scheme eq 'http')
  329         {
  330             # RFC 2616, section 15.1.3.
  331             # https -> http redirect, suppressing Referer
  332             $referral->remove_header('Referer');
  333         }
  334 
  335         if (   $code == HTTP::Status::RC_SEE_OTHER
  336             || $code == HTTP::Status::RC_FOUND)
  337         {
  338             my $method = uc($referral->method);
  339             unless ($method eq "GET" || $method eq "HEAD") {
  340                 $referral->method("GET");
  341                 $referral->content("");
  342                 $referral->remove_content_headers;
  343             }
  344         }
  345 
  346         # And then we update the URL based on the Location:-header.
  347         my $referral_uri = $response->header('Location');
  348         {
  349             # Some servers erroneously return a relative URL for redirects,
  350             # so make it absolute if it not already is.
  351             local $URI::ABS_ALLOW_RELATIVE_SCHEME = 1;
  352             my $base = $response->base;
  353             $referral_uri = "" unless defined $referral_uri;
  354             $referral_uri
  355                 = $HTTP::URI_CLASS->new($referral_uri, $base)->abs($base);
  356         }
  357         $referral->uri($referral_uri);
  358 
  359         return $response unless $self->redirect_ok($referral, $response);
  360         return $self->request($referral, $arg, $size, $response);
  361 
  362     }
  363     elsif ($code == HTTP::Status::RC_UNAUTHORIZED
  364         || $code == HTTP::Status::RC_PROXY_AUTHENTICATION_REQUIRED)
  365     {
  366         my $proxy = ($code == HTTP::Status::RC_PROXY_AUTHENTICATION_REQUIRED);
  367         my $ch_header
  368             = $proxy || $request->method eq 'CONNECT'
  369             ? "Proxy-Authenticate"
  370             : "WWW-Authenticate";
  371         my @challenges = $response->header($ch_header);
  372         unless (@challenges) {
  373             $response->header(
  374                 "Client-Warning" => "Missing Authenticate header");
  375             return $response;
  376         }
  377 
  378         require HTTP::Headers::Util;
  379         CHALLENGE: for my $challenge (@challenges) {
  380             $challenge =~ tr/,/;/;    # "," is used to separate auth-params!!
  381             ($challenge) = HTTP::Headers::Util::split_header_words($challenge);
  382             my $scheme = shift(@$challenge);
  383             shift(@$challenge);       # no value
  384             $challenge = {@$challenge};    # make rest into a hash
  385 
  386             unless ($scheme =~ /^([a-z]+(?:-[a-z]+)*)$/) {
  387                 $response->header(
  388                     "Client-Warning" => "Bad authentication scheme '$scheme'");
  389                 return $response;
  390             }
  391             $scheme = $1;                  # untainted now
  392             my $class = "LWP::Authen::\u$scheme";
  393             $class =~ tr/-/_/;
  394 
  395             no strict 'refs';
  396             unless (%{"$class\::"}) {
  397                 # try to load it
  398                 my $error;
  399                 try {
  400                     (my $req = $class) =~ s{::}{/}g;
  401                     $req .= '.pm' unless $req =~ /\.pm$/;
  402                     require $req;
  403                 }
  404                 catch {
  405                     $error = $_;
  406                 };
  407                 if ($error) {
  408                     if ($error =~ /^Can\'t locate/) {
  409                         $response->header("Client-Warning" =>
  410                                 "Unsupported authentication scheme '$scheme'");
  411                     }
  412                     else {
  413                         $response->header("Client-Warning" => $error);
  414                     }
  415                     next CHALLENGE;
  416                 }
  417             }
  418             unless ($class->can("authenticate")) {
  419                 $response->header("Client-Warning" =>
  420                         "Unsupported authentication scheme '$scheme'");
  421                 next CHALLENGE;
  422             }
  423             my $re = $class->authenticate($self, $proxy, $challenge, $response,
  424                 $request, $arg, $size);
  425 
  426             next CHALLENGE if $re->code == HTTP::Status::RC_UNAUTHORIZED;
  427             return $re;
  428         }
  429         return $response;
  430     }
  431     return $response;
  432 }
  433 
  434 #
  435 # Now the shortcuts...
  436 #
  437 sub get {
  438     require HTTP::Request::Common;
  439     my($self, @parameters) = @_;
  440     my @suff = $self->_process_colonic_headers(\@parameters,1);
  441     return $self->request( HTTP::Request::Common::GET( @parameters ), @suff );
  442 }
  443 
  444 sub _has_raw_content {
  445     my $self = shift;
  446     shift; # drop url
  447 
  448     # taken from HTTP::Request::Common::request_type_with_data
  449     my $content;
  450     $content = shift if @_ and ref $_[0];
  451     my($k, $v);
  452     while (($k,$v) = splice(@_, 0, 2)) {
  453         if (lc($k) eq 'content') {
  454             $content = $v;
  455         }
  456     }
  457 
  458     # We were given Content => 'string' ...
  459     if (defined $content && ! ref ($content)) {
  460         return 1;
  461     }
  462 
  463     return;
  464 }
  465 
  466 sub _maybe_copy_default_content_type {
  467     my ($self, $req, @parameters) = @_;
  468 
  469     # If we have a default Content-Type and someone passes in a POST/PUT
  470     # with Content => 'some-string-value', use that Content-Type instead
  471     # of x-www-form-urlencoded
  472     my $ct = $self->default_header('Content-Type');
  473     return unless defined $ct && $self->_has_raw_content(@parameters);
  474 
  475     $req->header('Content-Type' => $ct);
  476 }
  477 
  478 sub post {
  479     require HTTP::Request::Common;
  480     my($self, @parameters) = @_;
  481     my @suff = $self->_process_colonic_headers(\@parameters, (ref($parameters[1]) ? 2 : 1));
  482     my $req = HTTP::Request::Common::POST(@parameters);
  483     $self->_maybe_copy_default_content_type($req, @parameters);
  484     return $self->request($req, @suff);
  485 }
  486 
  487 
  488 sub head {
  489     require HTTP::Request::Common;
  490     my($self, @parameters) = @_;
  491     my @suff = $self->_process_colonic_headers(\@parameters,1);
  492     return $self->request( HTTP::Request::Common::HEAD( @parameters ), @suff );
  493 }
  494 
  495 sub patch {
  496     require HTTP::Request::Common;
  497     my($self, @parameters) = @_;
  498     my @suff = $self->_process_colonic_headers(\@parameters, (ref($parameters[1]) ? 2 : 1));
  499 
  500     # this work-around is in place as HTTP::Request::Common
  501     # did not implement a patch convenience method until
  502     # version 6.12. Once we can bump the prereq to at least
  503     # that version, we can use ::PATCH instead of this hack
  504     my $req = HTTP::Request::Common::PUT(@parameters);
  505     $req->method('PATCH');
  506 
  507     $self->_maybe_copy_default_content_type($req, @parameters);
  508     return $self->request($req, @suff);
  509 }
  510 
  511 sub put {
  512     require HTTP::Request::Common;
  513     my($self, @parameters) = @_;
  514     my @suff = $self->_process_colonic_headers(\@parameters, (ref($parameters[1]) ? 2 : 1));
  515     my $req = HTTP::Request::Common::PUT(@parameters);
  516     $self->_maybe_copy_default_content_type($req, @parameters);
  517     return $self->request($req, @suff);
  518 }
  519 
  520 
  521 sub delete {
  522     require HTTP::Request::Common;
  523     my($self, @parameters) = @_;
  524     my @suff = $self->_process_colonic_headers(\@parameters,1);
  525     return $self->request( HTTP::Request::Common::DELETE( @parameters ), @suff );
  526 }
  527 
  528 
  529 sub _process_colonic_headers {
  530     # Process :content_cb / :content_file / :read_size_hint headers.
  531     my($self, $args, $start_index) = @_;
  532 
  533     my($arg, $size);
  534     for(my $i = $start_index; $i < @$args; $i += 2) {
  535     next unless defined $args->[$i];
  536 
  537     #printf "Considering %s => %s\n", $args->[$i], $args->[$i + 1];
  538 
  539     if($args->[$i] eq ':content_cb') {
  540         # Some sanity-checking...
  541         $arg = $args->[$i + 1];
  542         Carp::croak("A :content_cb value can't be undef") unless defined $arg;
  543         Carp::croak("A :content_cb value must be a coderef")
  544         unless ref $arg and UNIVERSAL::isa($arg, 'CODE');
  545 
  546     }
  547     elsif ($args->[$i] eq ':content_file') {
  548         $arg = $args->[$i + 1];
  549 
  550         # Some sanity-checking...
  551         Carp::croak("A :content_file value can't be undef")
  552         unless defined $arg;
  553         Carp::croak("A :content_file value can't be a reference")
  554         if ref $arg;
  555         Carp::croak("A :content_file value can't be \"\"")
  556         unless length $arg;
  557 
  558     }
  559     elsif ($args->[$i] eq ':read_size_hint') {
  560         $size = $args->[$i + 1];
  561         # Bother checking it?
  562 
  563     }
  564     else {
  565         next;
  566     }
  567     splice @$args, $i, 2;
  568     $i -= 2;
  569     }
  570 
  571     # And return a suitable suffix-list for request(REQ,...)
  572 
  573     return             unless defined $arg;
  574     return $arg, $size if     defined $size;
  575     return $arg;
  576 }
  577 
  578 
  579 sub is_online {
  580     my $self = shift;
  581     return 1 if $self->get("http://www.msftncsi.com/ncsi.txt")->content eq "Microsoft NCSI";
  582     return 1 if $self->get("http://www.apple.com")->content =~ m,<title>Apple</title>,;
  583     return 0;
  584 }
  585 
  586 
  587 my @ANI = qw(- \ | /);
  588 
  589 sub progress {
  590     my($self, $status, $m) = @_;
  591     return unless $self->{show_progress};
  592 
  593     local($,, $\);
  594     if ($status eq "begin") {
  595         print STDERR "** ", $m->method, " ", $m->uri, " ==> ";
  596         $self->{progress_start} = time;
  597         $self->{progress_lastp} = "";
  598         $self->{progress_ani} = 0;
  599     }
  600     elsif ($status eq "end") {
  601         delete $self->{progress_lastp};
  602         delete $self->{progress_ani};
  603         print STDERR $m->status_line;
  604         my $t = time - delete $self->{progress_start};
  605         print STDERR " (${t}s)" if $t;
  606         print STDERR "\n";
  607     }
  608     elsif ($status eq "tick") {
  609         print STDERR "$ANI[$self->{progress_ani}++]\b";
  610         $self->{progress_ani} %= @ANI;
  611     }
  612     else {
  613         my $p = sprintf "%3.0f%%", $status * 100;
  614         return if $p eq $self->{progress_lastp};
  615         print STDERR "$p\b\b\b\b";
  616         $self->{progress_lastp} = $p;
  617     }
  618     STDERR->flush;
  619 }
  620 
  621 
  622 #
  623 # This whole allow/forbid thing is based on man 1 at's way of doing things.
  624 #
  625 sub is_protocol_supported
  626 {
  627     my($self, $scheme) = @_;
  628     if (ref $scheme) {
  629     # assume we got a reference to an URI object
  630     $scheme = $scheme->scheme;
  631     }
  632     else {
  633     Carp::croak("Illegal scheme '$scheme' passed to is_protocol_supported")
  634         if $scheme =~ /\W/;
  635     $scheme = lc $scheme;
  636     }
  637 
  638     my $x;
  639     if(ref($self) and $x       = $self->protocols_allowed) {
  640       return 0 unless grep lc($_) eq $scheme, @$x;
  641     }
  642     elsif (ref($self) and $x = $self->protocols_forbidden) {
  643       return 0 if grep lc($_) eq $scheme, @$x;
  644     }
  645 
  646     local($SIG{__DIE__});  # protect against user defined die handlers
  647     $x = LWP::Protocol::implementor($scheme);
  648     return 1 if $x and $x ne 'LWP::Protocol::nogo';
  649     return 0;
  650 }
  651 
  652 
  653 sub protocols_allowed      { shift->_elem('protocols_allowed'    , @_) }
  654 sub protocols_forbidden    { shift->_elem('protocols_forbidden'  , @_) }
  655 sub requests_redirectable  { shift->_elem('requests_redirectable', @_) }
  656 
  657 
  658 sub redirect_ok
  659 {
  660     # RFC 2616, section 10.3.2 and 10.3.3 say:
  661     #  If the 30[12] status code is received in response to a request other
  662     #  than GET or HEAD, the user agent MUST NOT automatically redirect the
  663     #  request unless it can be confirmed by the user, since this might
  664     #  change the conditions under which the request was issued.
  665 
  666     # Note that this routine used to be just:
  667     #  return 0 if $_[1]->method eq "POST";  return 1;
  668 
  669     my($self, $new_request, $response) = @_;
  670     my $method = $response->request->method;
  671     return 0 unless grep $_ eq $method,
  672       @{ $self->requests_redirectable || [] };
  673 
  674     if ($new_request->uri->scheme eq 'file') {
  675       $response->header("Client-Warning" =>
  676             "Can't redirect to a file:// URL!");
  677       return 0;
  678     }
  679 
  680     # Otherwise it's apparently okay...
  681     return 1;
  682 }
  683 
  684 sub credentials {
  685     my $self   = shift;
  686     my $netloc = lc(shift || '');
  687     my $realm  = shift || "";
  688     my $old    = $self->{basic_authentication}{$netloc}{$realm};
  689     if (@_) {
  690         $self->{basic_authentication}{$netloc}{$realm} = [@_];
  691     }
  692     return unless $old;
  693     return @$old if wantarray;
  694     return join(":", @$old);
  695 }
  696 
  697 sub get_basic_credentials
  698 {
  699     my($self, $realm, $uri, $proxy) = @_;
  700     return if $proxy;
  701     return $self->credentials($uri->host_port, $realm);
  702 }
  703 
  704 
  705 sub timeout      { shift->_elem('timeout',      @_); }
  706 sub local_address{ shift->_elem('local_address',@_); }
  707 sub max_size     { shift->_elem('max_size',     @_); }
  708 sub max_redirect { shift->_elem('max_redirect', @_); }
  709 sub show_progress{ shift->_elem('show_progress', @_); }
  710 sub send_te      { shift->_elem('send_te',      @_); }
  711 
  712 sub ssl_opts {
  713     my $self = shift;
  714     if (@_ == 1) {
  715     my $k = shift;
  716     return $self->{ssl_opts}{$k};
  717     }
  718     if (@_) {
  719     my $old;
  720     while (@_) {
  721         my($k, $v) = splice(@_, 0, 2);
  722         $old = $self->{ssl_opts}{$k} unless @_;
  723         if (defined $v) {
  724         $self->{ssl_opts}{$k} = $v;
  725         }
  726         else {
  727         delete $self->{ssl_opts}{$k};
  728         }
  729     }
  730     %{$self->{ssl_opts}} = (%{$self->{ssl_opts}}, @_);
  731     return $old;
  732     }
  733 
  734     return keys %{$self->{ssl_opts}};
  735 }
  736 
  737 sub parse_head {
  738     my $self = shift;
  739     if (@_) {
  740         my $flag = shift;
  741         my $parser;
  742         my $old = $self->set_my_handler("response_header", $flag ? sub {
  743                my($response, $ua) = @_;
  744                require HTML::HeadParser;
  745                $parser = HTML::HeadParser->new;
  746                $parser->xml_mode(1) if $response->content_is_xhtml;
  747                $parser->utf8_mode(1) if $] >= 5.008 && $HTML::Parser::VERSION >= 3.40;
  748 
  749                push(@{$response->{handlers}{response_data}}, {
  750            callback => sub {
  751                return unless $parser;
  752                unless ($parser->parse($_[3])) {
  753                my $h = $parser->header;
  754                my $r = $_[0];
  755                for my $f ($h->header_field_names) {
  756                    $r->init_header($f, [$h->header($f)]);
  757                }
  758                undef($parser);
  759                }
  760            },
  761            });
  762 
  763             } : undef,
  764             m_media_type => "html",
  765         );
  766         return !!$old;
  767     }
  768     else {
  769         return !!$self->get_my_handler("response_header");
  770     }
  771 }
  772 
  773 sub cookie_jar {
  774     my $self = shift;
  775     my $old = $self->{cookie_jar};
  776     if (@_) {
  777     my $jar = shift;
  778     if (ref($jar) eq "HASH") {
  779         require HTTP::Cookies;
  780         $jar = HTTP::Cookies->new(%$jar);
  781     }
  782     $self->{cookie_jar} = $jar;
  783         $self->set_my_handler("request_prepare",
  784             $jar ? sub { $jar->add_cookie_header($_[0]); } : undef,
  785         );
  786         $self->set_my_handler("response_done",
  787             $jar ? sub { $jar->extract_cookies($_[0]); } : undef,
  788         );
  789     }
  790     $old;
  791 }
  792 
  793 sub default_headers {
  794     my $self = shift;
  795     my $old = $self->{def_headers} ||= HTTP::Headers->new;
  796     if (@_) {
  797     Carp::croak("default_headers not set to HTTP::Headers compatible object")
  798         unless @_ == 1 && $_[0]->can("header_field_names");
  799     $self->{def_headers} = shift;
  800     }
  801     return $old;
  802 }
  803 
  804 sub default_header {
  805     my $self = shift;
  806     return $self->default_headers->header(@_);
  807 }
  808 
  809 sub _agent { "libwww-perl/$VERSION" }
  810 
  811 sub agent {
  812     my $self = shift;
  813     if (@_) {
  814     my $agent = shift;
  815         if ($agent) {
  816             $agent .= $self->_agent if $agent =~ /\s+$/;
  817         }
  818         else {
  819             undef($agent)
  820         }
  821         return $self->default_header("User-Agent", $agent);
  822     }
  823     return $self->default_header("User-Agent");
  824 }
  825 
  826 sub from {  # legacy
  827     my $self = shift;
  828     return $self->default_header("From", @_);
  829 }
  830 
  831 
  832 sub conn_cache {
  833     my $self = shift;
  834     my $old = $self->{conn_cache};
  835     if (@_) {
  836     my $cache = shift;
  837     if (ref($cache) eq "HASH") {
  838         require LWP::ConnCache;
  839         $cache = LWP::ConnCache->new(%$cache);
  840     }
  841     $self->{conn_cache} = $cache;
  842     }
  843     $old;
  844 }
  845 
  846 
  847 sub add_handler {
  848     my($self, $phase, $cb, %spec) = @_;
  849     $spec{line} ||= join(":", (caller)[1,2]);
  850     my $conf = $self->{handlers}{$phase} ||= do {
  851         require HTTP::Config;
  852         HTTP::Config->new;
  853     };
  854     $conf->add(%spec, callback => $cb);
  855 }
  856 
  857 sub set_my_handler {
  858     my($self, $phase, $cb, %spec) = @_;
  859     $spec{owner} = (caller(1))[3] unless exists $spec{owner};
  860     $self->remove_handler($phase, %spec);
  861     $spec{line} ||= join(":", (caller)[1,2]);
  862     $self->add_handler($phase, $cb, %spec) if $cb;
  863 }
  864 
  865 sub get_my_handler {
  866     my $self = shift;
  867     my $phase = shift;
  868     my $init = pop if @_ % 2;
  869     my %spec = @_;
  870     my $conf = $self->{handlers}{$phase};
  871     unless ($conf) {
  872         return unless $init;
  873         require HTTP::Config;
  874         $conf = $self->{handlers}{$phase} = HTTP::Config->new;
  875     }
  876     $spec{owner} = (caller(1))[3] unless exists $spec{owner};
  877     my @h = $conf->find(%spec);
  878     if (!@h && $init) {
  879         if (ref($init) eq "CODE") {
  880             $init->(\%spec);
  881         }
  882         elsif (ref($init) eq "HASH") {
  883             while (my($k, $v) = each %$init) {
  884                 $spec{$k} = $v;
  885             }
  886         }
  887         $spec{callback} ||= sub {};
  888         $spec{line} ||= join(":", (caller)[1,2]);
  889         $conf->add(\%spec);
  890         return \%spec;
  891     }
  892     return wantarray ? @h : $h[0];
  893 }
  894 
  895 sub remove_handler {
  896     my($self, $phase, %spec) = @_;
  897     if ($phase) {
  898         my $conf = $self->{handlers}{$phase} || return;
  899         my @h = $conf->remove(%spec);
  900         delete $self->{handlers}{$phase} if $conf->empty;
  901         return @h;
  902     }
  903 
  904     return unless $self->{handlers};
  905     return map $self->remove_handler($_), sort keys %{$self->{handlers}};
  906 }
  907 
  908 sub handlers {
  909     my($self, $phase, $o) = @_;
  910     my @h;
  911     if ($o->{handlers} && $o->{handlers}{$phase}) {
  912         push(@h, @{$o->{handlers}{$phase}});
  913     }
  914     if (my $conf = $self->{handlers}{$phase}) {
  915         push(@h, $conf->matching($o));
  916     }
  917     return @h;
  918 }
  919 
  920 sub run_handlers {
  921     my($self, $phase, $o) = @_;
  922 
  923     # here we pass $_[2] to the callbacks, instead of $o, so that they
  924     # can assign to it; e.g. request_prepare is documented to allow
  925     # that
  926     if (defined(wantarray)) {
  927         for my $h ($self->handlers($phase, $o)) {
  928             my $ret = $h->{callback}->($_[2], $self, $h);
  929             return $ret if $ret;
  930         }
  931         return undef;
  932     }
  933 
  934     for my $h ($self->handlers($phase, $o)) {
  935         $h->{callback}->($_[2], $self, $h);
  936     }
  937 }
  938 
  939 
  940 # deprecated
  941 sub use_eval   { shift->_elem('use_eval',  @_); }
  942 sub use_alarm
  943 {
  944     Carp::carp("LWP::UserAgent->use_alarm(BOOL) is a no-op")
  945     if @_ > 1 && $^W;
  946     "";
  947 }
  948 
  949 
  950 sub clone
  951 {
  952     my $self = shift;
  953     my $copy = bless { %$self }, ref $self;  # copy most fields
  954 
  955     delete $copy->{handlers};
  956     delete $copy->{conn_cache};
  957 
  958     # copy any plain arrays and hashes; known not to need recursive copy
  959     for my $k (qw(proxy no_proxy requests_redirectable ssl_opts)) {
  960         next unless $copy->{$k};
  961         if (ref($copy->{$k}) eq "ARRAY") {
  962             $copy->{$k} = [ @{$copy->{$k}} ];
  963         }
  964         elsif (ref($copy->{$k}) eq "HASH") {
  965             $copy->{$k} = { %{$copy->{$k}} };
  966         }
  967     }
  968 
  969     if ($self->{def_headers}) {
  970         $copy->{def_headers} = $self->{def_headers}->clone;
  971     }
  972 
  973     # re-enable standard handlers
  974     $copy->parse_head($self->parse_head);
  975 
  976     # no easy way to clone the cookie jar; so let's just remove it for now
  977     $copy->cookie_jar(undef);
  978 
  979     $copy;
  980 }
  981 
  982 
  983 sub mirror
  984 {
  985     my($self, $url, $file) = @_;
  986 
  987     die "Local file name is missing" unless defined $file && length $file;
  988 
  989     my $request = HTTP::Request->new('GET', $url);
  990 
  991     # If the file exists, add a cache-related header
  992     if ( -e $file ) {
  993         my ($mtime) = ( stat($file) )[9];
  994         if ($mtime) {
  995             $request->header( 'If-Modified-Since' => HTTP::Date::time2str($mtime) );
  996         }
  997     }
  998     my $tmpfile = "$file-$$";
  999 
 1000     my $response = $self->request($request, $tmpfile);
 1001     if ( $response->header('X-Died') ) {
 1002         die $response->header('X-Died');
 1003     }
 1004 
 1005     # Only fetching a fresh copy of the file would be considered success.
 1006     # If the file was not modified, "304" would returned, which
 1007     # is considered by HTTP::Status to be a "redirect", /not/ "success"
 1008     if ( $response->is_success ) {
 1009         my @stat        = stat($tmpfile) or die "Could not stat tmpfile '$tmpfile': $!";
 1010         my $file_length = $stat[7];
 1011         my ($content_length) = $response->header('Content-length');
 1012 
 1013         if ( defined $content_length and $file_length < $content_length ) {
 1014             unlink($tmpfile);
 1015             die "Transfer truncated: " . "only $file_length out of $content_length bytes received\n";
 1016         }
 1017         elsif ( defined $content_length and $file_length > $content_length ) {
 1018             unlink($tmpfile);
 1019             die "Content-length mismatch: " . "expected $content_length bytes, got $file_length\n";
 1020         }
 1021         # The file was the expected length.
 1022         else {
 1023             # Replace the stale file with a fresh copy
 1024             if ( -e $file ) {
 1025                 # Some DOSish systems fail to rename if the target exists
 1026                 chmod 0777, $file;
 1027                 unlink $file;
 1028             }
 1029             rename( $tmpfile, $file )
 1030                 or die "Cannot rename '$tmpfile' to '$file': $!\n";
 1031 
 1032             # make sure the file has the same last modification time
 1033             if ( my $lm = $response->last_modified ) {
 1034                 utime $lm, $lm, $file;
 1035             }
 1036         }
 1037     }
 1038     # The local copy is fresh enough, so just delete the temp file
 1039     else {
 1040         unlink($tmpfile);
 1041     }
 1042     return $response;
 1043 }
 1044 
 1045 
 1046 sub _need_proxy {
 1047     my($req, $ua) = @_;
 1048     return if exists $req->{proxy};
 1049     my $proxy = $ua->{proxy}{$req->uri->scheme} || return;
 1050     if ($ua->{no_proxy}) {
 1051         if (my $host = eval { $req->uri->host }) {
 1052             for my $domain (@{$ua->{no_proxy}}) {
 1053                 if ($host =~ /\Q$domain\E$/) {
 1054                     return;
 1055                 }
 1056             }
 1057         }
 1058     }
 1059     $req->{proxy} = $HTTP::URI_CLASS->new($proxy);
 1060 }
 1061 
 1062 
 1063 sub proxy {
 1064     my $self = shift;
 1065     my $key  = shift;
 1066     if (!@_ && ref $key eq 'ARRAY') {
 1067         die 'odd number of items in proxy arrayref!' unless @{$key} % 2 == 0;
 1068 
 1069         # This map reads the elements of $key 2 at a time
 1070         return
 1071             map { $self->proxy($key->[2 * $_], $key->[2 * $_ + 1]) }
 1072             (0 .. @{$key} / 2 - 1);
 1073     }
 1074     return map { $self->proxy($_, @_) } @$key if ref $key;
 1075 
 1076     Carp::croak("'$key' is not a valid URI scheme") unless $key =~ /^$URI::scheme_re\z/;
 1077     my $old = $self->{'proxy'}{$key};
 1078     if (@_) {
 1079         my $url = shift;
 1080         if (defined($url) && length($url)) {
 1081             Carp::croak("Proxy must be specified as absolute URI; '$url' is not") unless $url =~ /^$URI::scheme_re:/;
 1082             Carp::croak("Bad http proxy specification '$url'") if $url =~ /^https?:/ && $url !~ m,^https?://[\w[],;
 1083         }
 1084         $self->{proxy}{$key} = $url;
 1085         $self->set_my_handler("request_preprepare", \&_need_proxy)
 1086     }
 1087     return $old;
 1088 }
 1089 
 1090 
 1091 sub env_proxy {
 1092     my ($self) = @_;
 1093     require Encode;
 1094     require Encode::Locale;
 1095     my($k,$v);
 1096     while(($k, $v) = each %ENV) {
 1097     if ($ENV{REQUEST_METHOD}) {
 1098         # Need to be careful when called in the CGI environment, as
 1099         # the HTTP_PROXY variable is under control of that other guy.
 1100         next if $k =~ /^HTTP_/;
 1101         $k = "HTTP_PROXY" if $k eq "CGI_HTTP_PROXY";
 1102     }
 1103     $k = lc($k);
 1104     next unless $k =~ /^(.*)_proxy$/;
 1105     $k = $1;
 1106     if ($k eq 'no') {
 1107         $self->no_proxy(split(/\s*,\s*/, $v));
 1108     }
 1109     else {
 1110             # Ignore random _proxy variables, allow only valid schemes
 1111             next unless $k =~ /^$URI::scheme_re\z/;
 1112             # Ignore xxx_proxy variables if xxx isn't a supported protocol
 1113             next unless LWP::Protocol::implementor($k);
 1114         $self->proxy($k, Encode::decode(locale => $v));
 1115     }
 1116     }
 1117 }
 1118 
 1119 
 1120 sub no_proxy {
 1121     my($self, @no) = @_;
 1122     if (@no) {
 1123     push(@{ $self->{'no_proxy'} }, @no);
 1124     }
 1125     else {
 1126     $self->{'no_proxy'} = [];
 1127     }
 1128 }
 1129 
 1130 
 1131 sub _new_response {
 1132     my($request, $code, $message, $content) = @_;
 1133     $message ||= HTTP::Status::status_message($code);
 1134     my $response = HTTP::Response->new($code, $message);
 1135     $response->request($request);
 1136     $response->header("Client-Date" => HTTP::Date::time2str(time));
 1137     $response->header("Client-Warning" => "Internal response");
 1138     $response->header("Content-Type" => "text/plain");
 1139     $response->content($content || "$code $message\n");
 1140     return $response;
 1141 }
 1142 
 1143 
 1144 1;
 1145 
 1146 __END__
 1147 
 1148 =pod
 1149 
 1150 =head1 NAME
 1151 
 1152 LWP::UserAgent - Web user agent class
 1153 
 1154 =head1 SYNOPSIS
 1155 
 1156     use strict;
 1157     use warnings;
 1158 
 1159     use LWP::UserAgent ();
 1160 
 1161     my $ua = LWP::UserAgent->new(timeout => 10);
 1162     $ua->env_proxy;
 1163 
 1164     my $response = $ua->get('http://example.com');
 1165 
 1166     if ($response->is_success) {
 1167         print $response->decoded_content;
 1168     }
 1169     else {
 1170         die $response->status_line;
 1171     }
 1172 
 1173 Extra layers of security (note the C<cookie_jar> and C<protocols_allowed>):
 1174 
 1175     use strict;
 1176     use warnings;
 1177 
 1178     use HTTP::CookieJar::LWP ();
 1179     use LWP::UserAgent       ();
 1180 
 1181     my $jar = HTTP::CookieJar::LWP->new;
 1182     my $ua  = LWP::UserAgent->new(
 1183         cookie_jar        => $jar,
 1184         protocols_allowed => ['http', 'https'],
 1185         timeout           => 10,
 1186     );
 1187 
 1188     $ua->env_proxy;
 1189 
 1190     my $response = $ua->get('http://example.com');
 1191 
 1192     if ($response->is_success) {
 1193         print $response->decoded_content;
 1194     }
 1195     else {
 1196         die $response->status_line;
 1197     }
 1198 
 1199 =head1 DESCRIPTION
 1200 
 1201 The L<LWP::UserAgent> is a class implementing a web user agent.
 1202 L<LWP::UserAgent> objects can be used to dispatch web requests.
 1203 
 1204 In normal use the application creates an L<LWP::UserAgent> object, and
 1205 then configures it with values for timeouts, proxies, name, etc. It
 1206 then creates an instance of L<HTTP::Request> for the request that
 1207 needs to be performed. This request is then passed to one of the
 1208 request method the UserAgent, which dispatches it using the relevant
 1209 protocol, and returns a L<HTTP::Response> object.  There are
 1210 convenience methods for sending the most common request types:
 1211 L<LWP::UserAgent/get>, L<LWP::UserAgent/head>, L<LWP::UserAgent/post>,
 1212 L<LWP::UserAgent/put> and L<LWP::UserAgent/delete>.  When using these
 1213 methods, the creation of the request object is hidden as shown in the
 1214 synopsis above.
 1215 
 1216 The basic approach of the library is to use HTTP-style communication
 1217 for all protocol schemes.  This means that you will construct
 1218 L<HTTP::Request> objects and receive L<HTTP::Response> objects even
 1219 for non-HTTP resources like I<gopher> and I<ftp>.  In order to achieve
 1220 even more similarity to HTTP-style communications, I<gopher> menus and
 1221 file directories are converted to HTML documents.
 1222 
 1223 =head1 CONSTRUCTOR METHODS
 1224 
 1225 The following constructor methods are available:
 1226 
 1227 =head2 clone
 1228 
 1229     my $ua2 = $ua->clone;
 1230 
 1231 Returns a copy of the L<LWP::UserAgent> object.
 1232 
 1233 B<CAVEAT>: Please be aware that the clone method does not copy or clone your
 1234 C<cookie_jar> attribute. Due to the limited restrictions on what can be used
 1235 for your cookie jar, there is no way to clone the attribute. The C<cookie_jar>
 1236 attribute will be C<undef> in the new object instance.
 1237 
 1238 =head2 new
 1239 
 1240     my $ua = LWP::UserAgent->new( %options )
 1241 
 1242 This method constructs a new L<LWP::UserAgent> object and returns it.
 1243 Key/value pair arguments may be provided to set up the initial state.
 1244 The following options correspond to attribute methods described below:
 1245 
 1246    KEY                     DEFAULT
 1247    -----------             --------------------
 1248    agent                   "libwww-perl/#.###"
 1249    from                    undef
 1250    conn_cache              undef
 1251    cookie_jar              undef
 1252    default_headers         HTTP::Headers->new
 1253    local_address           undef
 1254    ssl_opts                { verify_hostname => 1 }
 1255    max_size                undef
 1256    max_redirect            7
 1257    parse_head              1
 1258    protocols_allowed       undef
 1259    protocols_forbidden     undef
 1260    requests_redirectable   ['GET', 'HEAD']
 1261    timeout                 180
 1262    proxy                   undef
 1263    no_proxy                []
 1264 
 1265 The following additional options are also accepted: If the C<env_proxy> option
 1266 is passed in with a true value, then proxy settings are read from environment
 1267 variables (see L<LWP::UserAgent/env_proxy>). If C<env_proxy> isn't provided, the
 1268 C<PERL_LWP_ENV_PROXY> environment variable controls if
 1269 L<LWP::UserAgent/env_proxy> is called during initialization.  If the
 1270 C<keep_alive> option value is defined and non-zero, then an C<LWP::ConnCache> is set up (see
 1271 L<LWP::UserAgent/conn_cache>).  The C<keep_alive> value is passed on as the
 1272 C<total_capacity> for the connection cache.
 1273 
 1274 C<proxy> must be set as an arrayref of key/value pairs. C<no_proxy> takes an
 1275 arrayref of domains.
 1276 
 1277 =head1 ATTRIBUTES
 1278 
 1279 The settings of the configuration attributes modify the behaviour of the
 1280 L<LWP::UserAgent> when it dispatches requests.  Most of these can also
 1281 be initialized by options passed to the constructor method.
 1282 
 1283 The following attribute methods are provided.  The attribute value is
 1284 left unchanged if no argument is given.  The return value from each
 1285 method is the old attribute value.
 1286 
 1287 =head2 agent
 1288 
 1289     my $agent = $ua->agent;
 1290     $ua->agent('Checkbot/0.4 ');    # append the default to the end
 1291     $ua->agent('Mozilla/5.0');
 1292     $ua->agent("");                 # don't identify
 1293 
 1294 Get/set the product token that is used to identify the user agent on
 1295 the network. The agent value is sent as the C<User-Agent> header in
 1296 the requests.
 1297 
 1298 The default is a string of the form C<libwww-perl/#.###>, where C<#.###> is
 1299 substituted with the version number of this library.
 1300 
 1301 If the provided string ends with space, the default C<libwww-perl/#.###>
 1302 string is appended to it.
 1303 
 1304 The user agent string should be one or more simple product identifiers
 1305 with an optional version number separated by the C</> character.
 1306 
 1307 =head2 conn_cache
 1308 
 1309     my $cache_obj = $ua->conn_cache;
 1310     $ua->conn_cache( $cache_obj );
 1311 
 1312 Get/set the L<LWP::ConnCache> object to use.  See L<LWP::ConnCache>
 1313 for details.
 1314 
 1315 =head2 cookie_jar
 1316 
 1317     my $jar = $ua->cookie_jar;
 1318     $ua->cookie_jar( $cookie_jar_obj );
 1319 
 1320 Get/set the cookie jar object to use.  The only requirement is that
 1321 the cookie jar object must implement the C<extract_cookies($response)> and
 1322 C<add_cookie_header($request)> methods.  These methods will then be
 1323 invoked by the user agent as requests are sent and responses are
 1324 received.  Normally this will be a L<HTTP::Cookies> object or some
 1325 subclass.  You are, however, encouraged to use L<HTTP::CookieJar::LWP>
 1326 instead.  See L</"BEST PRACTICES"> for more information.
 1327 
 1328     use HTTP::CookieJar::LWP ();
 1329 
 1330     my $jar = HTTP::CookieJar::LWP->new;
 1331     my $ua = LWP::UserAgent->new( cookie_jar => $jar );
 1332 
 1333     # or after object creation
 1334     $ua->cookie_jar( $cookie_jar );
 1335 
 1336 The default is to have no cookie jar, i.e. never automatically add
 1337 C<Cookie> headers to the requests.
 1338 
 1339 Shortcut: If a reference to a plain hash is passed in, it is replaced with an
 1340 instance of L<HTTP::Cookies> that is initialized based on the hash. This form
 1341 also automatically loads the L<HTTP::Cookies> module.  It means that:
 1342 
 1343   $ua->cookie_jar({ file => "$ENV{HOME}/.cookies.txt" });
 1344 
 1345 is really just a shortcut for:
 1346 
 1347   require HTTP::Cookies;
 1348   $ua->cookie_jar(HTTP::Cookies->new(file => "$ENV{HOME}/.cookies.txt"));
 1349 
 1350 =head2 credentials
 1351 
 1352     my $creds = $ua->credentials();
 1353     $ua->credentials( $netloc, $realm );
 1354     $ua->credentials( $netloc, $realm, $uname, $pass );
 1355     $ua->credentials("www.example.com:80", "Some Realm", "foo", "secret");
 1356 
 1357 Get/set the user name and password to be used for a realm.
 1358 
 1359 The C<$netloc> is a string of the form C<< <host>:<port> >>.  The username and
 1360 password will only be passed to this server.
 1361 
 1362 =head2 default_header
 1363 
 1364     $ua->default_header( $field );
 1365     $ua->default_header( $field => $value );
 1366     $ua->default_header('Accept-Encoding' => scalar HTTP::Message::decodable());
 1367     $ua->default_header('Accept-Language' => "no, en");
 1368 
 1369 This is just a shortcut for
 1370 C<< $ua->default_headers->header( $field => $value ) >>.
 1371 
 1372 =head2 default_headers
 1373 
 1374     my $headers = $ua->default_headers;
 1375     $ua->default_headers( $headers_obj );
 1376 
 1377 Get/set the headers object that will provide default header values for
 1378 any requests sent.  By default this will be an empty L<HTTP::Headers>
 1379 object.
 1380 
 1381 =head2 from
 1382 
 1383     my $from = $ua->from;
 1384     $ua->from('foo@bar.com');
 1385 
 1386 Get/set the email address for the human user who controls
 1387 the requesting user agent.  The address should be machine-usable, as
 1388 defined in L<RFC2822|https://tools.ietf.org/html/rfc2822>. The C<from> value
 1389 is sent as the C<From> header in the requests.
 1390 
 1391 The default is to not send a C<From> header.  See
 1392 L<LWP::UserAgent/default_headers> for the more general interface that allow
 1393 any header to be defaulted.
 1394 
 1395 
 1396 =head2 local_address
 1397 
 1398     my $address = $ua->local_address;
 1399     $ua->local_address( $address );
 1400 
 1401 Get/set the local interface to bind to for network connections.  The interface
 1402 can be specified as a hostname or an IP address.  This value is passed as the
 1403 C<LocalAddr> argument to L<IO::Socket::INET>.
 1404 
 1405 =head2 max_redirect
 1406 
 1407     my $max = $ua->max_redirect;
 1408     $ua->max_redirect( $n );
 1409 
 1410 This reads or sets the object's limit of how many times it will obey
 1411 redirection responses in a given request cycle.
 1412 
 1413 By default, the value is C<7>. This means that if you call L<LWP::UserAgent/request>
 1414 and the response is a redirect elsewhere which is in turn a
 1415 redirect, and so on seven times, then LWP gives up after that seventh
 1416 request.
 1417 
 1418 =head2 max_size
 1419 
 1420     my $size = $ua->max_size;
 1421     $ua->max_size( $bytes );
 1422 
 1423 Get/set the size limit for response content.  The default is C<undef>,
 1424 which means that there is no limit.  If the returned response content
 1425 is only partial, because the size limit was exceeded, then a
 1426 C<Client-Aborted> header will be added to the response.  The content
 1427 might end up longer than C<max_size> as we abort once appending a
 1428 chunk of data makes the length exceed the limit.  The C<Content-Length>
 1429 header, if present, will indicate the length of the full content and
 1430 will normally not be the same as C<< length($res->content) >>.
 1431 
 1432 =head2 parse_head
 1433 
 1434     my $bool = $ua->parse_head;
 1435     $ua->parse_head( $boolean );
 1436 
 1437 Get/set a value indicating whether we should initialize response
 1438 headers from the E<lt>head> section of HTML documents. The default is
 1439 true. I<Do not turn this off> unless you know what you are doing.
 1440 
 1441 =head2 protocols_allowed
 1442 
 1443     my $aref = $ua->protocols_allowed;      # get allowed protocols
 1444     $ua->protocols_allowed( \@protocols );  # allow ONLY these
 1445     $ua->protocols_allowed(undef);          # delete the list
 1446     $ua->protocols_allowed(['http',]);      # ONLY allow http
 1447 
 1448 By default, an object has neither a C<protocols_allowed> list, nor a
 1449 L<LWP::UserAgent/protocols_forbidden> list.
 1450 
 1451 This reads (or sets) this user agent's list of protocols that the
 1452 request methods will exclusively allow.  The protocol names are case
 1453 insensitive.
 1454 
 1455 For example: C<< $ua->protocols_allowed( [ 'http', 'https'] ); >>
 1456 means that this user agent will I<allow only> those protocols,
 1457 and attempts to use this user agent to access URLs with any other
 1458 schemes (like C<ftp://...>) will result in a 500 error.
 1459 
 1460 Note that having a C<protocols_allowed> list causes any
 1461 L<LWP::UserAgent/protocols_forbidden> list to be ignored.
 1462 
 1463 =head2 protocols_forbidden
 1464 
 1465     my $aref = $ua->protocols_forbidden;    # get the forbidden list
 1466     $ua->protocols_forbidden(\@protocols);  # do not allow these
 1467     $ua->protocols_forbidden(['http',]);    # All http reqs get a 500
 1468     $ua->protocols_forbidden(undef);        # delete the list
 1469 
 1470 This reads (or sets) this user agent's list of protocols that the
 1471 request method will I<not> allow. The protocol names are case
 1472 insensitive.
 1473 
 1474 For example: C<< $ua->protocols_forbidden( [ 'file', 'mailto'] ); >>
 1475 means that this user agent will I<not> allow those protocols, and
 1476 attempts to use this user agent to access URLs with those schemes
 1477 will result in a 500 error.
 1478 
 1479 =head2 requests_redirectable
 1480 
 1481     my $aref = $ua->requests_redirectable;
 1482     $ua->requests_redirectable( \@requests );
 1483     $ua->requests_redirectable(['GET', 'HEAD',]); # the default
 1484 
 1485 This reads or sets the object's list of request names that
 1486 L<LWP::UserAgent/redirect_ok> will allow redirection for. By default, this
 1487 is C<['GET', 'HEAD']>, as per L<RFC 2616|https://tools.ietf.org/html/rfc2616>.
 1488 To change to include C<POST>, consider:
 1489 
 1490    push @{ $ua->requests_redirectable }, 'POST';
 1491 
 1492 =head2 send_te
 1493 
 1494     my $bool = $ua->send_te;
 1495     $ua->send_te( $boolean );
 1496 
 1497 If true, will send a C<TE> header along with the request. The default is
 1498 true. Set it to false to disable the C<TE> header for systems who can't
 1499 handle it.
 1500 
 1501 =head2 show_progress
 1502 
 1503     my $bool = $ua->show_progress;
 1504     $ua->show_progress( $boolean );
 1505 
 1506 Get/set a value indicating whether a progress bar should be displayed
 1507 on the terminal as requests are processed. The default is false.
 1508 
 1509 =head2 ssl_opts
 1510 
 1511     my @keys = $ua->ssl_opts;
 1512     my $val = $ua->ssl_opts( $key );
 1513     $ua->ssl_opts( $key => $value );
 1514 
 1515 Get/set the options for SSL connections.  Without argument return the list
 1516 of options keys currently set.  With a single argument return the current
 1517 value for the given option.  With 2 arguments set the option value and return
 1518 the old.  Setting an option to the value C<undef> removes this option.
 1519 
 1520 The options that LWP relates to are:
 1521 
 1522 =over
 1523 
 1524 =item C<verify_hostname> => $bool
 1525 
 1526 When TRUE LWP will for secure protocol schemes ensure it connects to servers
 1527 that have a valid certificate matching the expected hostname.  If FALSE no
 1528 checks are made and you can't be sure that you communicate with the expected peer.
 1529 The no checks behaviour was the default for libwww-perl-5.837 and earlier releases.
 1530 
 1531 This option is initialized from the C<PERL_LWP_SSL_VERIFY_HOSTNAME> environment
 1532 variable.  If this environment variable isn't set; then C<verify_hostname>
 1533 defaults to 1.
 1534 
 1535 =item C<SSL_ca_file> => $path
 1536 
 1537 The path to a file containing Certificate Authority certificates.
 1538 A default setting for this option is provided by checking the environment
 1539 variables C<PERL_LWP_SSL_CA_FILE> and C<HTTPS_CA_FILE> in order.
 1540 
 1541 =item C<SSL_ca_path> => $path
 1542 
 1543 The path to a directory containing files containing Certificate Authority
 1544 certificates.
 1545 A default setting for this option is provided by checking the environment
 1546 variables C<PERL_LWP_SSL_CA_PATH> and C<HTTPS_CA_DIR> in order.
 1547 
 1548 =back
 1549 
 1550 Other options can be set and are processed directly by the SSL Socket implementation
 1551 in use.  See L<IO::Socket::SSL> or L<Net::SSL> for details.
 1552 
 1553 The libwww-perl core no longer bundles protocol plugins for SSL.  You will need
 1554 to install L<LWP::Protocol::https> separately to enable support for processing
 1555 https-URLs.
 1556 
 1557 =head2 timeout
 1558 
 1559     my $secs = $ua->timeout;
 1560     $ua->timeout( $secs );
 1561 
 1562 Get/set the timeout value in seconds. The default value is
 1563 180 seconds, i.e. 3 minutes.
 1564 
 1565 The request is aborted if no activity on the connection to the server
 1566 is observed for C<timeout> seconds.  This means that the time it takes
 1567 for the complete transaction and the L<LWP::UserAgent/request> method to
 1568 actually return might be longer.
 1569 
 1570 When a request times out, a response object is still returned.  The response
 1571 will have a standard HTTP Status Code (500).  This response will have the
 1572 "Client-Warning" header set to the value of "Internal response".  See the
 1573 L<LWP::UserAgent/get> method description below for further details.
 1574 
 1575 =head1 PROXY ATTRIBUTES
 1576 
 1577 The following methods set up when requests should be passed via a
 1578 proxy server.
 1579 
 1580 =head2 env_proxy
 1581 
 1582     $ua->env_proxy;
 1583 
 1584 Load proxy settings from C<*_proxy> environment variables.  You might
 1585 specify proxies like this (sh-syntax):
 1586 
 1587   gopher_proxy=http://proxy.my.place/
 1588   wais_proxy=http://proxy.my.place/
 1589   no_proxy="localhost,example.com"
 1590   export gopher_proxy wais_proxy no_proxy
 1591 
 1592 csh or tcsh users should use the C<setenv> command to define these
 1593 environment variables.
 1594 
 1595 On systems with case insensitive environment variables there exists a
 1596 name clash between the CGI environment variables and the C<HTTP_PROXY>
 1597 environment variable normally picked up by C<env_proxy>.  Because of
 1598 this C<HTTP_PROXY> is not honored for CGI scripts.  The
 1599 C<CGI_HTTP_PROXY> environment variable can be used instead.
 1600 
 1601 =head2 no_proxy
 1602 
 1603     $ua->no_proxy( @domains );
 1604     $ua->no_proxy('localhost', 'example.com');
 1605     $ua->no_proxy(); # clear the list
 1606 
 1607 Do not proxy requests to the given domains.  Calling C<no_proxy> without
 1608 any domains clears the list of domains.
 1609 
 1610 =head2 proxy
 1611 
 1612     $ua->proxy(\@schemes, $proxy_url)
 1613     $ua->proxy(['http', 'ftp'], 'http://proxy.sn.no:8001/');
 1614 
 1615     # For a single scheme:
 1616     $ua->proxy($scheme, $proxy_url)
 1617     $ua->proxy('gopher', 'http://proxy.sn.no:8001/');
 1618 
 1619     # To set multiple proxies at once:
 1620     $ua->proxy([
 1621         ftp => 'http://ftp.example.com:8001/',
 1622         [ 'http', 'https' ] => 'http://http.example.com:8001/',
 1623     ]);
 1624 
 1625 Set/retrieve proxy URL for a scheme.
 1626 
 1627 The first form specifies that the URL is to be used as a proxy for
 1628 access methods listed in the list in the first method argument,
 1629 i.e. C<http> and C<ftp>.
 1630 
 1631 The second form shows a shorthand form for specifying
 1632 proxy URL for a single access scheme.
 1633 
 1634 The third form demonstrates setting multiple proxies at once. This is also
 1635 the only form accepted by the constructor.
 1636 
 1637 =head1 HANDLERS
 1638 
 1639 Handlers are code that injected at various phases during the
 1640 processing of requests.  The following methods are provided to manage
 1641 the active handlers:
 1642 
 1643 =head2 add_handler
 1644 
 1645     $ua->add_handler( $phase => \&cb, %matchspec )
 1646 
 1647 Add handler to be invoked in the given processing phase.  For how to
 1648 specify C<%matchspec> see L<HTTP::Config/"Matching">.
 1649 
 1650 The possible values C<$phase> and the corresponding callback signatures are as
 1651 follows.  Note that the handlers are documented in the order in which they will
 1652 be run, which is:
 1653 
 1654     request_preprepare
 1655     request_prepare
 1656     request_send
 1657     response_header
 1658     response_data
 1659     response_done
 1660     response_redirect
 1661 
 1662 =over
 1663 
 1664 =item request_preprepare => sub { my($request, $ua, $handler) = @_; ... }
 1665 
 1666 The handler is called before the C<request_prepare> and other standard
 1667 initialization of the request.  This can be used to set up headers
 1668 and attributes that the C<request_prepare> handler depends on.  Proxy
 1669 initialization should take place here; but in general don't register
 1670 handlers for this phase.
 1671 
 1672 =item request_prepare => sub { my($request, $ua, $handler) = @_; ... }
 1673 
 1674 The handler is called before the request is sent and can modify the
 1675 request any way it see fit.  This can for instance be used to add
 1676 certain headers to specific requests.
 1677 
 1678 The method can assign a new request object to C<$_[0]> to replace the
 1679 request that is sent fully.
 1680 
 1681 The return value from the callback is ignored.  If an exception is
 1682 raised it will abort the request and make the request method return a
 1683 "400 Bad request" response.
 1684 
 1685 =item request_send => sub { my($request, $ua, $handler) = @_; ... }
 1686 
 1687 This handler gets a chance of handling requests before they're sent to the
 1688 protocol handlers.  It should return an L<HTTP::Response> object if it
 1689 wishes to terminate the processing; otherwise it should return nothing.
 1690 
 1691 The C<response_header> and C<response_data> handlers will not be
 1692 invoked for this response, but the C<response_done> will be.
 1693 
 1694 =item response_header => sub { my($response, $ua, $handler) = @_; ... }
 1695 
 1696 This handler is called right after the response headers have been
 1697 received, but before any content data.  The handler might set up
 1698 handlers for data and might croak to abort the request.
 1699 
 1700 The handler might set the C<< $response->{default_add_content} >> value to
 1701 control if any received data should be added to the response object
 1702 directly.  This will initially be false if the C<< $ua->request() >> method
 1703 was called with a C<$content_file> or C<$content_cb argument>; otherwise true.
 1704 
 1705 =item response_data => sub { my($response, $ua, $handler, $data) = @_; ... }
 1706 
 1707 This handler is called for each chunk of data received for the
 1708 response.  The handler might croak to abort the request.
 1709 
 1710 This handler needs to return a TRUE value to be called again for
 1711 subsequent chunks for the same request.
 1712 
 1713 =item response_done => sub { my($response, $ua, $handler) = @_; ... }
 1714 
 1715 The handler is called after the response has been fully received, but
 1716 before any redirect handling is attempted.  The handler can be used to
 1717 extract information or modify the response.
 1718 
 1719 =item response_redirect => sub { my($response, $ua, $handler) = @_; ... }
 1720 
 1721 The handler is called in C<< $ua->request >> after C<response_done>.  If the
 1722 handler returns an L<HTTP::Request> object we'll start over with processing
 1723 this request instead.
 1724 
 1725 =back
 1726 
 1727 For all of these, C<$handler> is a code reference to the handler that
 1728 is currently being run.
 1729 
 1730 =head2 get_my_handler
 1731 
 1732     $ua->get_my_handler( $phase, %matchspec );
 1733     $ua->get_my_handler( $phase, %matchspec, $init );
 1734 
 1735 Will retrieve the matching handler as hash ref.
 1736 
 1737 If C<$init> is passed as a true value, create and add the
 1738 handler if it's not found.  If C<$init> is a subroutine reference, then
 1739 it's called with the created handler hash as argument.  This sub might
 1740 populate the hash with extra fields; especially the callback.  If
 1741 C<$init> is a hash reference, merge the hashes.
 1742 
 1743 =head2 handlers
 1744 
 1745     $ua->handlers( $phase, $request )
 1746     $ua->handlers( $phase, $response )
 1747 
 1748 Returns the handlers that apply to the given request or response at
 1749 the given processing phase.
 1750 
 1751 =head2 remove_handler
 1752 
 1753     $ua->remove_handler( undef, %matchspec );
 1754     $ua->remove_handler( $phase, %matchspec );
 1755     $ua->remove_handler(); # REMOVE ALL HANDLERS IN ALL PHASES
 1756 
 1757 Remove handlers that match the given C<%matchspec>.  If C<$phase> is not
 1758 provided, remove handlers from all phases.
 1759 
 1760 Be careful as calling this function with C<%matchspec> that is not
 1761 specific enough can remove handlers not owned by you.  It's probably
 1762 better to use the L<LWP::UserAgent/set_my_handler> method instead.
 1763 
 1764 The removed handlers are returned.
 1765 
 1766 =head2 set_my_handler
 1767 
 1768     $ua->set_my_handler( $phase, $cb, %matchspec );
 1769     $ua->set_my_handler($phase, undef); # remove handler for phase
 1770 
 1771 Set handlers private to the executing subroutine.  Works by defaulting
 1772 an C<owner> field to the C<%matchspec> that holds the name of the called
 1773 subroutine.  You might pass an explicit C<owner> to override this.
 1774 
 1775 If $cb is passed as C<undef>, remove the handler.
 1776 
 1777 =head1 REQUEST METHODS
 1778 
 1779 The methods described in this section are used to dispatch requests
 1780 via the user agent.  The following request methods are provided:
 1781 
 1782 =head2 delete
 1783 
 1784     my $res = $ua->delete( $url );
 1785     my $res = $ua->delete( $url, $field_name => $value, ... );
 1786 
 1787 This method will dispatch a C<DELETE> request on the given URL.  Additional
 1788 headers and content options are the same as for the L<LWP::UserAgent/get>
 1789 method.
 1790 
 1791 This method will use the DELETE() function from L<HTTP::Request::Common>
 1792 to build the request.  See L<HTTP::Request::Common> for a details on
 1793 how to pass form content and other advanced features.
 1794 
 1795 =head2 get
 1796 
 1797     my $res = $ua->get( $url );
 1798     my $res = $ua->get( $url , $field_name => $value, ... );
 1799 
 1800 This method will dispatch a C<GET> request on the given URL.  Further
 1801 arguments can be given to initialize the headers of the request. These
 1802 are given as separate name/value pairs.  The return value is a
 1803 response object.  See L<HTTP::Response> for a description of the
 1804 interface it provides.
 1805 
 1806 There will still be a response object returned when LWP can't connect to the
 1807 server specified in the URL or when other failures in protocol handlers occur.
 1808 These internal responses use the standard HTTP status codes, so the responses
 1809 can't be differentiated by testing the response status code alone.  Error
 1810 responses that LWP generates internally will have the "Client-Warning" header
 1811 set to the value "Internal response".  If you need to differentiate these
 1812 internal responses from responses that a remote server actually generates, you
 1813 need to test this header value.
 1814 
 1815 Fields names that start with ":" are special.  These will not
 1816 initialize headers of the request but will determine how the response
 1817 content is treated.  The following special field names are recognized:
 1818 
 1819     ':content_file'   => $filename
 1820     ':content_cb'     => \&callback
 1821     ':read_size_hint' => $bytes
 1822 
 1823 If a $filename is provided with the C<:content_file> option, then the
 1824 response content will be saved here instead of in the response
 1825 object.  If a callback is provided with the C<:content_cb> option then
 1826 this function will be called for each chunk of the response content as
 1827 it is received from the server.  If neither of these options are
 1828 given, then the response content will accumulate in the response
 1829 object itself.  This might not be suitable for very large response
 1830 bodies.  Only one of C<:content_file> or C<:content_cb> can be
 1831 specified.  The content of unsuccessful responses will always
 1832 accumulate in the response object itself, regardless of the
 1833 C<:content_file> or C<:content_cb> options passed in.  Note that errors
 1834 writing to the content file (for example due to permission denied
 1835 or the filesystem being full) will be reported via the C<Client-Aborted>
 1836 or C<X-Died> response headers, and not the C<is_success> method.
 1837 
 1838 The C<:read_size_hint> option is passed to the protocol module which
 1839 will try to read data from the server in chunks of this size.  A
 1840 smaller value for the C<:read_size_hint> will result in a higher
 1841 number of callback invocations.
 1842 
 1843 The callback function is called with 3 arguments: a chunk of data, a
 1844 reference to the response object, and a reference to the protocol
 1845 object.  The callback can abort the request by invoking die().  The
 1846 exception message will show up as the "X-Died" header field in the
 1847 response returned by the get() function.
 1848 
 1849 =head2 head
 1850 
 1851     my $res = $ua->head( $url );
 1852     my $res = $ua->head( $url , $field_name => $value, ... );
 1853 
 1854 This method will dispatch a C<HEAD> request on the given URL.
 1855 Otherwise it works like the L<LWP::UserAgent/get> method described above.
 1856 
 1857 =head2 is_protocol_supported
 1858 
 1859     my $bool = $ua->is_protocol_supported( $scheme );
 1860 
 1861 You can use this method to test whether this user agent object supports the
 1862 specified C<scheme>.  (The C<scheme> might be a string (like C<http> or
 1863 C<ftp>) or it might be an L<URI> object reference.)
 1864 
 1865 Whether a scheme is supported is determined by the user agent's
 1866 C<protocols_allowed> or C<protocols_forbidden> lists (if any), and by
 1867 the capabilities of LWP.  I.e., this will return true only if LWP
 1868 supports this protocol I<and> it's permitted for this particular
 1869 object.
 1870 
 1871 =head2 is_online
 1872 
 1873     my $bool = $ua->is_online;
 1874 
 1875 Tries to determine if you have access to the Internet. Returns C<1> (true)
 1876 if the built-in heuristics determine that the user agent is
 1877 able to access the Internet (over HTTP) or C<0> (false).
 1878 
 1879 See also L<LWP::Online>.
 1880 
 1881 =head2 mirror
 1882 
 1883     my $res = $ua->mirror( $url, $filename );
 1884 
 1885 This method will get the document identified by URL and store it in
 1886 file called C<$filename>.  If the file already exists, then the request
 1887 will contain an C<If-Modified-Since> header matching the modification
 1888 time of the file.  If the document on the server has not changed since
 1889 this time, then nothing happens.  If the document has been updated, it
 1890 will be downloaded again.  The modification time of the file will be
 1891 forced to match that of the server.
 1892 
 1893 The return value is an L<HTTP::Response> object.
 1894 
 1895 =head2 patch
 1896     # Any version of HTTP::Message works with this form:
 1897     my $res = $ua->patch( $url, $field_name => $value, Content => $content );
 1898 
 1899     # Using hash or array references requires HTTP::Message >= 6.12
 1900     use HTTP::Request 6.12;
 1901     my $res = $ua->patch( $url, \%form );
 1902     my $res = $ua->patch( $url, \@form );
 1903     my $res = $ua->patch( $url, \%form, $field_name => $value, ... );
 1904     my $res = $ua->patch( $url, $field_name => $value, Content => \%form );
 1905     my $res = $ua->patch( $url, $field_name => $value, Content => \@form );
 1906 
 1907 This method will dispatch a C<PATCH> request on the given URL, with
 1908 C<%form> or C<@form> providing the key/value pairs for the fill-in form
 1909 content. Additional headers and content options are the same as for
 1910 the L<LWP::UserAgent/get> method.
 1911 
 1912 CAVEAT:
 1913 
 1914 This method can only accept content that is in key-value pairs when using
 1915 L<HTTP::Request::Common> prior to version C<6.12>. Any use of hash or array
 1916 references will result in an error prior to version C<6.12>.
 1917 
 1918 This method will use the C<PATCH> function from L<HTTP::Request::Common>
 1919 to build the request.  See L<HTTP::Request::Common> for a details on
 1920 how to pass form content and other advanced features.
 1921 
 1922 =head2 post
 1923 
 1924     my $res = $ua->post( $url, \%form );
 1925     my $res = $ua->post( $url, \@form );
 1926     my $res = $ua->post( $url, \%form, $field_name => $value, ... );
 1927     my $res = $ua->post( $url, $field_name => $value, Content => \%form );
 1928     my $res = $ua->post( $url, $field_name => $value, Content => \@form );
 1929     my $res = $ua->post( $url, $field_name => $value, Content => $content );
 1930 
 1931 This method will dispatch a C<POST> request on the given URL, with
 1932 C<%form> or C<@form> providing the key/value pairs for the fill-in form
 1933 content. Additional headers and content options are the same as for
 1934 the L<LWP::UserAgent/get> method.
 1935 
 1936 This method will use the C<POST> function from L<HTTP::Request::Common>
 1937 to build the request.  See L<HTTP::Request::Common> for a details on
 1938 how to pass form content and other advanced features.
 1939 
 1940 =head2 put
 1941 
 1942     # Any version of HTTP::Message works with this form:
 1943     my $res = $ua->put( $url, $field_name => $value, Content => $content );
 1944 
 1945     # Using hash or array references requires HTTP::Message >= 6.07
 1946     use HTTP::Request 6.07;
 1947     my $res = $ua->put( $url, \%form );
 1948     my $res = $ua->put( $url, \@form );
 1949     my $res = $ua->put( $url, \%form, $field_name => $value, ... );
 1950     my $res = $ua->put( $url, $field_name => $value, Content => \%form );
 1951     my $res = $ua->put( $url, $field_name => $value, Content => \@form );
 1952 
 1953 This method will dispatch a C<PUT> request on the given URL, with
 1954 C<%form> or C<@form> providing the key/value pairs for the fill-in form
 1955 content. Additional headers and content options are the same as for
 1956 the L<LWP::UserAgent/get> method.
 1957 
 1958 CAVEAT:
 1959 
 1960 This method can only accept content that is in key-value pairs when using
 1961 L<HTTP::Request::Common> prior to version C<6.07>. Any use of hash or array
 1962 references will result in an error prior to version C<6.07>.
 1963 
 1964 This method will use the C<PUT> function from L<HTTP::Request::Common>
 1965 to build the request.  See L<HTTP::Request::Common> for a details on
 1966 how to pass form content and other advanced features.
 1967 
 1968 =head2 request
 1969 
 1970     my $res = $ua->request( $request );
 1971     my $res = $ua->request( $request, $content_file );
 1972     my $res = $ua->request( $request, $content_cb );
 1973     my $res = $ua->request( $request, $content_cb, $read_size_hint );
 1974 
 1975 This method will dispatch the given C<$request> object. Normally this
 1976 will be an instance of the L<HTTP::Request> class, but any object with
 1977 a similar interface will do. The return value is an L<HTTP::Response> object.
 1978 
 1979 The C<request> method will process redirects and authentication
 1980 responses transparently. This means that it may actually send several
 1981 simple requests via the L<LWP::UserAgent/simple_request> method described below.
 1982 
 1983 The request methods described above; L<LWP::UserAgent/get>, L<LWP::UserAgent/head>,
 1984 L<LWP::UserAgent/post> and L<LWP::UserAgent/mirror> will all dispatch the request
 1985 they build via this method. They are convenience methods that simply hide the
 1986 creation of the request object for you.
 1987 
 1988 The C<$content_file>, C<$content_cb> and C<$read_size_hint> all correspond to
 1989 options described with the L<LWP::UserAgent/get> method above. Note that errors
 1990 writing to the content file (for example due to permission denied
 1991 or the filesystem being full) will be reported via the C<Client-Aborted>
 1992 or C<X-Died> response headers, and not the C<is_success> method.
 1993 
 1994 You are allowed to use a CODE reference as C<content> in the request
 1995 object passed in.  The C<content> function should return the content
 1996 when called.  The content can be returned in chunks.  The content
 1997 function will be invoked repeatedly until it return an empty string to
 1998 signal that there is no more content.
 1999 
 2000 =head2 simple_request
 2001 
 2002     my $request = HTTP::Request->new( ... );
 2003     my $res = $ua->simple_request( $request );
 2004     my $res = $ua->simple_request( $request, $content_file );
 2005     my $res = $ua->simple_request( $request, $content_cb );
 2006     my $res = $ua->simple_request( $request, $content_cb, $read_size_hint );
 2007 
 2008 This method dispatches a single request and returns the response
 2009 received.  Arguments are the same as for the L<LWP::UserAgent/request> described above.
 2010 
 2011 The difference from L<LWP::UserAgent/request> is that C<simple_request> will not try to
 2012 handle redirects or authentication responses.  The L<LWP::UserAgent/request> method
 2013 will, in fact, invoke this method for each simple request it sends.
 2014 
 2015 =head1 CALLBACK METHODS
 2016 
 2017 The following methods will be invoked as requests are processed. These
 2018 methods are documented here because subclasses of L<LWP::UserAgent>
 2019 might want to override their behaviour.
 2020 
 2021 =head2 get_basic_credentials
 2022 
 2023     # This checks wantarray and can either return an array:
 2024     my ($user, $pass) = $ua->get_basic_credentials( $realm, $uri, $isproxy );
 2025     # or a string that looks like "user:pass"
 2026     my $creds = $ua->get_basic_credentials($realm, $uri, $isproxy);
 2027 
 2028 This is called by L<LWP::UserAgent/request> to retrieve credentials for documents
 2029 protected by Basic or Digest Authentication.  The arguments passed in
 2030 is the C<$realm> provided by the server, the C<$uri> requested and a
 2031 C<boolean flag> to indicate if this is authentication against a proxy server.
 2032 
 2033 The method should return a username and password.  It should return an
 2034 empty list to abort the authentication resolution attempt.  Subclasses
 2035 can override this method to prompt the user for the information. An
 2036 example of this can be found in C<lwp-request> program distributed
 2037 with this library.
 2038 
 2039 The base implementation simply checks a set of pre-stored member
 2040 variables, set up with the L<LWP::UserAgent/credentials> method.
 2041 
 2042 =head2 prepare_request
 2043 
 2044     $request = $ua->prepare_request( $request );
 2045 
 2046 This method is invoked by L<LWP::UserAgent/simple_request>. Its task is
 2047 to modify the given C<$request> object by setting up various headers based
 2048 on the attributes of the user agent. The return value should normally be the
 2049 C<$request> object passed in.  If a different request object is returned
 2050 it will be the one actually processed.
 2051 
 2052 The headers affected by the base implementation are; C<User-Agent>,
 2053 C<From>, C<Range> and C<Cookie>.
 2054 
 2055 =head2 progress
 2056 
 2057     my $prog = $ua->progress( $status, $request_or_response );
 2058 
 2059 This is called frequently as the response is received regardless of
 2060 how the content is processed.  The method is called with C<$status>
 2061 "begin" at the start of processing the request and with C<$state> "end"
 2062 before the request method returns.  In between these C<$status> will be
 2063 the fraction of the response currently received or the string "tick"
 2064 if the fraction can't be calculated.
 2065 
 2066 When C<$status> is "begin" the second argument is the L<HTTP::Request> object,
 2067 otherwise it is the L<HTTP::Response> object.
 2068 
 2069 =head2 redirect_ok
 2070 
 2071     my $bool = $ua->redirect_ok( $prospective_request, $response );
 2072 
 2073 This method is called by L<LWP::UserAgent/request> before it tries to follow a
 2074 redirection to the request in C<$response>.  This should return a true
 2075 value if this redirection is permissible.  The C<$prospective_request>
 2076 will be the request to be sent if this method returns true.
 2077 
 2078 The base implementation will return false unless the method
 2079 is in the object's C<requests_redirectable> list,
 2080 false if the proposed redirection is to a C<file://...>
 2081 URL, and true otherwise.
 2082 
 2083 =head1 BEST PRACTICES
 2084 
 2085 The default settings can get you up and running quickly, but there are settings
 2086 you can change in order to make your life easier.
 2087 
 2088 =head2 Handling Cookies
 2089 
 2090 You are encouraged to install L<Mozilla::PublicSuffix> and use
 2091 L<HTTP::CookieJar::LWP> as your cookie jar.  L<HTTP::CookieJar::LWP> provides a
 2092 better security model matching that of current Web browsers when
 2093 L<Mozilla::PublicSuffix> is installed.
 2094 
 2095     use HTTP::CookieJar::LWP ();
 2096 
 2097     my $jar = HTTP::CookieJar::LWP->new;
 2098     my $ua = LWP::UserAgent->new( cookie_jar => $jar );
 2099 
 2100 See L</"cookie_jar"> for more information.
 2101 
 2102 =head2 Managing Protocols
 2103 
 2104 C<protocols_allowed> gives you the ability to whitelist the protocols you're
 2105 willing to allow.
 2106 
 2107     my $ua = LWP::UserAgent->new(
 2108         protocols_allowed => [ 'http', 'https' ]
 2109     );
 2110 
 2111 This will prevent you from inadvertently following URLs like
 2112 C<file:///etc/passwd>.  See L</"protocols_allowed">.
 2113 
 2114 C<protocols_forbidden> gives you the ability to blacklist the protocols you're
 2115 unwilling to allow.
 2116 
 2117     my $ua = LWP::UserAgent->new(
 2118         protocols_forbidden => [ 'file', 'mailto', 'ssh', ]
 2119     );
 2120 
 2121 This can also prevent you from inadvertently following URLs like
 2122 C<file:///etc/passwd>.  See L</protocols_forbidden>.
 2123 
 2124 =head1 SEE ALSO
 2125 
 2126 See L<LWP> for a complete overview of libwww-perl5.  See L<lwpcook>
 2127 and the scripts F<lwp-request> and F<lwp-download> for examples of
 2128 usage.
 2129 
 2130 See L<HTTP::Request> and L<HTTP::Response> for a description of the
 2131 message objects dispatched and received.  See L<HTTP::Request::Common>
 2132 and L<HTML::Form> for other ways to build request objects.
 2133 
 2134 See L<WWW::Mechanize> and L<WWW::Search> for examples of more
 2135 specialized user agents based on L<LWP::UserAgent>.
 2136 
 2137 =head1 COPYRIGHT AND LICENSE
 2138 
 2139 Copyright 1995-2009 Gisle Aas.
 2140 
 2141 This library is free software; you can redistribute it and/or
 2142 modify it under the same terms as Perl itself.
 2143 
 2144 =cut