[ViewVC] Diff of: cvs/AnyEvent-HTTP/HTTP.pm

Comparing AnyEvent-HTTP/HTTP.pm (file contents):
Revision 1.3 by root, Wed Jun 4 11:58:36 2008 UTC vs.
Revision 1.9 by root, Wed Jun 4 13:51:53 2008 UTC

 =item http_get $url, key => value..., $cb->($data, $headers)
 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_get $url, $body, key => value..., $cb->($data, $headers)
+=item http_post $url, $body, key => value..., $cb->($data, $headers)
-Executes an HTTP-POST request with a requets body of C<$bod>. See the
+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<GET>, C<POST>). The URL
 The callback will be called with the response data as first argument
 (or C<undef> 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<HTTPVersion>, C<Status> and
 C<Reason> contain the three parts of the HTTP Status-Line of the same
 name.
 If an internal error occurs, such as not being able to resolve a hostname,
 then C<$data> will be C<undef>, C<< $headers->{Status} >> will be C<599>
 and the C<Reason> 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
 The request body, usually empty. Will be-sent as-is (future versions of
 this module might offer more options).
 =back
-=back
+Example: make a simple HTTP GET request for http://www.nethype.de/
+   http_request GET => "http://www.nethype.de/", sub {
+      my ($body, $hdr) = @_;
+      print "$body\n";
+   };
+Example: make a HTTP HEAD request on https://www.google.com/, use a
+timeout of 30 seconds.
+   http_request
+      GET     => "https://www.google.com",
+      timeout => 30,
+      sub {
+         my ($body, $hdr) = @_;
+         use Data::Dumper;
+         print Dumper $hdr;
+      }
+   ;
 =cut
 sub http_request($$$;@) {
    my $cb = pop;
    my %hdr;
    $method = uc $method;
-   if (my $hdr = delete $arg{headers}) {
+   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;
-   my $recurse = exists $arg{recurse} ? $arg{recurse} : $MAX_RECURSE;
    $hdr{"user-agent"} ||= $USERAGENT;
    my ($host, $port, $path, $scheme);
       ($scheme, my $authority, $path, my $query, my $fragment) =
          $url =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|;
       $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;
       $host =~ s/^\[(.*)\]$/$1/;
    $scheme = lc $scheme;
    my %state;
-   $state{body} = delete $arg{body};
-   $hdr{"content-length"} = length $state{body};
+   $hdr{"content-length"} = length $arg{body};
    $state{connect_guard} = AnyEvent::Socket::tcp_connect $host, $port, sub {
       $state{fh} = shift
          or return $cb->(undef, { Status => 599, Reason => "$!" });
       # send request
       $state{handle}->push_write (
          "$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
       # status line
             }
             substr $_, 0, 1, ""
                for values %hdr;
-            if ($method ne "HEAD") {
+            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 {
                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);
+                     $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 = ();
-                     $cb->($_[0]{rbuf}, \%hdr);
+                     $finish->($_[0]{rbuf}, \%hdr);
                   });
                   $_[0]->on_eof (undef);
                   $_[0]->on_read (sub { });
                }
             }
 sub http_get($$;@) {
    unshift @_, "GET";
    &http_request
 }
+sub http_head($$;@) {
+   unshift @_, "HEAD";
+   &http_request
+}
 sub http_post($$$;@) {
    unshift @_, "POST", "body";
    &http_request
 }
+=back
 =head2 GLOBAL FUNCTIONS AND VARIABLES
 =over 4
 =item AnyEvent::HTTP::set_proxy "proxy-url"

Diff Legend

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

Comparing AnyEvent-HTTP/HTTP.pm (file contents): Revision 1.3 by root, Wed Jun 4 11:58:36 2008 UTC vs. Revision 1.9 by root, Wed Jun 4 13:51:53 2008 UTC

Diff Legend

Comparing AnyEvent-HTTP/HTTP.pm (file contents):
Revision 1.3 by root, Wed Jun 4 11:58:36 2008 UTC vs.
Revision 1.9 by root, Wed Jun 4 13:51:53 2008 UTC