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

Comparing AnyEvent-HTTP/HTTP.pm (file contents):
Revision 1.43 by root, Mon Jul 6 03:03:12 2009 UTC vs.
Revision 1.53 by root, Sat Dec 5 15:37:07 2009 UTC

 use strict;
 no warnings;
 use Errno ();
-use AnyEvent 4.452 ();
+use AnyEvent 5.0 ();
 use AnyEvent::Util ();
 use AnyEvent::Socket ();
 use AnyEvent::Handle ();
 use base Exporter::;
-our $VERSION = '1.12';
+our $VERSION = '1.44';
 our @EXPORT = qw(http_get http_post http_head http_request);
 our $USERAGENT          = "Mozilla/5.0 (compatible; U; AnyEvent-HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)";
 our $MAX_RECURSE        =  10;
 =item headers => hashref
 The request headers to use. Currently, C<http_request> may provide its
 own C<Host:>, C<Content-Length:>, C<Connection:> and C<Cookie:> headers
-and will provide defaults for C<User-Agent:> and C<Referer:>.
+and will provide defaults for C<User-Agent:> and C<Referer:> (this can be
+suppressed by using C<undef> for these headers in which case they won't be
+sent at all).
 =item timeout => $seconds
 The time-out to use for various stages - each connect attempt will reset
-the timeout, as will read or write activity. Default timeout is 5 minutes.
+the timeout, as will read or write activity, i.e. this is not an overall
+timeout.
+Default timeout is 5 minutes.
 =item proxy => [$host, $port[, $scheme]] or undef
 Use the given http proxy for all requests. If not specified, then the
 default proxy (as specified by C<$ENV{http_proxy}>) is used.
-C<$scheme> must be either missing or C<http> for HTTP, or C<https> for
+C<$scheme> must be either missing, C<http> for HTTP or C<https> for
 HTTPS.
 =item body => $string
 The request body, usually empty. Will be-sent as-is (future versions of
 verification) TLS context.
 The default for this option is C<low>, which could be interpreted as "give
 me the page, no matter what".
+=item on_prepare => $callback->($fh)
+In rare cases you need to "tune" the socket before it is used to
+connect (for exmaple, to bind it on a given IP address). This parameter
+overrides the prepare callback passed to C<AnyEvent::Socket::tcp_connect>
+and behaves exactly the same way (e.g. it has to provide a
+timeout). See the description for the C<$prepare_cb> argument of
+C<AnyEvent::Socket::tcp_connect> for details.
 =item on_header => $callback->($headers)
 When specified, this callback will be called with the header hash as soon
 as headers have been successfully received from the remote server (not on
 locally-generated errors).
 This callback is useful when the data is too large to be held in memory
 (so the callback writes it to a file) or when only some information should
 be extracted, or when the body should be processed incrementally.
 It is usually preferred over doing your own body handling via
-C<want_body_handle>.
+C<want_body_handle>, but in case of streaming APIs, where HTTP is
+only used to create a connection, C<want_body_handle> is the better
+alternative, as it allows you to install your own event handler, reducing
+resource usage.
 =item want_body_handle => $enable
 When enabled (default is disabled), the behaviour of AnyEvent::HTTP
 changes considerably: after parsing the headers, and instead of
 This is useful with some push-type services, where, after the initial
 headers, an interactive protocol is used (typical example would be the
 push-style twitter API which starts a JSON/XML stream).
 If you think you need this, first have a look at C<on_body>, to see if
-that doesn'T solve your problem in a better way.
+that doesn't solve your problem in a better way.
 =back
 Example: make a simple HTTP GET request for http://www.nethype.de/
    push @{ $CO_SLOT{$_[0]}[1] }, $_[1];
    _slot_schedule $_[0];
 }
