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.23 by root, Wed Jul 2 01:23:41 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;
… …
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;
… …
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) { 417 if ($_[1]{Status} =~ /^30[12]$/ && $recurse && $method ne "POST") {
415 # microsoft and other assholes don't give a shit for following standards, 418 # microsoft and other assholes don't give a shit for following standards,
416 # try to support a common form of broken Location header. 419 # try to support a common form of broken Location header.
417 $_[1]{location} =~ s%^/%$scheme://$uhost:$uport/%; 420 $_[1]{location} =~ s%^/%$scheme://$uhost:$uport/%;
418 421
422 # apparently, mozilla et al. just change POST to GET here
423 # more research is needed before we do the same
424
419 http_request ($method, $_[1]{location}, %arg, recurse => $recurse - 1, $cb); 425 http_request ($method, $_[1]{location}, %arg, recurse => $recurse - 1, $cb);
426 } elsif ($_[1]{Status} == 303 && $recurse) {
427 $_[1]{location} =~ s%^/%$scheme://$uhost:$uport/%;
428
429 http_request (GET => $_[1]{location}, %arg, recurse => $recurse - 1, $cb);
420 } else { 430 } else {
421 $cb->($_[0], $_[1]); 431 $cb->($_[0], $_[1]);
422 } 432 }
423 }; 433 };
424 434
… …
463 unshift @_, "HEAD"; 473 unshift @_, "HEAD";
464 &http_request 474 &http_request
465} 475}
466 476
467sub http_post($$@) { 477sub http_post($$@) {
478 my $url = shift;
468 unshift @_, "POST", "body"; 479 unshift @_, "POST", $url, "body";
469 &http_request 480 &http_request
470} 481}
471 482
472=back 483=back
473 484

Diff Legend

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