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.19 by elmex, Mon Jun 9 13:02:13 2008 UTC vs.
Revision 1.26 by root, Thu Jul 24 05:59:20 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.01'; 53our $VERSION = '1.03';
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;
… …
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 on
81additional parameters. 81additional parameters.
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.
87 87
88=item http_request $method => $url, key => value..., $cb->($data, $headers) 88=item http_request $method => $url, key => value..., $cb->($data, $headers)
89 89
90Executes a HTTP request of type C<$method> (e.g. C<GET>, C<POST>). The URL 90Executes a HTTP request of type C<$method> (e.g. C<GET>, C<POST>). The URL
… …
93The callback will be called with the response data as first argument 93The 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 94(or C<undef> if it wasn't available due to errors), and a hash-ref with
95response headers as second argument. 95response headers as second argument.
96 96
97All 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
98headers, the three "pseudo-headers" C<HTTPVersion>, C<Status> and 98headers, the "pseudo-headers" C<HTTPVersion>, C<Status> and C<Reason>
99C<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
100name. If the server sends a header multiple lines, then their contents 103If the server sends a header multiple lines, then their contents will be
101will be joined together with C<\x00>. 104joined together with C<\x00>.
102 105
103If 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,
104then 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>
105and the C<Reason> pseudo-header will contain an error message. 108and the C<Reason> pseudo-header will contain an error message.
106 109
… …
232 while (my ($k, $v) = each %$hdr) { 235 while (my ($k, $v) = each %$hdr) {
233 $hdr{lc $k} = $v; 236 $hdr{lc $k} = $v;
234 } 237 }
235 } 238 }
236 239
237 my $recurse = exists $arg{recurse} ? $arg{recurse} : $MAX_RECURSE; 240 my $recurse = exists $arg{recurse} ? delete $arg{recurse} : $MAX_RECURSE;
238 241
239 return $cb->(undef, { Status => 599, Reason => "recursion limit reached", URL => $url }) 242 return $cb->(undef, { Status => 599, Reason => "recursion limit reached", URL => $url })
240 if $recurse < 0; 243 if $recurse < 0;
241 244
242 my $proxy = $arg{proxy} || $PROXY; 245 my $proxy = $arg{proxy} || $PROXY;
… …
352 355
353 %hdr = (); # reduce memory usage, save a kitten 356 %hdr = (); # reduce memory usage, save a kitten
354 357
355 # status line 358 # status line
356 $state{handle}->push_read (line => qr/\015?\012/, sub { 359 $state{handle}->push_read (line => qr/\015?\012/, sub {
357 $_[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
358 or return (%state = (), $cb->(undef, { Status => 599, Reason => "invalid server response ($_[1])", URL => $url })); 361 or return (%state = (), $cb->(undef, { Status => 599, Reason => "invalid server response ($_[1])", URL => $url }));
359 362
360 my %hdr = ( # response headers 363 my %hdr = ( # response headers
361 HTTPVersion => "\x00$1", 364 HTTPVersion => "\x00$1",
362 Status => "\x00$2", 365 Status => "\x00$2",
… …
409 $arg{cookie_jar}{version} = 1; 412 $arg{cookie_jar}{version} = 1;
410 $arg{cookie_jar}{$cdom}{$cpath}{$name} = \%kv; 413 $arg{cookie_jar}{$cdom}{$cpath}{$name} = \%kv;
411 } 414 }
412 } 415 }
413 416
414 if ($_[1]{Status} =~ /^30[12]$/ && $recurse) {
415 # microsoft and other assholes don't give a shit for following standards, 417 # microsoft and other shitheads don't give a shit for following standards,
416 # try to support a common form of broken Location header. 418 # try to support some common forms of broken Location headers.
419 if ($_[1]{location} !~ /^(?: $ | [^:\/?\#]+ : )/x) {
420 $_[1]{location} =~ s/^\.\/+//;
421
417 $_[1]{location} =~ s%^/%$scheme://$uhost:$uport/%; 422 my $url = "$scheme://$uhost:$uport";
418 423
424 unless ($_[1]{location} =~ s/^\///) {
425 $url .= $upath;
426 $url =~ s/\/[^\/]*$//;
427 }
428
429 $_[1]{location} = "$url/$_[1]{location}";
430 }
431
432 if ($_[1]{Status} =~ /^30[12]$/ && $recurse && $method ne "POST") {
433 # apparently, mozilla et al. just change POST to GET here
434 # more research is needed before we do the same
419 http_request ($method, $_[1]{location}, %arg, recurse => $recurse - 1, $cb); 435 http_request ($method, $_[1]{location}, %arg, recurse => $recurse - 1, $cb);
436 } elsif ($_[1]{Status} == 303 && $recurse) {
437 # even http/1.1 is unlear on how to mutate the method
438 $method = "GET" unless $method eq "HEAD";
439 http_request ($method => $_[1]{location}, %arg, recurse => $recurse - 1, $cb);
440 } elsif ($_[1]{Status} == 307 && $recurse && $method =~ /^(?:GET|HEAD)$/) {
441 http_request ($method => $_[1]{location}, %arg, recurse => $recurse - 1, $cb);
420 } else { 442 } else {
421 $cb->($_[0], $_[1]); 443 $cb->($_[0], $_[1]);
422 } 444 }
423 }; 445 };
424 446
… …
463 unshift @_, "HEAD"; 485 unshift @_, "HEAD";
464 &http_request 486 &http_request
465} 487}
466 488
467sub http_post($$@) { 489sub http_post($$@) {
490 my $url = shift;
468 unshift @_, "POST", "body"; 491 unshift @_, "POST", $url, "body";
469 &http_request 492 &http_request
470} 493}
471 494
472=back 495=back
473 496

Diff Legend

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