-our $qr_nl   = qr<\015?\012>;
+our $qr_nl   = qr{\015?\012};
-our $qr_nlnl = qr<\015?\012\015?\012>;
+our $qr_nlnl = qr{(?<![^\012])\015?\012};
 our $TLS_CTX_LOW  = { cache => 1, sslv2 => 1 };
 our $TLS_CTX_HIGH = { cache => 1, verify => 1, verify_peername => "https" };
 sub http_request($$@) {
       or return $cb->(undef, { Status => 599, Reason => "Unparsable URL", URL => $url });
    my $uhost = $1;
    $uport = $2 if defined $2;
-   $hdr{host} = defined $2 ? "$uhost:$2" : "$uhost";
+   $hdr{host} = defined $2 ? "$uhost:$2" : "$uhost"
+      unless exists $hdr{host};
    $uhost =~ s/^\[(.*)\]$/$1/;
    $upath .= "?$query" if length $query;
    $upath =~ s%^/?%/%;
    my ($rhost, $rport, $rscheme, $rpath); # request host, port, path
    if ($proxy) {
       ($rpath, $rhost, $rport, $rscheme) = ($url, @$proxy);
+      $rscheme = "http" unless defined $rscheme;
       # don't support https requests over https-proxy transport,
       # can't be done with tls as spec'ed, unless you double-encrypt.
       $rscheme = "http" if $uscheme eq "https" && $rscheme eq "https";
    } else {
       ($rhost, $rport, $rscheme, $rpath) = ($uhost, $uport, $uscheme, $upath);
    }
-   $hdr{"user-agent"} ||= $USERAGENT;
+   # leave out fragment and query string, just a heuristic
-   $hdr{referer}      ||= "$uscheme://$uauthority$upath"; # leave out fragment and query string, just a heuristic
+   $hdr{referer}      ||= "$uscheme://$uauthority$upath" unless exists $hdr{referer};
+   $hdr{"user-agent"} ||= $USERAGENT                     unless exists $hdr{"user-agent"};
-   $hdr{"content-length"} = length $arg{body};
+   $hdr{"content-length"} = length $arg{body}
+      if length $arg{body} || $method ne "GET";
    my %state = (connect_guard => 1);
    _get_slot $uhost, sub {
       $state{slot_guard} = shift;
       return unless $state{connect_guard};
       $state{connect_guard} = AnyEvent::Socket::tcp_connect $rhost, $rport, sub {
          $state{fh} = shift
+            or do {
+               my $err = "$!";
+               %state = ();
-            or return (%state = (), $cb->(undef, { Status => 599, Reason => "$!", URL => $url }));
+               return $cb->(undef, { Status => 599, Reason => $err, URL => $url });
+            };
          pop; # free memory, save a tree
          return unless delete $state{connect_guard};
          # get handle
             $state{handle}->starttls ("connect") if $uscheme eq "https" && !exists $state{handle}{tls};
             # send request
             $state{handle}->push_write (
                "$method $rpath HTTP/1.0\015\012"
-               . (join "", map "\u$_: $hdr{$_}\015\012", keys %hdr)
+               . (join "", map "\u$_: $hdr{$_}\015\012", grep defined $hdr{$_}, keys %hdr)
                . "\015\012"
                . (delete $arg{body})
             );
             %hdr = (); # reduce memory usage, save a kitten
                   URL         => ",$url"
                );
                # headers, could be optimized a bit
                $state{handle}->unshift_read (line => $qr_nlnl, sub {
-                  for ("$_[1]\012") {
+                  for ("$_[1]") {
                      y/\015//d; # weed out any \015, as they show up in the weirdest of places.
                      # things seen, not parsed:
                      # p3pP="NON CUR OTPi OUR NOR UNI"
                            redo if /\G\s*,/gc;
                         }
                      }
-                     if ($redirect) {
+                     if ($redirect && exists $hdr{location}) {
                         # we ignore any errors, as it is very common to receive
                         # Content-Length != 0 but no actual body
                         # we also access %hdr, as $_[1] might be an erro
                         http_request ($method => $hdr{location}, %arg, recurse => $recurse - 1, $cb);
                      } else {
             });
          } else {
             &$handle_actual_request;
          }
-      }, sub {
+      }, $arg{on_prepare} || sub { $timeout };
-         $timeout
-      };
    };
    defined wantarray && AnyEvent::Util::guard { %state = () }
 }
 =over 4
 =item AnyEvent::HTTP::set_proxy "proxy-url"
 Sets the default proxy server to use. The proxy-url must begin with a
-string of the form C<http://host:port> (optionally C<https:...>).
+string of the form C<http://host:port> (optionally C<https:...>), croaks
+otherwise.
+To clear an already-set proxy, use C<undef>.
 =item $AnyEvent::HTTP::MAX_RECURSE
 The default value for the C<recurse> request parameter (default: C<10>).
 The default value for the C<User-Agent> header (the default is
 C<Mozilla/5.0 (compatible; U; AnyEvent-HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)>).
 =item $AnyEvent::HTTP::MAX_PER_HOST
-The maximum number of concurrent conenctions to the same host (identified
+The maximum number of concurrent connections to the same host (identified
 by the hostname). If the limit is exceeded, then the additional requests
 are queued until previous connections are closed.
 The default value for this is C<4>, and it is highly advisable to not
 increase it.
 =back
 =cut
 sub set_proxy($) {
+   if (length $_[0]) {
-   $PROXY = [$2, $3 || 3128, $1] if $_[0] =~ m%^(https?):// ([^:/]+) (?: : (\d*) )?%ix;
+      $_[0] =~ m%^(https?):// ([^:/]+) (?: : (\d*) )?%ix
+         or Carp::croak "$_[0]: invalid proxy URL";
+      $PROXY = [$2, $3 || 3128, $1]
+   } else {
+      undef $PROXY;
+   }
 }
 # initialise proxy from environment
+eval {
-set_proxy $ENV{http_proxy};
+   set_proxy $ENV{http_proxy};
+};
 =head1 SEE ALSO
 L<AnyEvent>.

Diff Legend

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

Comparing AnyEvent-HTTP/HTTP.pm (file contents): Revision 1.43 by root, Mon Jul 6 03:03:12 2009 UTC vs. Revision 1.53 by root, Sat Dec 5 15:37:07 2009 UTC

Diff Legend

Comparing AnyEvent-HTTP/HTTP.pm (file contents):
Revision 1.43 by root, Mon Jul 6 03:03:12 2009 UTC vs.
Revision 1.53 by root, Sat Dec 5 15:37:07 2009 UTC