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.11 by root, Thu Jun 5 15:34:00 2008 UTC vs.
Revision 1.16 by root, Fri Jun 6 12:57:48 2008 UTC

… …
44use AnyEvent::Socket (); 44use AnyEvent::Socket ();
45use AnyEvent::Handle (); 45use AnyEvent::Handle ();
46 46
47use base Exporter::; 47use base Exporter::;
48 48
49our $VERSION = '1.0'; 49our $VERSION = '1.01';
50 50
51our @EXPORT = qw(http_get http_request); 51our @EXPORT = qw(http_get http_request);
52 52
53our $USERAGENT = "Mozilla/5.0 (compatible; AnyEvent::HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)"; 53our $USERAGENT = "Mozilla/5.0 (compatible; AnyEvent::HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)";
54our $MAX_RECURSE = 10; 54our $MAX_RECURSE = 10;
… …
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)
… …
121Whether to recurse requests or not, e.g. on redirects, authentication 122Whether to recurse requests or not, e.g. on redirects, authentication
122retries and so on, and how often to do so. 123retries and so on, and how often to do so.
123 124
124=item headers => hashref 125=item headers => hashref
125 126
126The request headers to use. 127The request headers to use. Currently, C<http_request> may provide its
128own C<Host:>, C<Content-Length:>, C<Connection:> and C<Cookie:> headers
129and will provide defaults for C<User-Agent:> and C<Referer:>.
127 130
128=item timeout => $seconds 131=item timeout => $seconds
129 132
130The time-out to use for various stages - each connect attempt will reset 133The time-out to use for various stages - each connect attempt will reset
131the timeout, as will read or write activity. Default timeout is 5 minutes. 134the timeout, as will read or write activity. Default timeout is 5 minutes.
… …
181 } 184 }
182 ; 185 ;
183 186
184=cut 187=cut
185 188
189sub _slot_schedule;
186sub _slot_schedule($) { 190sub _slot_schedule($) {
187 my $host = shift; 191 my $host = shift;
188 192
189 while ($CO_SLOT{$host}[0] < $MAX_PER_HOST) { 193 while ($CO_SLOT{$host}[0] < $MAX_PER_HOST) {
190 if (my $cb = shift @{ $CO_SLOT{$host}[1] }) { 194 if (my $cb = shift @{ $CO_SLOT{$host}[1] }) {
191 # somebody wnats that slot 195 # somebody wants that slot
192 ++$CO_SLOT{$host}[0]; 196 ++$CO_SLOT{$host}[0];
197 ++$ACTIVE;
193 198
194 $cb->(AnyEvent::Util::guard { 199 $cb->(AnyEvent::Util::guard {
200 --$ACTIVE;
195 --$CO_SLOT{$host}[0]; 201 --$CO_SLOT{$host}[0];
196 _slot_schedule $host; 202 _slot_schedule $host;
197 }); 203 });
198 } else { 204 } else {
199 # nobody wants the slot, maybe we can forget about it 205 # nobody wants the slot, maybe we can forget about it
200 delete $CO_SLOT{$host} unless $CO_SLOT{$host}[0]; 206 delete $CO_SLOT{$host} unless $CO_SLOT{$host}[0];
201 warn "$host deleted" unless $CO_SLOT{$host}[0];#d#
202 last; 207 last;
203 } 208 }
204 } 209 }
205} 210}
206 211
… …
209 push @{ $CO_SLOT{$_[0]}[1] }, $_[1]; 214 push @{ $CO_SLOT{$_[0]}[1] }, $_[1];
210 215
211 _slot_schedule $_[0]; 216 _slot_schedule $_[0];
212} 217}
213 218
214sub http_request($$$;@) { 219sub http_request($$@) {
215 my $cb = pop; 220 my $cb = pop;
216 my ($method, $url, %arg) = @_; 221 my ($method, $url, %arg) = @_;
217 222
218 my %hdr; 223 my %hdr;
219 224
… …
241 $scheme = lc $scheme; 246 $scheme = lc $scheme;
242 247
243 my $uport = $scheme eq "http" ? 80 248 my $uport = $scheme eq "http" ? 80
244 : $scheme eq "https" ? 443 249 : $scheme eq "https" ? 443
245 : 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" });
251
252 $hdr{referer} ||= "$scheme://$authority$upath"; # leave out fragment and query string, just a heuristic
246 253
247 $authority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x 254 $authority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x
248 or return $cb->(undef, { Status => 599, Reason => "unparsable URL" }); 255 or return $cb->(undef, { Status => 599, Reason => "unparsable URL" });
249 256
250 my $uhost = $1; 257 my $uhost = $1;
… …
320 } 327 }
321 328
322 # (re-)configure handle 329 # (re-)configure handle
323 $state{handle}->timeout ($timeout); 330 $state{handle}->timeout ($timeout);
324 $state{handle}->on_error (sub { 331 $state{handle}->on_error (sub {
332 my $errno = "$!";
325 %state = (); 333 %state = ();
326 $cb->(undef, { Status => 599, Reason => "$!" }); 334 $cb->(undef, { Status => 599, Reason => $errno });
327 }); 335 });
328 $state{handle}->on_eof (sub { 336 $state{handle}->on_eof (sub {
329 %state = (); 337 %state = ();
330 $cb->(undef, { Status => 599, Reason => "unexpected end-of-file" }); 338 $cb->(undef, { Status => 599, Reason => "unexpected end-of-file" });
331 }); 339 });
… …
396 $arg{cookie_jar}{version} = 1; 404 $arg{cookie_jar}{version} = 1;
397 $arg{cookie_jar}{$cdom}{$cpath}{$name} = \%kv; 405 $arg{cookie_jar}{$cdom}{$cpath}{$name} = \%kv;
398 } 406 }
399 } 407 }
400 408
401 if ($_[1]{Status} =~ /^x30[12]$/ && $recurse) { 409 if ($_[1]{Status} =~ /^30[12]$/ && $recurse) {
402 # 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,
403 # try to support a common form of broken Location header. 411 # try to support a common form of broken Location header.
404 $_[1]{location} =~ s%^/%$scheme://$uhost:$uport/%; 412 $_[1]{location} =~ s%^/%$scheme://$uhost:$uport/%;
405 413
406 http_request ($method, $_[1]{location}, %arg, recurse => $recurse - 1, $cb); 414 http_request ($method, $_[1]{location}, %arg, recurse => $recurse - 1, $cb);
… …
439 }; 447 };
440 448
441 defined wantarray && AnyEvent::Util::guard { %state = () } 449 defined wantarray && AnyEvent::Util::guard { %state = () }
442} 450}
443 451
444sub http_get($$;@) { 452sub http_get($@) {
445 unshift @_, "GET"; 453 unshift @_, "GET";
446 &http_request 454 &http_request
447} 455}
448 456
449sub http_head($$;@) { 457sub http_head($@) {
450 unshift @_, "HEAD"; 458 unshift @_, "HEAD";
451 &http_request 459 &http_request
452} 460}
453 461
454sub http_post($$$;@) { 462sub http_post($$@) {
455 unshift @_, "POST", "body"; 463 unshift @_, "POST", "body";
456 &http_request 464 &http_request
457} 465}
458 466
459=back 467=back
… …
486 494
487The maximum time to cache a persistent connection, in seconds (default: 2). 495The maximum time to cache a persistent connection, in seconds (default: 2).
488 496
489Not implemented currently. 497Not implemented currently.
490 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
491=back 505=back
492 506
493=cut 507=cut
494 508
495sub set_proxy($) { 509sub set_proxy($) {

Diff Legend

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