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.14 by root, Thu Jun 5 17:29:01 2008 UTC vs.
Revision 1.19 by elmex, Mon Jun 9 13:02:13 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;
… …
214 push @{ $CO_SLOT{$_[0]}[1] }, $_[1]; 218 push @{ $CO_SLOT{$_[0]}[1] }, $_[1];
215 219
216 _slot_schedule $_[0]; 220 _slot_schedule $_[0];
217} 221}
218 222
219sub http_request($$$;@) { 223sub http_request($$@) {
220 my $cb = pop; 224 my $cb = pop;
221 my ($method, $url, %arg) = @_; 225 my ($method, $url, %arg) = @_;
222 226
223 my %hdr; 227 my %hdr;
224 228
… …
230 } 234 }
231 } 235 }
232 236
233 my $recurse = exists $arg{recurse} ? $arg{recurse} : $MAX_RECURSE; 237 my $recurse = exists $arg{recurse} ? $arg{recurse} : $MAX_RECURSE;
234 238
235 return $cb->(undef, { Status => 599, Reason => "recursion limit reached" }) 239 return $cb->(undef, { Status => 599, Reason => "recursion limit reached", URL => $url })
236 if $recurse < 0; 240 if $recurse < 0;
237 241
238 my $proxy = $arg{proxy} || $PROXY; 242 my $proxy = $arg{proxy} || $PROXY;
239 my $timeout = $arg{timeout} || $TIMEOUT; 243 my $timeout = $arg{timeout} || $TIMEOUT;
240 244
… …
245 249
246 $scheme = lc $scheme; 250 $scheme = lc $scheme;
247 251
248 my $uport = $scheme eq "http" ? 80 252 my $uport = $scheme eq "http" ? 80
249 : $scheme eq "https" ? 443 253 : $scheme eq "https" ? 443
250 : 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", URL => $url });
251 255
252 $hdr{referer} ||= "$scheme://$authority$upath"; # leave out fragment and query string, just a heuristic 256 $hdr{referer} ||= "$scheme://$authority$upath"; # leave out fragment and query string, just a heuristic
253 257
254 $authority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x 258 $authority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x
255 or return $cb->(undef, { Status => 599, Reason => "unparsable URL" }); 259 or return $cb->(undef, { Status => 599, Reason => "unparsable URL", URL => $url });
256 260
257 my $uhost = $1; 261 my $uhost = $1;
258 $uport = $2 if defined $2; 262 $uport = $2 if defined $2;
259 263
260 $uhost =~ s/^\[(.*)\]$/$1/; 264 $uhost =~ s/^\[(.*)\]$/$1/;
… …
305 309
306 return unless $state{connect_guard}; 310 return unless $state{connect_guard};
307 311
308 $state{connect_guard} = AnyEvent::Socket::tcp_connect $rhost, $rport, sub { 312 $state{connect_guard} = AnyEvent::Socket::tcp_connect $rhost, $rport, sub {
309 $state{fh} = shift 313 $state{fh} = shift
310 or return $cb->(undef, { Status => 599, Reason => "$!" }); 314 or return $cb->(undef, { Status => 599, Reason => "$!", URL => $url });
311 315
312 delete $state{connect_guard}; # reduce memory usage, save a tree 316 delete $state{connect_guard}; # reduce memory usage, save a tree
313 317
314 # get handle 318 # get handle
315 $state{handle} = new AnyEvent::Handle 319 $state{handle} = new AnyEvent::Handle
… …
329 # (re-)configure handle 333 # (re-)configure handle
330 $state{handle}->timeout ($timeout); 334 $state{handle}->timeout ($timeout);
331 $state{handle}->on_error (sub { 335 $state{handle}->on_error (sub {
332 my $errno = "$!"; 336 my $errno = "$!";
333 %state = (); 337 %state = ();
334 $cb->(undef, { Status => 599, Reason => $errno }); 338 $cb->(undef, { Status => 599, Reason => $errno, URL => $url });
335 }); 339 });
336 $state{handle}->on_eof (sub { 340 $state{handle}->on_eof (sub {
337 %state = (); 341 %state = ();
338 $cb->(undef, { Status => 599, Reason => "unexpected end-of-file" }); 342 $cb->(undef, { Status => 599, Reason => "unexpected end-of-file", URL => $url });
339 }); 343 });
340 344
341 # send request 345 # send request
342 $state{handle}->push_write ( 346 $state{handle}->push_write (
343 "$method $rpath HTTP/1.0\015\012" 347 "$method $rpath HTTP/1.0\015\012"
… …
349 %hdr = (); # reduce memory usage, save a kitten 353 %hdr = (); # reduce memory usage, save a kitten
350 354
351 # status line 355 # status line
352 $state{handle}->push_read (line => qr/\015?\012/, sub { 356 $state{handle}->push_read (line => qr/\015?\012/, sub {
353 $_[1] =~ /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) \s+ ([^\015\012]+)/ix 357 $_[1] =~ /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) \s+ ([^\015\012]+)/ix
354 or return (%state = (), $cb->(undef, { Status => 599, Reason => "invalid server response ($_[1])" })); 358 or return (%state = (), $cb->(undef, { Status => 599, Reason => "invalid server response ($_[1])", URL => $url }));
355 359
356 my %hdr = ( # response headers 360 my %hdr = ( # response headers
357 HTTPVersion => "\x00$1", 361 HTTPVersion => "\x00$1",
358 Status => "\x00$2", 362 Status => "\x00$2",
359 Reason => "\x00$3", 363 Reason => "\x00$3",
364 URL => "\x00$url"
360 ); 365 );
361 366
362 # headers, could be optimized a bit 367 # headers, could be optimized a bit
363 $state{handle}->unshift_read (line => qr/\015?\012\015?\012/, sub { 368 $state{handle}->unshift_read (line => qr/\015?\012\015?\012/, sub {
364 for ("$_[1]\012") { 369 for ("$_[1]\012") {
… …
371 ((?: [^\015\012]+ | \015?\012[\011\040] )*) 376 ((?: [^\015\012]+ | \015?\012[\011\040] )*)
372 \015?\012 377 \015?\012
373 /gxc; 378 /gxc;
374 379
375 /\G$/ 380 /\G$/
376 or return (%state = (), $cb->(undef, { Status => 599, Reason => "garbled response headers" })); 381 or return (%state = (), $cb->(undef, { Status => 599, Reason => "garbled response headers", URL => $url }));
377 } 382 }
378 383
379 substr $_, 0, 1, "" 384 substr $_, 0, 1, ""
380 for values %hdr; 385 for values %hdr;
381 386
… …
447 }; 452 };
448 453
449 defined wantarray && AnyEvent::Util::guard { %state = () } 454 defined wantarray && AnyEvent::Util::guard { %state = () }
450} 455}
451 456
452sub http_get($$;@) { 457sub http_get($@) {
453 unshift @_, "GET"; 458 unshift @_, "GET";
454 &http_request 459 &http_request
455} 460}
456 461
457sub http_head($$;@) { 462sub http_head($@) {
458 unshift @_, "HEAD"; 463 unshift @_, "HEAD";
459 &http_request 464 &http_request
460} 465}
461 466
462sub http_post($$$;@) { 467sub http_post($$@) {
463 unshift @_, "POST", "body"; 468 unshift @_, "POST", "body";
464 &http_request 469 &http_request
465} 470}
466 471
467=back 472=back
… …
517 522
518L<AnyEvent>. 523L<AnyEvent>.
519 524
520=head1 AUTHOR 525=head1 AUTHOR
521 526
522 Marc Lehmann <schmorp@schmorp.de> 527 Marc Lehmann <schmorp@schmorp.de>
523 http://home.schmorp.de/ 528 http://home.schmorp.de/
524 529
525=cut 530=cut
526 531
5271 5321
528 533

Diff Legend

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