--- AnyEvent-HTTP/HTTP.pm 2008/06/04 11:37:41 1.2 +++ AnyEvent-HTTP/HTTP.pm 2008/06/04 12:32:30 1.8 @@ -36,7 +36,7 @@ our @EXPORT = qw(http_get http_request); our $USERAGENT = "Mozilla/5.0 (compatible; AnyEvent::HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)"; -our $MAX_REDIRECTS = 10; +our $MAX_RECURSE = 10; our $MAX_PERSISTENT = 8; our $PERSISTENT_TIMEOUT = 2; our $TIMEOUT = 300; @@ -54,6 +54,16 @@ Executes an HTTP-GET request. See the http_request function for details on additional parameters. +=item http_head $url, key => value..., $cb->($data, $headers) + +Executes an HTTP-HEAD request. See the http_request function for details on +additional parameters. + +=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. + =item http_request $method => $url, key => value..., $cb->($data, $headers) Executes a HTTP request of type C<$method> (e.g. C, C). The URL @@ -63,7 +73,7 @@ (or C if it wasn't available due to errors), and a hash-ref with response headers as second argument. -All the headers in that has are lowercased. In addition to the response +All the headers in that hash are lowercased. In addition to the response headers, the three "pseudo-headers" C, C and C contain the three parts of the HTTP Status-Line of the same name. @@ -72,15 +82,27 @@ then C<$data> will be C, C<< $headers->{Status} >> will be C<599> and the C pseudo-header will contain an error message. +A typical callback might look like this: + + sub { + my ($body, $hdr) = @_; + + if ($hdr->{Status} =~ /^2/) { + ... everything should be ok + } else { + print "error, $hdr->{Status} $hdr->{Reason}\n"; + } + } + Additional parameters are key-value pairs, and are fully optional. They include: =over 4 -=item recurse => $boolean (default: true) +=item recurse => $count (default: $MAX_RECURSE) Whether to recurse requests or not, e.g. on redirects, authentication -retries and so on. +retries and so on, and how often to do so. =item headers => hashref @@ -99,6 +121,11 @@ C<$scheme> must be either missing or C for HTTP, or C for HTTPS. +=item body => $string + +The request body, usually empty. Will be-sent as-is (future versions of +this module might offer more options). + =back =back @@ -111,12 +138,19 @@ my %hdr; - if (my $hdr = delete $arg{headers}) { + $method = uc $method; + + if (my $hdr = $arg{headers}) { while (my ($k, $v) = each %$hdr) { $hdr{lc $k} = $v; } } + my $recurse = exists $arg{recurse} ? $arg{recurse} : $MAX_RECURSE; + + return $cb->(undef, { Status => 599, Reason => "recursion limit reached" }) + if $recurse < 0; + my $proxy = $arg{proxy} || $PROXY; my $timeout = $arg{timeout} || $TIMEOUT; @@ -133,10 +167,10 @@ $port = $scheme eq "http" ? 80 : $scheme eq "https" ? 443 - : croak "$url: only http and https URLs supported"; + : return $cb->(undef, { Status => 599, Reason => "$url: only http and https URLs supported" }); $authority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x - or croak "$authority: unparsable URL"; + or return $cb->(undef, { Status => 599, Reason => "$url: unparsable URL" }); $host = $1; $port = $2 if defined $2; @@ -153,10 +187,7 @@ my %state; - my $body = ""; - $state{body} = $body; - - $hdr{"content-length"} = length $body; + $hdr{"content-length"} = length $arg{body}; $state{connect_guard} = AnyEvent::Socket::tcp_connect $host, $port, sub { $state{fh} = shift @@ -192,10 +223,10 @@ # send request $state{handle}->push_write ( - "\U$method\E $path HTTP/1.0\015\012" + "$method $path HTTP/1.0\015\012" . (join "", map "$_: $hdr{$_}\015\012", keys %hdr) . "\015\012" - . (delete $state{body}) + . (delete $arg{body}) ); %hdr = (); # reduce memory usage, save a kitten @@ -231,25 +262,38 @@ substr $_, 0, 1, "" for values %hdr; - if (exists $hdr{"content-length"}) { - $_[0]->unshift_read (chunk => $hdr{"content-length"}, sub { - # could cache persistent connection now - if ($hdr{connection} =~ /\bkeep-alive\b/i) { - # but we don't, due to misdesigns, this is annoyingly complex - }; - - %state = (); - $cb->($_[1], \%hdr); - }); + my $finish = sub { + if ($_[1]{Status} =~ /^30[12]$/ && $recurse) { + http_request ($method, $_[1]{location}, %arg, recurse => $recurse - 1, $cb); + } else { + $cb->($_[0], $_[1]); + } + }; + + if ($hdr{Status} =~ /^(?:1..|204|304)$/ or $method eq "HEAD") { + %state = (); + $finish->(undef, \%hdr); } else { - # too bad, need to read until we get an error or EOF, - # no way to detect winged data. - $_[0]->on_error (sub { - %state = (); - $cb->($_[0]{rbuf}, \%hdr); - }); - $_[0]->on_eof (undef); - $_[0]->on_read (sub { }); + if (exists $hdr{"content-length"}) { + $_[0]->unshift_read (chunk => $hdr{"content-length"}, sub { + # could cache persistent connection now + if ($hdr{connection} =~ /\bkeep-alive\b/i) { + # but we don't, due to misdesigns, this is annoyingly complex + }; + + %state = (); + $finish->($_[1], \%hdr); + }); + } else { + # too bad, need to read until we get an error or EOF, + # no way to detect winged data. + $_[0]->on_error (sub { + %state = (); + $finish->($_[0]{rbuf}, \%hdr); + }); + $_[0]->on_eof (undef); + $_[0]->on_read (sub { }); + } } }); }); @@ -265,6 +309,16 @@ &http_request } +sub http_head($$;@) { + unshift @_, "HEAD"; + &http_request +} + +sub http_post($$$;@) { + unshift @_, "POST", "body"; + &http_request +} + =head2 GLOBAL FUNCTIONS AND VARIABLES =over 4 @@ -274,10 +328,9 @@ Sets the default proxy server to use. The proxy-url must begin with a string of the form C (optionally C). -=item $AnyEvent::HTTP::MAX_REDIRECTS +=item $AnyEvent::HTTP::MAX_RECURSE -The default value for the C request parameter -(default: C<10>). +The default value for the C request parameter (default: C<10>). =item $AnyEvent::HTTP::USERAGENT @@ -288,10 +341,14 @@ The maximum number of persistent connections to keep open (default: 8). +Not implemented currently. + =item $AnyEvent::HTTP::PERSISTENT_TIMEOUT The maximum time to cache a persistent connection, in seconds (default: 2). +Not implemented currently. + =back =cut