ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent-HTTP/HTTP.pm
(Generate patch)

Comparing AnyEvent-HTTP/HTTP.pm (file contents):
Revision 1.12 by root, Thu Jun 5 16:33:02 2008 UTC vs.
Revision 1.14 by root, Thu Jun 5 17:29:01 2008 UTC

… …
59# changing these is evil 59# changing these is evil
60our $MAX_PERSISTENT_PER_HOST = 2; 60our $MAX_PERSISTENT_PER_HOST = 2;
61our $MAX_PER_HOST = 4; 61our $MAX_PER_HOST = 4;
62 62
63our $PROXY; 63our $PROXY;
64our $ACTIVE = 0;
64 65
65my %KA_COUNT; # number of open keep-alive connections per host 66my %KA_COUNT; # number of open keep-alive connections per host
66my %CO_SLOT; # number of open connections, and wait queue, per host 67my %CO_SLOT; # number of open connections, and wait queue, per host
67 68
68=item http_get $url, key => value..., $cb->($data, $headers) 69=item http_get $url, key => value..., $cb->($data, $headers)
… …
191 192
192 while ($CO_SLOT{$host}[0] < $MAX_PER_HOST) { 193 while ($CO_SLOT{$host}[0] < $MAX_PER_HOST) {
193 if (my $cb = shift @{ $CO_SLOT{$host}[1] }) { 194 if (my $cb = shift @{ $CO_SLOT{$host}[1] }) {
194 # somebody wants that slot 195 # somebody wants that slot
195 ++$CO_SLOT{$host}[0]; 196 ++$CO_SLOT{$host}[0];
197 ++$ACTIVE;
196 198
197 $cb->(AnyEvent::Util::guard { 199 $cb->(AnyEvent::Util::guard {
200 --$ACTIVE;
198 --$CO_SLOT{$host}[0]; 201 --$CO_SLOT{$host}[0];
199 _slot_schedule $host; 202 _slot_schedule $host;
200 }); 203 });
201 } else { 204 } else {
202 # nobody wants the slot, maybe we can forget about it 205 # nobody wants the slot, maybe we can forget about it
… …
244 247
245 my $uport = $scheme eq "http" ? 80 248 my $uport = $scheme eq "http" ? 80
246 : $scheme eq "https" ? 443 249 : $scheme eq "https" ? 443
247 : return $cb->(undef, { Status => 599, Reason => "only http and https URL schemes supported" }); 250 : return $cb->(undef, { Status => 599, Reason => "only http and https URL schemes supported" });
248 251
252 $hdr{referer} ||= "$scheme://$authority$upath"; # leave out fragment and query string, just a heuristic
253
249 $authority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x 254 $authority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x
250 or return $cb->(undef, { Status => 599, Reason => "unparsable URL" }); 255 or return $cb->(undef, { Status => 599, Reason => "unparsable URL" });
251 256
252 my $uhost = $1; 257 my $uhost = $1;
253 $uport = $2 if defined $2; 258 $uport = $2 if defined $2;
254 259
255 $uhost =~ s/^\[(.*)\]$/$1/; 260 $uhost =~ s/^\[(.*)\]$/$1/;
256 $upath .= "?$query" if length $query; 261 $upath .= "?$query" if length $query;
257 262
258 $upath =~ s%^/?%/%; 263 $upath =~ s%^/?%/%;
259
260 $hdr{referer} ||= "$scheme://$authority$upath";
261 264
262 # cookie processing 265 # cookie processing
263 if (my $jar = $arg{cookie_jar}) { 266 if (my $jar = $arg{cookie_jar}) {
264 %$jar = () if $jar->{version} < 1; 267 %$jar = () if $jar->{version} < 1;
265 268
… …
324 } 327 }
325 328
326 # (re-)configure handle 329 # (re-)configure handle
327 $state{handle}->timeout ($timeout); 330 $state{handle}->timeout ($timeout);
328 $state{handle}->on_error (sub { 331 $state{handle}->on_error (sub {
332 my $errno = "$!";
329 %state = (); 333 %state = ();
330 $cb->(undef, { Status => 599, Reason => "$!" }); 334 $cb->(undef, { Status => 599, Reason => $errno });
331 }); 335 });
332 $state{handle}->on_eof (sub { 336 $state{handle}->on_eof (sub {
333 %state = (); 337 %state = ();
334 $cb->(undef, { Status => 599, Reason => "unexpected end-of-file" }); 338 $cb->(undef, { Status => 599, Reason => "unexpected end-of-file" });
335 }); 339 });
… …
400 $arg{cookie_jar}{version} = 1; 404 $arg{cookie_jar}{version} = 1;
401 $arg{cookie_jar}{$cdom}{$cpath}{$name} = \%kv; 405 $arg{cookie_jar}{$cdom}{$cpath}{$name} = \%kv;
402 } 406 }
403 } 407 }
404 408
405 if ($_[1]{Status} =~ /^x30[12]$/ && $recurse) { 409 if ($_[1]{Status} =~ /^30[12]$/ && $recurse) {
406 # microsoft and other assholes don't give a shit for following standards, 410 # microsoft and other assholes don't give a shit for following standards,
407 # try to support a common form of broken Location header. 411 # try to support a common form of broken Location header.
408 $_[1]{location} =~ s%^/%$scheme://$uhost:$uport/%; 412 $_[1]{location} =~ s%^/%$scheme://$uhost:$uport/%;
409 413
410 http_request ($method, $_[1]{location}, %arg, recurse => $recurse - 1, $cb); 414 http_request ($method, $_[1]{location}, %arg, recurse => $recurse - 1, $cb);
… …
490 494
491The maximum time to cache a persistent connection, in seconds (default: 2). 495The maximum time to cache a persistent connection, in seconds (default: 2).
492 496
493Not implemented currently. 497Not implemented currently.
494 498
499=item $AnyEvent::HTTP::ACTIVE
500
501The number of active connections. This is not the number of currently
502running requests, but the number of currently open and non-idle TCP
503connections. This number of can be useful for load-leveling.
504
495=back 505=back
496 506
497=cut 507=cut
498 508
499sub set_proxy($) { 509sub set_proxy($) {

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines