--- AnyEvent-HTTP/HTTP.pm 2008/07/02 01:30:33 1.24 +++ AnyEvent-HTTP/HTTP.pm 2008/10/22 23:28:11 1.29 @@ -50,7 +50,7 @@ use base Exporter::; -our $VERSION = '1.03'; +our $VERSION = '1.05'; our @EXPORT = qw(http_get http_post http_head http_request); @@ -73,23 +73,29 @@ =item http_get $url, key => value..., $cb->($data, $headers) Executes an HTTP-GET request. See the http_request function for details on -additional parameters. +additional parameters and the return value. =item http_head $url, key => value..., $cb->($data, $headers) -Executes an HTTP-HEAD request. See the http_request function for details on -additional parameters. +Executes an HTTP-HEAD request. See the http_request function for details +on additional parameters and the return value. =item http_post $url, $body, key => value..., $cb->($data, $headers) -Executes an HTTP-POST request with a request body of C<$bod>. See the -http_request function for details on additional parameters. +Executes an HTTP-POST request with a request body of C<$body>. See the +http_request function for details on additional parameters and the return +value. =item http_request $method => $url, key => value..., $cb->($data, $headers) Executes a HTTP request of type C<$method> (e.g. C, C). The URL must be an absolute http or https URL. +When called in void context, nothing is returned. In other contexts, +C returns a "cancellation guard" - you have to keep the +object at least alive until the callback get called. If the object gets +destroyed before the callbakc is called, the request will be cancelled. + The callback will be called with the response data as first argument (or C if it wasn't available due to errors), and a hash-ref with response headers as second argument. @@ -191,6 +197,16 @@ } ; +Example: make another simple HTTP GET request, but immediately try to +cancel it. + + my $request = http_request GET => "http://www.nethype.de/", sub { + my ($body, $hdr) = @_; + print "$body\n"; + }; + + undef $request; + =cut sub _slot_schedule; @@ -357,7 +373,7 @@ # status line $state{handle}->push_read (line => qr/\015?\012/, sub { - $_[1] =~ /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) \s+ ([^\015\012]+)/ix + $_[1] =~ /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\015\012]*) )?/ix or return (%state = (), $cb->(undef, { Status => 599, Reason => "invalid server response ($_[1])", URL => $url })); my %hdr = ( # response headers @@ -400,7 +416,7 @@ my $cdom = (delete $kv{domain}) || $uhost; my $cpath = (delete $kv{path}) || "/"; - $cdom =~ s/^.?/./; # make sure it starts with a "." + $cdom =~ s/^\.?/./; # make sure it starts with a "." next if $cdom =~ /\.$/; @@ -414,10 +430,20 @@ } } - # microsoft and other assholes don't give a shit for following standards, - # try to support a common form of broken Location header. - $_[1]{location} =~ s%^/%$scheme://$uhost:$uport/% - if exists $_[1]{location}; + # microsoft and other shitheads don't give a shit for following standards, + # try to support some common forms of broken Location headers. + if ($_[1]{location} !~ /^(?: $ | [^:\/?\#]+ : )/x) { + $_[1]{location} =~ s/^\.\/+//; + + my $url = "$scheme://$uhost:$uport"; + + unless ($_[1]{location} =~ s/^\///) { + $url .= $upath; + $url =~ s/\/[^\/]*$//; + } + + $_[1]{location} = "$url/$_[1]{location}"; + } if ($_[1]{Status} =~ /^30[12]$/ && $recurse && $method ne "POST") { # apparently, mozilla et al. just change POST to GET here