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.24 by root, Wed Jul 2 01:30:33 2008 UTC vs.
Revision 1.29 by root, Wed Oct 22 23:28:11 2008 UTC

… …
48use AnyEvent::Socket (); 48use AnyEvent::Socket ();
49use AnyEvent::Handle (); 49use AnyEvent::Handle ();
50 50
51use base Exporter::; 51use base Exporter::;
52 52
53our $VERSION = '1.03'; 53our $VERSION = '1.05';
54 54
55our @EXPORT = qw(http_get http_post http_head http_request); 55our @EXPORT = qw(http_get http_post http_head http_request);
56 56
57our $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)";
58our $MAX_RECURSE = 10; 58our $MAX_RECURSE = 10;
… …
71my %CO_SLOT; # number of open connections, and wait queue, per host 71my %CO_SLOT; # number of open connections, and wait queue, per host
72 72
73=item http_get $url, key => value..., $cb->($data, $headers) 73=item http_get $url, key => value..., $cb->($data, $headers)
74 74
75Executes an HTTP-GET request. See the http_request function for details on 75Executes an HTTP-GET request. See the http_request function for details on
76additional parameters. 76additional parameters and the return value.
77 77
78=item http_head $url, key => value..., $cb->($data, $headers) 78=item http_head $url, key => value..., $cb->($data, $headers)
79 79
80Executes an HTTP-HEAD request. See the http_request function for details on 80Executes an HTTP-HEAD request. See the http_request function for details
81additional parameters. 81on additional parameters and the return value.
82 82
83=item http_post $url, $body, key => value..., $cb->($data, $headers) 83=item http_post $url, $body, key => value..., $cb->($data, $headers)
84 84
85Executes an HTTP-POST request with a request body of C<$bod>. See the 85Executes an HTTP-POST request with a request body of C<$body>. See the
86http_request function for details on additional parameters. 86http_request function for details on additional parameters and the return
87value.
87 88
88=item http_request $method => $url, key => value..., $cb->($data, $headers) 89=item http_request $method => $url, key => value..., $cb->($data, $headers)
89 90
90Executes a HTTP request of type C<$method> (e.g. C<GET>, C<POST>). The URL 91Executes a HTTP request of type C<$method> (e.g. C<GET>, C<POST>). The URL
91must be an absolute http or https URL. 92must be an absolute http or https URL.
93
94When called in void context, nothing is returned. In other contexts,
95C<http_request> returns a "cancellation guard" - you have to keep the
96object at least alive until the callback get called. If the object gets
97destroyed before the callbakc is called, the request will be cancelled.
92 98
93The callback will be called with the response data as first argument 99The callback will be called with the response data as first argument
94(or C<undef> if it wasn't available due to errors), and a hash-ref with 100(or C<undef> if it wasn't available due to errors), and a hash-ref with
95response headers as second argument. 101response headers as second argument.
96 102
… …
188 my ($body, $hdr) = @_; 194 my ($body, $hdr) = @_;
189 use Data::Dumper; 195 use Data::Dumper;
190 print Dumper $hdr; 196 print Dumper $hdr;
191 } 197 }
192 ; 198 ;
199
200Example: make another simple HTTP GET request, but immediately try to
201cancel it.
202
203 my $request = http_request GET => "http://www.nethype.de/", sub {
204 my ($body, $hdr) = @_;
205 print "$body\n";
206 };
207
208 undef $request;
193 209
194=cut 210=cut
195 211
196sub _slot_schedule; 212sub _slot_schedule;
197sub _slot_schedule($) { 213sub _slot_schedule($) {
… …
355 371
356 %hdr = (); # reduce memory usage, save a kitten 372 %hdr = (); # reduce memory usage, save a kitten
357 373
358 # status line 374 # status line
359 $state{handle}->push_read (line => qr/\015?\012/, sub { 375 $state{handle}->push_read (line => qr/\015?\012/, sub {
360 $_[1] =~ /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) \s+ ([^\015\012]+)/ix 376 $_[1] =~ /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\015\012]*) )?/ix
361 or return (%state = (), $cb->(undef, { Status => 599, Reason => "invalid server response ($_[1])", URL => $url })); 377 or return (%state = (), $cb->(undef, { Status => 599, Reason => "invalid server response ($_[1])", URL => $url }));
362 378
363 my %hdr = ( # response headers 379 my %hdr = ( # response headers
364 HTTPVersion => "\x00$1", 380 HTTPVersion => "\x00$1",
365 Status => "\x00$2", 381 Status => "\x00$2",
… …
398 my %kv = (value => $value, map { split /=/, $_, 2 } @arg); 414 my %kv = (value => $value, map { split /=/, $_, 2 } @arg);
399 415
400 my $cdom = (delete $kv{domain}) || $uhost; 416 my $cdom = (delete $kv{domain}) || $uhost;
401 my $cpath = (delete $kv{path}) || "/"; 417 my $cpath = (delete $kv{path}) || "/";
402 418
403 $cdom =~ s/^.?/./; # make sure it starts with a "." 419 $cdom =~ s/^\.?/./; # make sure it starts with a "."
404 420
405 next if $cdom =~ /\.$/; 421 next if $cdom =~ /\.$/;
406 422
407 # this is not rfc-like and not netscape-like. go figure. 423 # this is not rfc-like and not netscape-like. go figure.
408 my $ndots = $cdom =~ y/.//; 424 my $ndots = $cdom =~ y/.//;
… …
412 $arg{cookie_jar}{version} = 1; 428 $arg{cookie_jar}{version} = 1;
413 $arg{cookie_jar}{$cdom}{$cpath}{$name} = \%kv; 429 $arg{cookie_jar}{$cdom}{$cpath}{$name} = \%kv;
414 } 430 }
415 } 431 }
416 432
417 # microsoft and other assholes don't give a shit for following standards, 433 # microsoft and other shitheads don't give a shit for following standards,
418 # try to support a common form of broken Location header. 434 # try to support some common forms of broken Location headers.
419 $_[1]{location} =~ s%^/%$scheme://$uhost:$uport/% 435 if ($_[1]{location} !~ /^(?: $ | [^:\/?\#]+ : )/x) {
436 $_[1]{location} =~ s/^\.\/+//;
437
438 my $url = "$scheme://$uhost:$uport";
439
420 if exists $_[1]{location}; 440 unless ($_[1]{location} =~ s/^\///) {
441 $url .= $upath;
442 $url =~ s/\/[^\/]*$//;
443 }
444
445 $_[1]{location} = "$url/$_[1]{location}";
446 }
421 447
422 if ($_[1]{Status} =~ /^30[12]$/ && $recurse && $method ne "POST") { 448 if ($_[1]{Status} =~ /^30[12]$/ && $recurse && $method ne "POST") {
423 # apparently, mozilla et al. just change POST to GET here 449 # apparently, mozilla et al. just change POST to GET here
424 # more research is needed before we do the same 450 # more research is needed before we do the same
425 http_request ($method, $_[1]{location}, %arg, recurse => $recurse - 1, $cb); 451 http_request ($method, $_[1]{location}, %arg, recurse => $recurse - 1, $cb);

Diff Legend

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