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.13 by root, Thu Jun 5 16:43:45 2008 UTC vs.
Revision 1.22 by root, Sat Jun 28 21:17:03 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.03';
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)
… …
88The callback will be called with the response data as first argument 93The callback will be called with the response data as first argument
89(or C<undef> if it wasn't available due to errors), and a hash-ref with 94(or C<undef> if it wasn't available due to errors), and a hash-ref with
90response headers as second argument. 95response headers as second argument.
91 96
92All the headers in that hash are lowercased. In addition to the response 97All the headers in that hash are lowercased. In addition to the response
93headers, the three "pseudo-headers" C<HTTPVersion>, C<Status> and 98headers, the "pseudo-headers" C<HTTPVersion>, C<Status> and C<Reason>
94C<Reason> contain the three parts of the HTTP Status-Line of the same 99contain the three parts of the HTTP Status-Line of the same name. The
100pseudo-header C<URL> contains the original URL (which can differ from the
101requested URL when following redirects).
102
95name. If the server sends a header multiple lines, then their contents 103If the server sends a header multiple lines, then their contents will be
96will be joined together with C<\x00>. 104joined together with C<\x00>.
97 105
98If an internal error occurs, such as not being able to resolve a hostname, 106If an internal error occurs, such as not being able to resolve a hostname,
99then C<$data> will be C<undef>, C<< $headers->{Status} >> will be C<599> 107then C<$data> will be C<undef>, C<< $headers->{Status} >> will be C<599>
100and the C<Reason> pseudo-header will contain an error message. 108and the C<Reason> pseudo-header will contain an error message.
101 109
… …
191 199
192 while ($CO_SLOT{$host}[0] < $MAX_PER_HOST) { 200 while ($CO_SLOT{$host}[0] < $MAX_PER_HOST) {
193 if (my $cb = shift @{ $CO_SLOT{$host}[1] }) { 201 if (my $cb = shift @{ $CO_SLOT{$host}[1] }) {
194 # somebody wants that slot 202 # somebody wants that slot
195 ++$CO_SLOT{$host}[0]; 203 ++$CO_SLOT{$host}[0];
204 ++$ACTIVE;
196 205
197 $cb->(AnyEvent::Util::guard { 206 $cb->(AnyEvent::Util::guard {
207 --$ACTIVE;
198 --$CO_SLOT{$host}[0]; 208 --$CO_SLOT{$host}[0];
199 _slot_schedule $host; 209 _slot_schedule $host;
200 }); 210 });
201 } else { 211 } else {
202 # nobody wants the slot, maybe we can forget about it 212 # nobody wants the slot, maybe we can forget about it
… …
211 push @{ $CO_SLOT{$_[0]}[1] }, $_[1]; 221 push @{ $CO_SLOT{$_[0]}[1] }, $_[1];
212 222
213 _slot_schedule $_[0]; 223 _slot_schedule $_[0];
214} 224}
215 225
216sub http_request($$$;@) { 226sub http_request($$@) {
217 my $cb = pop; 227 my $cb = pop;
218 my ($method, $url, %arg) = @_; 228 my ($method, $url, %arg) = @_;
219 229
220 my %hdr; 230 my %hdr;
221 231
… …
227 } 237 }
228 } 238 }
229 239
230 my $recurse = exists $arg{recurse} ? $arg{recurse} : $MAX_RECURSE; 240 my $recurse = exists $arg{recurse} ? $arg{recurse} : $MAX_RECURSE;
231 241
232 return $cb->(undef, { Status => 599, Reason => "recursion limit reached" }) 242 return $cb->(undef, { Status => 599, Reason => "recursion limit reached", URL => $url })
233 if $recurse < 0; 243 if $recurse < 0;
234 244
235 my $proxy = $arg{proxy} || $PROXY; 245 my $proxy = $arg{proxy} || $PROXY;
236 my $timeout = $arg{timeout} || $TIMEOUT; 246 my $timeout = $arg{timeout} || $TIMEOUT;
237 247
… …
242 252
243 $scheme = lc $scheme; 253 $scheme = lc $scheme;
244 254
245 my $uport = $scheme eq "http" ? 80 255 my $uport = $scheme eq "http" ? 80
246 : $scheme eq "https" ? 443 256 : $scheme eq "https" ? 443
247 : return $cb->(undef, { Status => 599, Reason => "only http and https URL schemes supported" }); 257 : return $cb->(undef, { Status => 599, Reason => "only http and https URL schemes supported", URL => $url });
248 258
249 $hdr{referer} ||= "$scheme://$authority$upath"; # leave out fragment and query string, just a heuristic 259 $hdr{referer} ||= "$scheme://$authority$upath"; # leave out fragment and query string, just a heuristic
250 260
251 $authority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x 261 $authority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x
252 or return $cb->(undef, { Status => 599, Reason => "unparsable URL" }); 262 or return $cb->(undef, { Status => 599, Reason => "unparsable URL", URL => $url });
253 263
254 my $uhost = $1; 264 my $uhost = $1;
255 $uport = $2 if defined $2; 265 $uport = $2 if defined $2;
256 266
257 $uhost =~ s/^\[(.*)\]$/$1/; 267 $uhost =~ s/^\[(.*)\]$/$1/;
… …
302 312
303 return unless $state{connect_guard}; 313 return unless $state{connect_guard};
304 314
305 $state{connect_guard} = AnyEvent::Socket::tcp_connect $rhost, $rport, sub { 315 $state{connect_guard} = AnyEvent::Socket::tcp_connect $rhost, $rport, sub {
306 $state{fh} = shift 316 $state{fh} = shift
307 or return $cb->(undef, { Status => 599, Reason => "$!" }); 317 or return $cb->(undef, { Status => 599, Reason => "$!", URL => $url });
308 318
309 delete $state{connect_guard}; # reduce memory usage, save a tree 319 delete $state{connect_guard}; # reduce memory usage, save a tree
310 320
311 # get handle 321 # get handle
312 $state{handle} = new AnyEvent::Handle 322 $state{handle} = new AnyEvent::Handle
… …
324 } 334 }
325 335
326 # (re-)configure handle 336 # (re-)configure handle
327 $state{handle}->timeout ($timeout); 337 $state{handle}->timeout ($timeout);
328 $state{handle}->on_error (sub { 338 $state{handle}->on_error (sub {
339 my $errno = "$!";
329 %state = (); 340 %state = ();
330 $cb->(undef, { Status => 599, Reason => "$!" }); 341 $cb->(undef, { Status => 599, Reason => $errno, URL => $url });
331 }); 342 });
332 $state{handle}->on_eof (sub { 343 $state{handle}->on_eof (sub {
333 %state = (); 344 %state = ();
334 $cb->(undef, { Status => 599, Reason => "unexpected end-of-file" }); 345 $cb->(undef, { Status => 599, Reason => "unexpected end-of-file", URL => $url });
335 }); 346 });
336 347
337 # send request 348 # send request
338 $state{handle}->push_write ( 349 $state{handle}->push_write (
339 "$method $rpath HTTP/1.0\015\012" 350 "$method $rpath HTTP/1.0\015\012"
… …
345 %hdr = (); # reduce memory usage, save a kitten 356 %hdr = (); # reduce memory usage, save a kitten
346 357
347 # status line 358 # status line
348 $state{handle}->push_read (line => qr/\015?\012/, sub { 359 $state{handle}->push_read (line => qr/\015?\012/, sub {
349 $_[1] =~ /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) \s+ ([^\015\012]+)/ix 360 $_[1] =~ /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) \s+ ([^\015\012]+)/ix
350 or return (%state = (), $cb->(undef, { Status => 599, Reason => "invalid server response ($_[1])" })); 361 or return (%state = (), $cb->(undef, { Status => 599, Reason => "invalid server response ($_[1])", URL => $url }));
351 362
352 my %hdr = ( # response headers 363 my %hdr = ( # response headers
353 HTTPVersion => "\x00$1", 364 HTTPVersion => "\x00$1",
354 Status => "\x00$2", 365 Status => "\x00$2",
355 Reason => "\x00$3", 366 Reason => "\x00$3",
367 URL => "\x00$url"
356 ); 368 );
357 369
358 # headers, could be optimized a bit 370 # headers, could be optimized a bit
359 $state{handle}->unshift_read (line => qr/\015?\012\015?\012/, sub { 371 $state{handle}->unshift_read (line => qr/\015?\012\015?\012/, sub {
360 for ("$_[1]\012") { 372 for ("$_[1]\012") {
… …
367 ((?: [^\015\012]+ | \015?\012[\011\040] )*) 379 ((?: [^\015\012]+ | \015?\012[\011\040] )*)
368 \015?\012 380 \015?\012
369 /gxc; 381 /gxc;
370 382
371 /\G$/ 383 /\G$/
372 or return (%state = (), $cb->(undef, { Status => 599, Reason => "garbled response headers" })); 384 or return (%state = (), $cb->(undef, { Status => 599, Reason => "garbled response headers", URL => $url }));
373 } 385 }
374 386
375 substr $_, 0, 1, "" 387 substr $_, 0, 1, ""
376 for values %hdr; 388 for values %hdr;
377 389
… …
443 }; 455 };
444 456
445 defined wantarray && AnyEvent::Util::guard { %state = () } 457 defined wantarray && AnyEvent::Util::guard { %state = () }
446} 458}
447 459
448sub http_get($$;@) { 460sub http_get($@) {
449 unshift @_, "GET"; 461 unshift @_, "GET";
450 &http_request 462 &http_request
451} 463}
452 464
453sub http_head($$;@) { 465sub http_head($@) {
454 unshift @_, "HEAD"; 466 unshift @_, "HEAD";
455 &http_request 467 &http_request
456} 468}
457 469
458sub http_post($$$;@) { 470sub http_post($$@) {
471 my $url = shift;
459 unshift @_, "POST", "body"; 472 unshift @_, "POST", $url, "body";
460 &http_request 473 &http_request
461} 474}
462 475
463=back 476=back
464 477
… …
490 503
491The maximum time to cache a persistent connection, in seconds (default: 2). 504The maximum time to cache a persistent connection, in seconds (default: 2).
492 505
493Not implemented currently. 506Not implemented currently.
494 507
508=item $AnyEvent::HTTP::ACTIVE
509
510The number of active connections. This is not the number of currently
511running requests, but the number of currently open and non-idle TCP
512connections. This number of can be useful for load-leveling.
513
495=back 514=back
496 515
497=cut 516=cut
498 517
499sub set_proxy($) { 518sub set_proxy($) {
… …
507 526
508L<AnyEvent>. 527L<AnyEvent>.
509 528
510=head1 AUTHOR 529=head1 AUTHOR
511 530
512 Marc Lehmann <schmorp@schmorp.de> 531 Marc Lehmann <schmorp@schmorp.de>
513 http://home.schmorp.de/ 532 http://home.schmorp.de/
514 533
515=cut 534=cut
516 535
5171 5361
518 537

Diff Legend

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