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.18 by root, Fri Jun 6 16:23:57 2008 UTC

… …
3AnyEvent::HTTP - simple but non-blocking HTTP/HTTPS client 3AnyEvent::HTTP - simple but non-blocking HTTP/HTTPS client
4 4
5=head1 SYNOPSIS 5=head1 SYNOPSIS
6 6
7 use AnyEvent::HTTP; 7 use AnyEvent::HTTP;
8
9 http_get "http://www.nethype.de/", sub { print $_[1] };
10
11 # ... do something else here
8 12
9=head1 DESCRIPTION 13=head1 DESCRIPTION
10 14
11This module is an L<AnyEvent> user, you need to make sure that you use and 15This module is an L<AnyEvent> user, you need to make sure that you use and
12run a supported event loop. 16run a supported event loop.
… …
44use AnyEvent::Socket (); 48use AnyEvent::Socket ();
45use AnyEvent::Handle (); 49use AnyEvent::Handle ();
46 50
47use base Exporter::; 51use base Exporter::;
48 52
49our $VERSION = '1.0'; 53our $VERSION = '1.01';
50 54
51our @EXPORT = qw(http_get http_request); 55our @EXPORT = qw(http_get http_post http_head http_request);
52 56
53our $USERAGENT = "Mozilla/5.0 (compatible; AnyEvent::HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)"; 57our $USERAGENT = "Mozilla/5.0 (compatible; AnyEvent::HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)";
54our $MAX_RECURSE = 10; 58our $MAX_RECURSE = 10;
55our $MAX_PERSISTENT = 8; 59our $MAX_PERSISTENT = 8;
56our $PERSISTENT_TIMEOUT = 2; 60our $PERSISTENT_TIMEOUT = 2;
… …
59# changing these is evil 63# changing these is evil
60our $MAX_PERSISTENT_PER_HOST = 2; 64our $MAX_PERSISTENT_PER_HOST = 2;
61our $MAX_PER_HOST = 4; 65our $MAX_PER_HOST = 4;
62 66
63our $PROXY; 67our $PROXY;
68our $ACTIVE = 0;
64 69
65my %KA_COUNT; # number of open keep-alive connections per host 70my %KA_COUNT; # number of open keep-alive connections per host
66my %CO_SLOT; # number of open connections, and wait queue, per host 71my %CO_SLOT; # number of open connections, and wait queue, per host
67 72
68=item http_get $url, key => value..., $cb->($data, $headers) 73=item http_get $url, key => value..., $cb->($data, $headers)
… …
191 196
192 while ($CO_SLOT{$host}[0] < $MAX_PER_HOST) { 197 while ($CO_SLOT{$host}[0] < $MAX_PER_HOST) {
193 if (my $cb = shift @{ $CO_SLOT{$host}[1] }) { 198 if (my $cb = shift @{ $CO_SLOT{$host}[1] }) {
194 # somebody wants that slot 199 # somebody wants that slot
195 ++$CO_SLOT{$host}[0]; 200 ++$CO_SLOT{$host}[0];
201 ++$ACTIVE;
196 202
197 $cb->(AnyEvent::Util::guard { 203 $cb->(AnyEvent::Util::guard {
204 --$ACTIVE;
198 --$CO_SLOT{$host}[0]; 205 --$CO_SLOT{$host}[0];
199 _slot_schedule $host; 206 _slot_schedule $host;
200 }); 207 });
201 } else { 208 } else {
202 # nobody wants the slot, maybe we can forget about it 209 # nobody wants the slot, maybe we can forget about it
… …
211 push @{ $CO_SLOT{$_[0]}[1] }, $_[1]; 218 push @{ $CO_SLOT{$_[0]}[1] }, $_[1];
212 219
213 _slot_schedule $_[0]; 220 _slot_schedule $_[0];
214} 221}
215 222
216sub http_request($$$;@) { 223sub http_request($$@) {
217 my $cb = pop; 224 my $cb = pop;
218 my ($method, $url, %arg) = @_; 225 my ($method, $url, %arg) = @_;
219 226
220 my %hdr; 227 my %hdr;
221 228
… …
244 251
245 my $uport = $scheme eq "http" ? 80 252 my $uport = $scheme eq "http" ? 80
246 : $scheme eq "https" ? 443 253 : $scheme eq "https" ? 443
247 : return $cb->(undef, { Status => 599, Reason => "only http and https URL schemes supported" }); 254 : return $cb->(undef, { Status => 599, Reason => "only http and https URL schemes supported" });
248 255
256 $hdr{referer} ||= "$scheme://$authority$upath"; # leave out fragment and query string, just a heuristic
257
249 $authority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x 258 $authority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x
250 or return $cb->(undef, { Status => 599, Reason => "unparsable URL" }); 259 or return $cb->(undef, { Status => 599, Reason => "unparsable URL" });
251 260
252 my $uhost = $1; 261 my $uhost = $1;
253 $uport = $2 if defined $2; 262 $uport = $2 if defined $2;
254 263
255 $uhost =~ s/^\[(.*)\]$/$1/; 264 $uhost =~ s/^\[(.*)\]$/$1/;
256 $upath .= "?$query" if length $query; 265 $upath .= "?$query" if length $query;
257 266
258 $upath =~ s%^/?%/%; 267 $upath =~ s%^/?%/%;
259
260 $hdr{referer} ||= "$scheme://$authority$upath";
261 268
262 # cookie processing 269 # cookie processing
263 if (my $jar = $arg{cookie_jar}) { 270 if (my $jar = $arg{cookie_jar}) {
264 %$jar = () if $jar->{version} < 1; 271 %$jar = () if $jar->{version} < 1;
265 272
… …
324 } 331 }
325 332
326 # (re-)configure handle 333 # (re-)configure handle
327 $state{handle}->timeout ($timeout); 334 $state{handle}->timeout ($timeout);
328 $state{handle}->on_error (sub { 335 $state{handle}->on_error (sub {
336 my $errno = "$!";
329 %state = (); 337 %state = ();
330 $cb->(undef, { Status => 599, Reason => "$!" }); 338 $cb->(undef, { Status => 599, Reason => $errno });
331 }); 339 });
332 $state{handle}->on_eof (sub { 340 $state{handle}->on_eof (sub {
333 %state = (); 341 %state = ();
334 $cb->(undef, { Status => 599, Reason => "unexpected end-of-file" }); 342 $cb->(undef, { Status => 599, Reason => "unexpected end-of-file" });
335 }); 343 });
… …
400 $arg{cookie_jar}{version} = 1; 408 $arg{cookie_jar}{version} = 1;
401 $arg{cookie_jar}{$cdom}{$cpath}{$name} = \%kv; 409 $arg{cookie_jar}{$cdom}{$cpath}{$name} = \%kv;
402 } 410 }
403 } 411 }
404 412
405 if ($_[1]{Status} =~ /^x30[12]$/ && $recurse) { 413 if ($_[1]{Status} =~ /^30[12]$/ && $recurse) {
406 # microsoft and other assholes don't give a shit for following standards, 414 # microsoft and other assholes don't give a shit for following standards,
407 # try to support a common form of broken Location header. 415 # try to support a common form of broken Location header.
408 $_[1]{location} =~ s%^/%$scheme://$uhost:$uport/%; 416 $_[1]{location} =~ s%^/%$scheme://$uhost:$uport/%;
409 417
410 http_request ($method, $_[1]{location}, %arg, recurse => $recurse - 1, $cb); 418 http_request ($method, $_[1]{location}, %arg, recurse => $recurse - 1, $cb);
… …
443 }; 451 };
444 452
445 defined wantarray && AnyEvent::Util::guard { %state = () } 453 defined wantarray && AnyEvent::Util::guard { %state = () }
446} 454}
447 455
448sub http_get($$;@) { 456sub http_get($@) {
449 unshift @_, "GET"; 457 unshift @_, "GET";
450 &http_request 458 &http_request
451} 459}
452 460
453sub http_head($$;@) { 461sub http_head($@) {
454 unshift @_, "HEAD"; 462 unshift @_, "HEAD";
455 &http_request 463 &http_request
456} 464}
457 465
458sub http_post($$$;@) { 466sub http_post($$@) {
459 unshift @_, "POST", "body"; 467 unshift @_, "POST", "body";
460 &http_request 468 &http_request
461} 469}
462 470
463=back 471=back
… …
490 498
491The maximum time to cache a persistent connection, in seconds (default: 2). 499The maximum time to cache a persistent connection, in seconds (default: 2).
492 500
493Not implemented currently. 501Not implemented currently.
494 502
503=item $AnyEvent::HTTP::ACTIVE
504
505The number of active connections. This is not the number of currently
506running requests, but the number of currently open and non-idle TCP
507connections. This number of can be useful for load-leveling.
508
495=back 509=back
496 510
497=cut 511=cut
498 512
499sub set_proxy($) { 513sub set_proxy($) {
… …
507 521
508L<AnyEvent>. 522L<AnyEvent>.
509 523
510=head1 AUTHOR 524=head1 AUTHOR
511 525
512 Marc Lehmann <schmorp@schmorp.de> 526 Marc Lehmann <schmorp@schmorp.de>
513 http://home.schmorp.de/ 527 http://home.schmorp.de/
514 528
515=cut 529=cut
516 530
5171 5311
518 532

Diff Legend

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