… | |
… | |
121 | Whether to recurse requests or not, e.g. on redirects, authentication |
121 | Whether to recurse requests or not, e.g. on redirects, authentication |
122 | retries and so on, and how often to do so. |
122 | retries and so on, and how often to do so. |
123 | |
123 | |
124 | =item headers => hashref |
124 | =item headers => hashref |
125 | |
125 | |
126 | The request headers to use. |
126 | The request headers to use. Currently, C<http_request> may provide its |
|
|
127 | own C<Host:>, C<Content-Length:>, C<Connection:> and C<Cookie:> headers |
|
|
128 | and will provide defaults for C<User-Agent:> and C<Referer:>. |
127 | |
129 | |
128 | =item timeout => $seconds |
130 | =item timeout => $seconds |
129 | |
131 | |
130 | The time-out to use for various stages - each connect attempt will reset |
132 | The time-out to use for various stages - each connect attempt will reset |
131 | the timeout, as will read or write activity. Default timeout is 5 minutes. |
133 | the timeout, as will read or write activity. Default timeout is 5 minutes. |
… | |
… | |
181 | } |
183 | } |
182 | ; |
184 | ; |
183 | |
185 | |
184 | =cut |
186 | =cut |
185 | |
187 | |
|
|
188 | sub _slot_schedule; |
186 | sub _slot_schedule($) { |
189 | sub _slot_schedule($) { |
187 | my $host = shift; |
190 | my $host = shift; |
188 | |
191 | |
189 | while ($CO_SLOT{$host}[0] < $MAX_PER_HOST) { |
192 | while ($CO_SLOT{$host}[0] < $MAX_PER_HOST) { |
190 | if (my $cb = shift @{ $CO_SLOT{$host}[1] }) { |
193 | if (my $cb = shift @{ $CO_SLOT{$host}[1] }) { |
191 | # somebody wnats that slot |
194 | # somebody wants that slot |
192 | ++$CO_SLOT{$host}[0]; |
195 | ++$CO_SLOT{$host}[0]; |
193 | |
196 | |
194 | $cb->(AnyEvent::Util::guard { |
197 | $cb->(AnyEvent::Util::guard { |
195 | --$CO_SLOT{$host}[0]; |
198 | --$CO_SLOT{$host}[0]; |
196 | _slot_schedule $host; |
199 | _slot_schedule $host; |
197 | }); |
200 | }); |
198 | } else { |
201 | } else { |
199 | # nobody wants the slot, maybe we can forget about it |
202 | # nobody wants the slot, maybe we can forget about it |
200 | delete $CO_SLOT{$host} unless $CO_SLOT{$host}[0]; |
203 | delete $CO_SLOT{$host} unless $CO_SLOT{$host}[0]; |
201 | warn "$host deleted" unless $CO_SLOT{$host}[0];#d# |
|
|
202 | last; |
204 | last; |
203 | } |
205 | } |
204 | } |
206 | } |
205 | } |
207 | } |
206 | |
208 | |
… | |
… | |
241 | $scheme = lc $scheme; |
243 | $scheme = lc $scheme; |
242 | |
244 | |
243 | my $uport = $scheme eq "http" ? 80 |
245 | my $uport = $scheme eq "http" ? 80 |
244 | : $scheme eq "https" ? 443 |
246 | : $scheme eq "https" ? 443 |
245 | : return $cb->(undef, { Status => 599, Reason => "only http and https URL schemes supported" }); |
247 | : return $cb->(undef, { Status => 599, Reason => "only http and https URL schemes supported" }); |
|
|
248 | |
|
|
249 | $hdr{referer} ||= "$scheme://$authority$upath"; # leave out fragment and query string, just a heuristic |
246 | |
250 | |
247 | $authority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x |
251 | $authority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x |
248 | or return $cb->(undef, { Status => 599, Reason => "unparsable URL" }); |
252 | or return $cb->(undef, { Status => 599, Reason => "unparsable URL" }); |
249 | |
253 | |
250 | my $uhost = $1; |
254 | my $uhost = $1; |
… | |
… | |
396 | $arg{cookie_jar}{version} = 1; |
400 | $arg{cookie_jar}{version} = 1; |
397 | $arg{cookie_jar}{$cdom}{$cpath}{$name} = \%kv; |
401 | $arg{cookie_jar}{$cdom}{$cpath}{$name} = \%kv; |
398 | } |
402 | } |
399 | } |
403 | } |
400 | |
404 | |
401 | if ($_[1]{Status} =~ /^x30[12]$/ && $recurse) { |
405 | if ($_[1]{Status} =~ /^30[12]$/ && $recurse) { |
402 | # microsoft and other assholes don't give a shit for following standards, |
406 | # microsoft and other assholes don't give a shit for following standards, |
403 | # try to support a common form of broken Location header. |
407 | # try to support a common form of broken Location header. |
404 | $_[1]{location} =~ s%^/%$scheme://$uhost:$uport/%; |
408 | $_[1]{location} =~ s%^/%$scheme://$uhost:$uport/%; |
405 | |
409 | |
406 | http_request ($method, $_[1]{location}, %arg, recurse => $recurse - 1, $cb); |
410 | http_request ($method, $_[1]{location}, %arg, recurse => $recurse - 1, $cb); |