Index: perl/modules/Facebook/lib/AnyEvent/HTTP.pm
===================================================================
--- perl/modules/Facebook/lib/AnyEvent/HTTP.pm	(revision bbd0cf162e91b3b75e5ee8670e46db64431aa63b)
+++ 	(revision )
@@ -1,1528 +1,0 @@
-=head1 NAME
-
-AnyEvent::HTTP - simple but non-blocking HTTP/HTTPS client
-
-=head1 SYNOPSIS
-
-   use AnyEvent::HTTP;
-
-   http_get "http://www.nethype.de/", sub { print $_[1] };
-
-   # ... do something else here
-
-=head1 DESCRIPTION
-
-This module is an L<AnyEvent> user, you need to make sure that you use and
-run a supported event loop.
-
-This module implements a simple, stateless and non-blocking HTTP
-client. It supports GET, POST and other request methods, cookies and more,
-all on a very low level. It can follow redirects, supports proxies, and
-automatically limits the number of connections to the values specified in
-the RFC.
-
-It should generally be a "good client" that is enough for most HTTP
-tasks. Simple tasks should be simple, but complex tasks should still be
-possible as the user retains control over request and response headers.
-
-The caller is responsible for authentication management, cookies (if
-the simplistic implementation in this module doesn't suffice), referer
-and other high-level protocol details for which this module offers only
-limited support.
-
-=head2 METHODS
-
-=over 4
-
-=cut
-
-package AnyEvent::HTTP;
-
-use common::sense;
-
-use Errno ();
-
-use AnyEvent 5.0 ();
-use AnyEvent::Util ();
-use AnyEvent::Handle ();
-
-use base Exporter::;
-
-our $VERSION = '2.13';
-
-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;
-our $PERSISTENT_TIMEOUT =   3;
-our $TIMEOUT            = 300;
-our $MAX_PER_HOST       =   4; # changing this is evil
-
-our $PROXY;
-our $ACTIVE = 0;
-
-my %KA_CACHE; # indexed by uhost currently, points to [$handle...] array
-my %CO_SLOT;  # number of open connections, and wait queue, per host
-
-=item http_get $url, key => value..., $cb->($data, $headers)
-
-Executes an HTTP-GET request. See the http_request function for details on
-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 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<$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<GET>, C<POST>). The URL
-must be an absolute http or https URL.
-
-When called in void context, nothing is returned. In other contexts,
-C<http_request> 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 callback is called, the request will be cancelled.
-
-The callback will be called with the response body data as first argument
-(or C<undef> if an error occured), and a hash-ref with response headers
-(and trailers) as second argument.
-
-All the headers in that hash are lowercased. In addition to the response
-headers, the "pseudo-headers" (uppercase to avoid clashing with possible
-response headers) C<HTTPVersion>, C<Status> and C<Reason> contain the
-three parts of the HTTP Status-Line of the same name. If an error occurs
-during the body phase of a request, then the original C<Status> and
-C<Reason> values from the header are available as C<OrigStatus> and
-C<OrigReason>.
-
-The pseudo-header C<URL> contains the actual URL (which can differ from
-the requested URL when following redirects - for example, you might get
-an error that your URL scheme is not supported even though your URL is a
-valid http URL because it redirected to an ftp URL, in which case you can
-look at the URL pseudo header).
-
-The pseudo-header C<Redirect> only exists when the request was a result
-of an internal redirect. In that case it is an array reference with
-the C<($data, $headers)> from the redirect response. Note that this
-response could in turn be the result of a redirect itself, and C<<
-$headers->{Redirect}[1]{Redirect} >> will then contain the original
-response, and so on.
-
-If the server sends a header multiple times, then their contents will be
-joined together with a comma (C<,>), as per the HTTP spec.
-
-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<590>-C<599> and the C<Reason> pseudo-header will contain an error
-message. Currently the following status codes are used:
-
-=over 4
-
-=item 595 - errors during connection etsbalishment, proxy handshake.
-
-=item 596 - errors during TLS negotiation, request sending and header processing.
-
-=item 597 - errors during body receiving or processing.
-
-=item 598 - user aborted request via C<on_header> or C<on_body>.
-
-=item 599 - other, usually nonretryable, errors (garbled URL etc.).
-
-=back
-
-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 => $count (default: $MAX_RECURSE)
-
-Whether to recurse requests or not, e.g. on redirects, authentication
-retries and so on, and how often to do so.
-
-=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 at least for C<TE:>, C<Referer:> and C<User-Agent:>
-(this can be suppressed by using C<undef> for these headers in which case
-they won't be sent at all).
-
-You really should provide your own C<User-Agent:> header value that is
-appropriate for your program - I wouldn't be surprised if the default
-AnyEvent string gets blocked by webservers sooner or later.
-
-Also, make sure that your headers names and values do not contain any
-embedded newlines.
-
-=item timeout => $seconds
-
-The time-out to use for various stages - each connect attempt will reset
-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, or no proxy if C<undef> is
-used.
-
-C<$scheme> must be either missing or must be C<http> for HTTP.
-
-If not specified, then the default proxy is used (see
-C<AnyEvent::HTTP::set_proxy>).
-
-=item body => $string
-
-The request body, usually empty. Will be sent as-is (future versions of
-this module might offer more options).
-
-=item cookie_jar => $hash_ref
-
-Passing this parameter enables (simplified) cookie-processing, loosely
-based on the original netscape specification.
-
-The C<$hash_ref> must be an (initially empty) hash reference which
-will get updated automatically. It is possible to save the cookie jar
-to persistent storage with something like JSON or Storable - see the
-C<AnyEvent::HTTP::cookie_jar_expire> function if you wish to remove
-expired or session-only cookies, and also for documentation on the format
-of the cookie jar.
-
-Note that this cookie implementation is not meant to be complete. If
-you want complete cookie management you have to do that on your
-own. C<cookie_jar> is meant as a quick fix to get most cookie-using sites
-working. Cookies are a privacy disaster, do not use them unless required
-to.
-
-When cookie processing is enabled, the C<Cookie:> and C<Set-Cookie:>
-headers will be set and handled by this module, otherwise they will be
-left untouched.
-
-=item tls_ctx => $scheme | $tls_ctx
-
-Specifies the AnyEvent::TLS context to be used for https connections. This
-parameter follows the same rules as the C<tls_ctx> parameter to
-L<AnyEvent::Handle>, but additionally, the two strings C<low> or
-C<high> can be specified, which give you a predefined low-security (no
-verification, highest compatibility) and high-security (CA and common-name
-verification) TLS context.
-
-The default for this option is C<low>, which could be interpreted as "give
-me the page, no matter what".
-
-See also the C<sessionid> parameter.
-
-=item session => $string
-
-The module might reuse connections to the same host internally. Sometimes
-(e.g. when using TLS), you do not want to reuse connections from other
-sessions. This can be achieved by setting this parameter to some unique
-ID (such as the address of an object storing your state data, or the TLS
-context) - only connections using the same unique ID will be reused.
-
-=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 tcp_connect => $callback->($host, $service, $connect_cb, $prepare_cb)
-
-In even rarer cases you want total control over how AnyEvent::HTTP
-establishes connections. Normally it uses L<AnyEvent::Socket::tcp_connect>
-to do this, but you can provide your own C<tcp_connect> function -
-obviously, it has to follow the same calling conventions, except that it
-may always return a connection guard object.
-
-There are probably lots of weird uses for this function, starting from
-tracing the hosts C<http_request> actually tries to connect, to (inexact
-but fast) host => IP address caching or even socks protocol support.
-
-=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).
-
-It has to return either true (in which case AnyEvent::HTTP will continue),
-or false, in which case AnyEvent::HTTP will cancel the download (and call
-the finish callback with an error code of C<598>).
-
-This callback is useful, among other things, to quickly reject unwanted
-content, which, if it is supposed to be rare, can be faster than first
-doing a C<HEAD> request.
-
-The downside is that cancelling the request makes it impossible to re-use
-the connection. Also, the C<on_header> callback will not receive any
-trailer (headers sent after the response body).
-
-Example: cancel the request unless the content-type is "text/html".
-
-   on_header => sub {
-      $_[0]{"content-type"} =~ /^text\/html\s*(?:;|$)/
-   },
-
-=item on_body => $callback->($partial_body, $headers)
-
-When specified, all body data will be passed to this callback instead of
-to the completion callback. The completion callback will get the empty
-string instead of the body data.
-
-It has to return either true (in which case AnyEvent::HTTP will continue),
-or false, in which case AnyEvent::HTTP will cancel the download (and call
-the completion callback with an error code of C<598>).
-
-The downside to cancelling the request is that it makes it impossible to
-re-use the connection.
-
-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>, 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
-downloading the body (if any), the completion callback will be
-called. Instead of the C<$body> argument containing the body data, the
-callback will receive the L<AnyEvent::Handle> object associated with the
-connection. In error cases, C<undef> will be passed. When there is no body
-(e.g. status C<304>), the empty string will be passed.
-
-The handle object might or might not be in TLS mode, might be connected
-to a proxy, be a persistent connection, use chunked transfer encoding
-etc., and configured in unspecified ways. The user is responsible for this
-handle (it will not be used by this module anymore).
-
-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.
-
-=item persistent => $boolean
-
-Try to create/reuse a persistent connection. When this flag is set
-(default: true for idempotent requests, false for all others), then
-C<http_request> tries to re-use an existing (previously-created)
-persistent connection to the host and, failing that, tries to create a new
-one.
-
-Requests failing in certain ways will be automatically retried once, which
-is dangerous for non-idempotent requests, which is why it defaults to off
-for them. The reason for this is because the bozos who designed HTTP/1.1
-made it impossible to distinguish between a fatal error and a normal
-connection timeout, so you never know whether there was a problem with
-your request or not.
-
-When reusing an existent connection, many parameters (such as TLS context)
-will be ignored. See the C<session> parameter for a workaround.
-
-=item keepalive => $boolean
-
-Only used when C<persistent> is also true. This parameter decides whether
-C<http_request> tries to handshake a HTTP/1.0-style keep-alive connection
-(as opposed to only a HTTP/1.1 persistent connection).
-
-The default is true, except when using a proxy, in which case it defaults
-to false, as HTTP/1.0 proxies cannot support this in a meaningful way.
-
-=item handle_params => { key => value ... }
-
-The key-value pairs in this hash will be passed to any L<AnyEvent::Handle>
-constructor that is called - not all requests will create a handle, and
-sometimes more than one is created, so this parameter is only good for
-setting hints.
-
-Example: set the maximum read size to 4096, to potentially conserve memory
-at the cost of speed.
-
-   handle_params => {
-      max_read_size => 4096,
-   },
-
-=back
-
-Example: do a simple HTTP GET request for http://www.nethype.de/ and print
-the response body.
-
-   http_request GET => "http://www.nethype.de/", sub {
-      my ($body, $hdr) = @_;
-      print "$body\n";
-   };
-
-Example: do a HTTP HEAD request on https://www.google.com/, use a
-timeout of 30 seconds.
-
-   http_request
-      HEAD    => "https://www.google.com",
-      headers => { "user-agent" => "MySearchClient 1.0" },
-      timeout => 30,
-      sub {
-         my ($body, $hdr) = @_;
-         use Data::Dumper;
-         print Dumper $hdr;
-      }
-   ;
-
-Example: do 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
-
-#############################################################################
-# wait queue/slots
-
-sub _slot_schedule;
-sub _slot_schedule($) {
-   my $host = shift;
-
-   while ($CO_SLOT{$host}[0] < $MAX_PER_HOST) {
-      if (my $cb = shift @{ $CO_SLOT{$host}[1] }) {
-         # somebody wants that slot
-         ++$CO_SLOT{$host}[0];
-         ++$ACTIVE;
-
-         $cb->(AnyEvent::Util::guard {
-            --$ACTIVE;
-            --$CO_SLOT{$host}[0];
-            _slot_schedule $host;
-         });
-      } else {
-         # nobody wants the slot, maybe we can forget about it
-         delete $CO_SLOT{$host} unless $CO_SLOT{$host}[0];
-         last;
-      }
-   }
-}
-
-# wait for a free slot on host, call callback
-sub _get_slot($$) {
-   push @{ $CO_SLOT{$_[0]}[1] }, $_[1];
-
-   _slot_schedule $_[0];
-}
-
-#############################################################################
-# cookie handling
-
-# expire cookies
-sub cookie_jar_expire($;$) {
-   my ($jar, $session_end) = @_;
-
-   %$jar = () if $jar->{version} != 1;
-
-   my $anow = AE::now;
-
-   while (my ($chost, $paths) = each %$jar) {
-      next unless ref $paths;
-
-      while (my ($cpath, $cookies) = each %$paths) {
-         while (my ($cookie, $kv) = each %$cookies) {
-            if (exists $kv->{_expires}) {
-               delete $cookies->{$cookie}
-                  if $anow > $kv->{_expires};
-            } elsif ($session_end) {
-               delete $cookies->{$cookie};
-            }
-         }
-
-         delete $paths->{$cpath}
-            unless %$cookies;
-      }
-
-      delete $jar->{$chost}
-         unless %$paths;
-   }
-}
- 
-# extract cookies from jar
-sub cookie_jar_extract($$$$) {
-   my ($jar, $scheme, $host, $path) = @_;
-
-   %$jar = () if $jar->{version} != 1;
-
-   my @cookies;
-
-   while (my ($chost, $paths) = each %$jar) {
-      next unless ref $paths;
-
-      if ($chost =~ /^\./) {
-         next unless $chost eq substr $host, -length $chost;
-      } elsif ($chost =~ /\./) {
-         next unless $chost eq $host;
-      } else {
-         next;
-      }
-
-      while (my ($cpath, $cookies) = each %$paths) {
-         next unless $cpath eq substr $path, 0, length $cpath;
-
-         while (my ($cookie, $kv) = each %$cookies) {
-            next if $scheme ne "https" && exists $kv->{secure};
-
-            if (exists $kv->{_expires} and AE::now > $kv->{_expires}) {
-               delete $cookies->{$cookie};
-               next;
-            }
-
-            my $value = $kv->{value};
-
-            if ($value =~ /[=;,[:space:]]/) {
-               $value =~ s/([\\"])/\\$1/g;
-               $value = "\"$value\"";
-            }
-
-            push @cookies, "$cookie=$value";
-         }
-      }
-   }
-
-   \@cookies
-}
- 
-# parse set_cookie header into jar
-sub cookie_jar_set_cookie($$$$) {
-   my ($jar, $set_cookie, $host, $date) = @_;
-
-   my $anow = int AE::now;
-   my $snow; # server-now
-
-   for ($set_cookie) {
-      # parse NAME=VALUE
-      my @kv;
-
-      # expires is not http-compliant in the original cookie-spec,
-      # we support the official date format and some extensions
-      while (
-         m{
-            \G\s*
-            (?:
-               expires \s*=\s* ([A-Z][a-z][a-z]+,\ [^,;]+)
-               | ([^=;,[:space:]]+) (?: \s*=\s* (?: "((?:[^\\"]+|\\.)*)" | ([^;,[:space:]]*) ) )?
-            )
-         }gcxsi
-      ) {
-         my $name = $2;
-         my $value = $4;
-
-         if (defined $1) {
-            # expires
-            $name  = "expires";
-            $value = $1;
-         } elsif (defined $3) {
-            # quoted
-            $value = $3;
-            $value =~ s/\\(.)/$1/gs;
-         }
-
-         push @kv, @kv ? lc $name : $name, $value;
-
-         last unless /\G\s*;/gc;
-      }
-
-      last unless @kv;
-
-      my $name = shift @kv;
-      my %kv = (value => shift @kv, @kv);
-
-      if (exists $kv{"max-age"}) {
-         $kv{_expires} = $anow + delete $kv{"max-age"};
-      } elsif (exists $kv{expires}) {
-         $snow ||= parse_date ($date) || $anow;
-         $kv{_expires} = $anow + (parse_date (delete $kv{expires}) - $snow);
-      } else {
-         delete $kv{_expires};
-      }
-
-      my $cdom;
-      my $cpath = (delete $kv{path}) || "/";
-
-      if (exists $kv{domain}) {
-         $cdom = delete $kv{domain};
-
-         $cdom =~ s/^\.?/./; # make sure it starts with a "."
-
-         next if $cdom =~ /\.$/;
-
-         # this is not rfc-like and not netscape-like. go figure.
-         my $ndots = $cdom =~ y/.//;
-         next if $ndots < ($cdom =~ /\.[^.][^.]\.[^.][^.]$/ ? 3 : 2);
-      } else {
-         $cdom = $host;
-      }
-
-      # store it
-      $jar->{version} = 1;
-      $jar->{lc $cdom}{$cpath}{$name} = \%kv;
-
-      redo if /\G\s*,/gc;
-   }
-}
-
-#############################################################################
-# keepalive/persistent connection cache
-
-# fetch a connection from the keepalive cache
-sub ka_fetch($) {
-   my $ka_key = shift;
-
-   my $hdl = pop @{ $KA_CACHE{$ka_key} }; # currently we reuse the MOST RECENTLY USED connection
-   delete $KA_CACHE{$ka_key}
-      unless @{ $KA_CACHE{$ka_key} };
-
-   $hdl
-}
-
-sub ka_store($$) {
-   my ($ka_key, $hdl) = @_;
-
-   my $kaa = $KA_CACHE{$ka_key} ||= [];
-
-   my $destroy = sub {
-      my @ka = grep $_ != $hdl, @{ $KA_CACHE{$ka_key} };
-
-      $hdl->destroy;
-
-      @ka
-         ? $KA_CACHE{$ka_key} = \@ka
-         : delete $KA_CACHE{$ka_key};
-   };
-
-   # on error etc., destroy
-   $hdl->on_error ($destroy);
-   $hdl->on_eof   ($destroy);
-   $hdl->on_read  ($destroy);
-   $hdl->timeout  ($PERSISTENT_TIMEOUT);
-
-   push @$kaa, $hdl;
-   shift @$kaa while @$kaa > $MAX_PER_HOST;
-}
-
-#############################################################################
-# utilities
-
-# continue to parse $_ for headers and place them into the arg
-sub _parse_hdr() {
-   my %hdr;
-
-   # things seen, not parsed:
-   # p3pP="NON CUR OTPi OUR NOR UNI"
-
-   $hdr{lc $1} .= ",$2"
-      while /\G
-            ([^:\000-\037]*):
-            [\011\040]*
-            ((?: [^\012]+ | \012[\011\040] )*)
-            \012
-         /gxc;
-
-   /\G$/
-     or return;
-
-   # remove the "," prefix we added to all headers above
-   substr $_, 0, 1, ""
-      for values %hdr;
-
-   \%hdr
-}
-
-#############################################################################
-# http_get
-
-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" };
-
-# maybe it should just become a normal object :/
-
-sub _destroy_state(\%) {
-   my ($state) = @_;
-
-   $state->{handle}->destroy if $state->{handle};
-   %$state = ();
-}
-
-sub _error(\%$$) {
-   my ($state, $cb, $hdr) = @_;
-
-   &_destroy_state ($state);
-
-   $cb->(undef, $hdr);
-   ()
-}
-
-sub http_request($$@) {
-   my $cb = pop;
-   my ($method, $url, %arg) = @_;
-
-   my %hdr;
-
-   $arg{tls_ctx} = $TLS_CTX_LOW  if $arg{tls_ctx} eq "low" || !exists $arg{tls_ctx};
-   $arg{tls_ctx} = $TLS_CTX_HIGH if $arg{tls_ctx} eq "high";
-
-   $method = uc $method;
-
-   if (my $hdr = $arg{headers}) {
-      while (my ($k, $v) = each %$hdr) {
-         $hdr{lc $k} = $v;
-      }
-   }
-
-   # pseudo headers for all subsequent responses
-   my @pseudo = (URL => $url);
-   push @pseudo, Redirect => delete $arg{Redirect} if exists $arg{Redirect};
-
-   my $recurse = exists $arg{recurse} ? delete $arg{recurse} : $MAX_RECURSE;
-
-   return $cb->(undef, { @pseudo, Status => 599, Reason => "Too many redirections" })
-      if $recurse < 0;
-
-   my $proxy   = exists $arg{proxy} ? $arg{proxy} : $PROXY;
-   my $timeout = $arg{timeout} || $TIMEOUT;
-
-   my ($uscheme, $uauthority, $upath, $query, undef) = # ignore fragment
-      $url =~ m|^([^:]+):(?://([^/?#]*))?([^?#]*)(?:(\?[^#]*))?(?:#(.*))?$|;
-
-   $uscheme = lc $uscheme;
-
-   my $uport = $uscheme eq "http"  ?  80
-             : $uscheme eq "https" ? 443
-             : return $cb->(undef, { @pseudo, Status => 599, Reason => "Only http and https URL schemes supported" });
-
-   $uauthority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x
-      or return $cb->(undef, { @pseudo, Status => 599, Reason => "Unparsable URL" });
-
-   my $uhost = lc $1;
-   $uport = $2 if defined $2;
-
-   $hdr{host} = defined $2 ? "$uhost:$2" : "$uhost"
-      unless exists $hdr{host};
-
-   $uhost =~ s/^\[(.*)\]$/$1/;
-   $upath .= $query if length $query;
-
-   $upath =~ s%^/?%/%;
-
-   # cookie processing
-   if (my $jar = $arg{cookie_jar}) {
-      my $cookies = cookie_jar_extract $jar, $uscheme, $uhost, $upath;
-
-      $hdr{cookie} = join "; ", @$cookies
-         if @$cookies;
-   }
-
-   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";
-
-      $rhost   = lc $rhost;
-      $rscheme = lc $rscheme;
-   } else {
-      ($rhost, $rport, $rscheme, $rpath) = ($uhost, $uport, $uscheme, $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}
-      if length $arg{body} || $method ne "GET";
-
-   my $idempotent = $method =~ /^(?:GET|HEAD|PUT|DELETE|OPTIONS|TRACE)$/;
-
-   # default value for keepalive is true iff the request is for an idempotent method
-   my $persistent = exists $arg{persistent} ? !!$arg{persistent} : $idempotent;
-   my $keepalive  = exists $arg{keepalive}  ? !!$arg{keepalive}  : !$proxy;
-   my $was_persistent; # true if this is actually a recycled connection
-
-   # the key to use in the keepalive cache
-   my $ka_key = "$uscheme\x00$uhost\x00$uport\x00$arg{sessionid}";
-
-   $hdr{connection} = ($persistent ? $keepalive ? "keep-alive " : "" : "close ") . "Te"; #1.1
-   $hdr{te}         = "trailers" unless exists $hdr{te}; #1.1
-
-   my %state = (connect_guard => 1);
-
-   my $ae_error = 595; # connecting
-
-   # handle actual, non-tunneled, request
-   my $handle_actual_request = sub {
-      $ae_error = 596; # request phase
-
-      my $hdl = $state{handle};
-
-      $hdl->starttls ("connect") if $uscheme eq "https" && !exists $hdl->{tls};
-
-      # send request
-      $hdl->push_write (
-         "$method $rpath HTTP/1.1\015\012"
-         . (join "", map "\u$_: $hdr{$_}\015\012", grep defined $hdr{$_}, keys %hdr)
-         . "\015\012"
-         . (delete $arg{body})
-      );
-
-      # return if error occured during push_write()
-      return unless %state;
-
-      # reduce memory usage, save a kitten, also re-use it for the response headers.
-      %hdr = ();
-
-      # status line and headers
-      $state{read_response} = sub {
-         return unless %state;
-
-         for ("$_[1]") {
-            y/\015//d; # weed out any \015, as they show up in the weirdest of places.
-
-            /^HTTP\/0*([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\012]*) )? \012/gxci
-               or return _error %state, $cb, { @pseudo, Status => 599, Reason => "Invalid server response" };
-
-            # 100 Continue handling
-            # should not happen as we don't send expect: 100-continue,
-            # but we handle it just in case.
-            # since we send the request body regardless, if we get an error
-            # we are out of-sync, which we currently do NOT handle correctly.
-            return $state{handle}->push_read (line => $qr_nlnl, $state{read_response})
-               if $2 eq 100;
-
-            push @pseudo,
-               HTTPVersion => $1,
-               Status      => $2,
-               Reason      => $3,
-            ;
-
-            my $hdr = _parse_hdr
-               or return _error %state, $cb, { @pseudo, Status => 599, Reason => "Garbled response headers" };
-
-            %hdr = (%$hdr, @pseudo);
-         }
-
-         # redirect handling
-         # microsoft and other shitheads don't give a shit for following standards,
-         # try to support some common forms of broken Location headers.
-         if ($hdr{location} !~ /^(?: $ | [^:\/?\#]+ : )/x) {
-            $hdr{location} =~ s/^\.\/+//;
-
-            my $url = "$rscheme://$uhost:$uport";
-
-            unless ($hdr{location} =~ s/^\///) {
-               $url .= $upath;
-               $url =~ s/\/[^\/]*$//;
-            }
-
-            $hdr{location} = "$url/$hdr{location}";
-         }
-
-         my $redirect;
-
-         if ($recurse) {
-            my $status = $hdr{Status};
-
-            # industry standard is to redirect POST as GET for
-            # 301, 302 and 303, in contrast to HTTP/1.0 and 1.1.
-            # also, the UA should ask the user for 301 and 307 and POST,
-            # industry standard seems to be to simply follow.
-            # we go with the industry standard.
-            if ($status == 301 or $status == 302 or $status == 303) {
-               # HTTP/1.1 is unclear on how to mutate the method
-               $method = "GET" unless $method eq "HEAD";
-               $redirect = 1;
-            } elsif ($status == 307) {
-               $redirect = 1;
-            }
-         }
-
-         my $finish = sub { # ($data, $err_status, $err_reason[, $persistent])
-            if ($state{handle}) {
-               # handle keepalive
-               if (
-                  $persistent
-                  && $_[3]
-                  && ($hdr{HTTPVersion} < 1.1
-                      ? $hdr{connection} =~ /\bkeep-?alive\b/i
-                      : $hdr{connection} !~ /\bclose\b/i)
-               ) {
-                  ka_store $ka_key, delete $state{handle};
-               } else {
-                  # no keepalive, destroy the handle
-                  $state{handle}->destroy;
-               }
-            }
-
-            %state = ();
-
-            if (defined $_[1]) {
-               $hdr{OrigStatus} = $hdr{Status}; $hdr{Status} = $_[1];
-               $hdr{OrigReason} = $hdr{Reason}; $hdr{Reason} = $_[2];
-            }
-
-            # set-cookie processing
-            if ($arg{cookie_jar}) {
-               cookie_jar_set_cookie $arg{cookie_jar}, $hdr{"set-cookie"}, $uhost, $hdr{date};
-            }
-
-            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
-               $state{recurse} =
-                  http_request (
-                     $method  => $hdr{location},
-                     %arg,
-                     recurse  => $recurse - 1,
-                     Redirect => [$_[0], \%hdr],
-                     sub {
-                        %state = ();
-                        &$cb
-                     },
-                  );
-            } else {
-               $cb->($_[0], \%hdr);
-            }
-         };
-
-         $ae_error = 597; # body phase
-
-         my $chunked = $hdr{"transfer-encoding"} =~ /\bchunked\b/i; # not quite correct...
-
-         my $len = $chunked ? undef : $hdr{"content-length"};
-
-         # body handling, many different code paths
-         # - no body expected
-         # - want_body_handle
-         # - te chunked
-         # - 2x length known (with or without on_body)
-         # - 2x length not known (with or without on_body)
-         if (!$redirect && $arg{on_header} && !$arg{on_header}(\%hdr)) {
-            $finish->(undef, 598 => "Request cancelled by on_header");
-         } elsif (
-            $hdr{Status} =~ /^(?:1..|204|205|304)$/
-            or $method eq "HEAD"
-            or (defined $len && $len == 0) # == 0, not !, because "0   " is true
-         ) {
-            # no body
-            $finish->("", undef, undef, 1);
-
-         } elsif (!$redirect && $arg{want_body_handle}) {
-            $_[0]->on_eof   (undef);
-            $_[0]->on_error (undef);
-            $_[0]->on_read  (undef);
-
-            $finish->(delete $state{handle});
-
-         } elsif ($chunked) {
-            my $cl = 0;
-            my $body = "";
-            my $on_body = $arg{on_body} || sub { $body .= shift; 1 };
-
-            $state{read_chunk} = sub {
-               $_[1] =~ /^([0-9a-fA-F]+)/
-                  or return $finish->(undef, $ae_error => "Garbled chunked transfer encoding");
-
-               my $len = hex $1;
-
-               if ($len) {
-                  $cl += $len;
-
-                  $_[0]->push_read (chunk => $len, sub {
-                     $on_body->($_[1], \%hdr)
-                        or return $finish->(undef, 598 => "Request cancelled by on_body");
-
-                     $_[0]->push_read (line => sub {
-                        length $_[1]
-                           and return $finish->(undef, $ae_error => "Garbled chunked transfer encoding");
-                        $_[0]->push_read (line => $state{read_chunk});
-                     });
-                  });
-               } else {
-                  $hdr{"content-length"} ||= $cl;
-
-                  $_[0]->push_read (line => $qr_nlnl, sub {
-                     if (length $_[1]) {
-                        for ("$_[1]") {
-                           y/\015//d; # weed out any \015, as they show up in the weirdest of places.
-
-                           my $hdr = _parse_hdr
-                              or return $finish->(undef, $ae_error => "Garbled response trailers");
-
-                           %hdr = (%hdr, %$hdr);
-                        }
-                     }
-
-                     $finish->($body, undef, undef, 1);
-                  });
-               }
-            };
-
-            $_[0]->push_read (line => $state{read_chunk});
-
-         } elsif ($arg{on_body}) {
-            if (defined $len) {
-               $_[0]->on_read (sub {
-                  $len -= length $_[0]{rbuf};
-
-                  $arg{on_body}(delete $_[0]{rbuf}, \%hdr)
-                     or return $finish->(undef, 598 => "Request cancelled by on_body");
-
-                  $len > 0
-                     or $finish->("", undef, undef, 1);
-               });
-            } else {
-               $_[0]->on_eof (sub {
-                  $finish->("");
-               });
-               $_[0]->on_read (sub {
-                  $arg{on_body}(delete $_[0]{rbuf}, \%hdr)
-                     or $finish->(undef, 598 => "Request cancelled by on_body");
-               });
-            }
-         } else {
-            $_[0]->on_eof (undef);
-
-            if (defined $len) {
-               $_[0]->on_read (sub {
-                  $finish->((substr delete $_[0]{rbuf}, 0, $len, ""), undef, undef, 1)
-                     if $len <= length $_[0]{rbuf};
-               });
-            } else {
-               $_[0]->on_error (sub {
-                  ($! == Errno::EPIPE || !$!)
-                     ? $finish->(delete $_[0]{rbuf})
-                     : $finish->(undef, $ae_error => $_[2]);
-               });
-               $_[0]->on_read (sub { });
-            }
-         }
-      };
-
-      # if keepalive is enabled, then the server closing the connection
-      # before a response can happen legally - we retry on idempotent methods.
-      if ($was_persistent && $idempotent) {
-         my $old_eof = $hdl->{on_eof};
-         $hdl->{on_eof} = sub {
-            _destroy_state %state;
-
-            %state = ();
-            $state{recurse} =
-               http_request (
-                  $method => $url,
-                  %arg,
-                  keepalive => 0,
-                  sub {
-                     %state = ();
-                     &$cb
-                  }
-               );
-         };
-         $hdl->on_read (sub {
-            return unless %state;
-
-            # as soon as we receive something, a connection close
-            # once more becomes a hard error
-            $hdl->{on_eof} = $old_eof;
-            $hdl->push_read (line => $qr_nlnl, $state{read_response});
-         });
-      } else {
-         $hdl->push_read (line => $qr_nlnl, $state{read_response});
-      }
-   };
-
-   my $prepare_handle = sub {
-      my ($hdl) = $state{handle};
-
-      $hdl->on_error (sub {
-         _error %state, $cb, { @pseudo, Status => $ae_error, Reason => $_[2] };
-      });
-      $hdl->on_eof (sub {
-         _error %state, $cb, { @pseudo, Status => $ae_error, Reason => "Unexpected end-of-file" };
-      });
-      $hdl->timeout_reset;
-      $hdl->timeout ($timeout);
-   };
-
-   # connected to proxy (or origin server)
-   my $connect_cb = sub {
-      my $fh = shift
-         or return _error %state, $cb, { @pseudo, Status => $ae_error, Reason => "$!" };
-
-      return unless delete $state{connect_guard};
-
-      # get handle
-      $state{handle} = new AnyEvent::Handle
-         %{ $arg{handle_params} },
-         fh       => $fh,
-         peername => $uhost,
-         tls_ctx  => $arg{tls_ctx},
-      ;
-
-      $prepare_handle->();
-
-      #$state{handle}->starttls ("connect") if $rscheme eq "https";
-
-      # now handle proxy-CONNECT method
-      if ($proxy && $uscheme eq "https") {
-         # oh dear, we have to wrap it into a connect request
-
-         # maybe re-use $uauthority with patched port?
-         $state{handle}->push_write ("CONNECT $uhost:$uport HTTP/1.0\015\012\015\012");
-         $state{handle}->push_read (line => $qr_nlnl, sub {
-            $_[1] =~ /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\015\012]*) )?/ix
-               or return _error %state, $cb, { @pseudo, Status => 599, Reason => "Invalid proxy connect response ($_[1])" };
-
-            if ($2 == 200) {
-               $rpath = $upath;
-               $handle_actual_request->();
-            } else {
-               _error %state, $cb, { @pseudo, Status => $2, Reason => $3 };
-            }
-         });
-      } else {
-         $handle_actual_request->();
-      }
-   };
-
-   _get_slot $uhost, sub {
-      $state{slot_guard} = shift;
-
-      return unless $state{connect_guard};
-
-      # try to use an existing keepalive connection, but only if we, ourselves, plan
-      # on a keepalive request (in theory, this should be a separate config option).
-      if ($persistent && $KA_CACHE{$ka_key}) {
-         $was_persistent = 1;
-
-         $state{handle} = ka_fetch $ka_key;
-         $state{handle}->destroyed
-            and die "AnyEvent::HTTP: unexpectedly got a destructed handle (1), please report.";#d#
-         $prepare_handle->();
-         $state{handle}->destroyed
-            and die "AnyEvent::HTTP: unexpectedly got a destructed handle (2), please report.";#d#
-         $handle_actual_request->();
-
-      } else {
-         my $tcp_connect = $arg{tcp_connect}
-                           || do { require AnyEvent::Socket; \&AnyEvent::Socket::tcp_connect };
-
-         $state{connect_guard} = $tcp_connect->($rhost, $rport, $connect_cb, $arg{on_prepare} || sub { $timeout });
-      }
-   };
-
-   defined wantarray && AnyEvent::Util::guard { _destroy_state %state }
-}
-
-sub http_get($@) {
-   unshift @_, "GET";
-   &http_request
-}
-
-sub http_head($@) {
-   unshift @_, "HEAD";
-   &http_request
-}
-
-sub http_post($$@) {
-   my $url = shift;
-   unshift @_, "POST", $url, "body";
-   &http_request
-}
-
-=back
-
-=head2 DNS CACHING
-
-AnyEvent::HTTP uses the AnyEvent::Socket::tcp_connect function for
-the actual connection, which in turn uses AnyEvent::DNS to resolve
-hostnames. The latter is a simple stub resolver and does no caching
-on its own. If you want DNS caching, you currently have to provide
-your own default resolver (by storing a suitable resolver object in
-C<$AnyEvent::DNS::RESOLVER>) or your own C<tcp_connect> callback.
-
-=head2 GLOBAL FUNCTIONS AND VARIABLES
-
-=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>, croaks otherwise.
-
-To clear an already-set proxy, use C<undef>.
-
-When AnyEvent::HTTP is laoded for the first time it will query the
-default proxy from the operating system, currently by looking at
-C<$ENV{http_proxy>}.
-
-=item AnyEvent::HTTP::cookie_jar_expire $jar[, $session_end]
-
-Remove all cookies from the cookie jar that have been expired. If
-C<$session_end> is given and true, then additionally remove all session
-cookies.
-
-You should call this function (with a true C<$session_end>) before you
-save cookies to disk, and you should call this function after loading them
-again. If you have a long-running program you can additonally call this
-function from time to time.
-
-A cookie jar is initially an empty hash-reference that is managed by this
-module. It's format is subject to change, but currently it is like this:
-
-The key C<version> has to contain C<1>, otherwise the hash gets
-emptied. All other keys are hostnames or IP addresses pointing to
-hash-references. The key for these inner hash references is the
-server path for which this cookie is meant, and the values are again
-hash-references. The keys of those hash-references is the cookie name, and
-the value, you guessed it, is another hash-reference, this time with the
-key-value pairs from the cookie, except for C<expires> and C<max-age>,
-which have been replaced by a C<_expires> key that contains the cookie
-expiry timestamp.
-
-Here is an example of a cookie jar with a single cookie, so you have a
-chance of understanding the above paragraph:
-
-   {
-      version    => 1,
-      "10.0.0.1" => {
-         "/" => {
-            "mythweb_id" => {
-              _expires => 1293917923,
-              value    => "ooRung9dThee3ooyXooM1Ohm",
-            },
-         },
-      },
-   }
-
-=item $date = AnyEvent::HTTP::format_date $timestamp
-
-Takes a POSIX timestamp (seconds since the epoch) and formats it as a HTTP
-Date (RFC 2616).
-
-=item $timestamp = AnyEvent::HTTP::parse_date $date
-
-Takes a HTTP Date (RFC 2616) or a Cookie date (netscape cookie spec) or a
-bunch of minor variations of those, and returns the corresponding POSIX
-timestamp, or C<undef> if the date cannot be parsed.
-
-=item $AnyEvent::HTTP::MAX_RECURSE
-
-The default value for the C<recurse> request parameter (default: C<10>).
-
-=item $AnyEvent::HTTP::TIMEOUT
-
-The default timeout for conenction operations (default: C<300>).
-
-=item $AnyEvent::HTTP::USERAGENT
-
-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 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. Both persistent and
-non-persistent connections are counted in this limit.
-
-The default value for this is C<4>, and it is highly advisable to not
-increase it much.
-
-For comparison: the RFC's recommend 4 non-persistent or 2 persistent
-connections, older browsers used 2, newers (such as firefox 3) typically
-use 6, and Opera uses 8 because like, they have the fastest browser and
-give a shit for everybody else on the planet.
-
-=item $AnyEvent::HTTP::PERSISTENT_TIMEOUT
-
-The time after which idle persistent conenctions get closed by
-AnyEvent::HTTP (default: C<3>).
-
-=item $AnyEvent::HTTP::ACTIVE
-
-The number of active connections. This is not the number of currently
-running requests, but the number of currently open and non-idle TCP
-connections. This number can be useful for load-leveling.
-
-=back
-
-=cut
-
-our @month   = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
-our @weekday = qw(Sun Mon Tue Wed Thu Fri Sat);
-
-sub format_date($) {
-   my ($time) = @_;
-
-   # RFC 822/1123 format
-   my ($S, $M, $H, $mday, $mon, $year, $wday, $yday, undef) = gmtime $time;
-
-   sprintf "%s, %02d %s %04d %02d:%02d:%02d GMT",
-      $weekday[$wday], $mday, $month[$mon], $year + 1900,
-      $H, $M, $S;
-}
-
-sub parse_date($) {
-   my ($date) = @_;
-
-   my ($d, $m, $y, $H, $M, $S);
-
-   if ($date =~ /^[A-Z][a-z][a-z]+, ([0-9][0-9]?)[\- ]([A-Z][a-z][a-z])[\- ]([0-9][0-9][0-9][0-9]) ([0-9][0-9]?):([0-9][0-9]?):([0-9][0-9]?) GMT$/) {
-      # RFC 822/1123, required by RFC 2616 (with " ")
-      # cookie dates (with "-")
-
-      ($d, $m, $y, $H, $M, $S) = ($1, $2, $3, $4, $5, $6);
-
-   } elsif ($date =~ /^[A-Z][a-z][a-z]+, ([0-9][0-9]?)-([A-Z][a-z][a-z])-([0-9][0-9]) ([0-9][0-9]?):([0-9][0-9]?):([0-9][0-9]?) GMT$/) {
-      # RFC 850
-      ($d, $m, $y, $H, $M, $S) = ($1, $2, $3 < 69 ? $3 + 2000 : $3 + 1900, $4, $5, $6);
-
-   } elsif ($date =~ /^[A-Z][a-z][a-z]+ ([A-Z][a-z][a-z]) ([0-9 ]?[0-9]) ([0-9][0-9]?):([0-9][0-9]?):([0-9][0-9]?) ([0-9][0-9][0-9][0-9])$/) {
-      # ISO C's asctime
-      ($d, $m, $y, $H, $M, $S) = ($2, $1, $6, $3, $4, $5);
-   }
-   # other formats fail in the loop below
-
-   for (0..11) {
-      if ($m eq $month[$_]) {
-         require Time::Local;
-         return Time::Local::timegm ($S, $M, $H, $d, $_, $y);
-      }
-   }
-
-   undef
-}
-
-sub set_proxy($) {
-   if (length $_[0]) {
-      $_[0] =~ m%^(http):// ([^:/]+) (?: : (\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};
-};
-
-=head2 SHOWCASE
-
-This section contaisn some more elaborate "real-world" examples or code
-snippets.
-
-=head2 HTTP/1.1 FILE DOWNLOAD
-
-Downloading files with HTTP can be quite tricky, especially when something
-goes wrong and you want to resume.
-
-Here is a function that initiates and resumes a download. It uses the
-last modified time to check for file content changes, and works with many
-HTTP/1.0 servers as well, and usually falls back to a complete re-download
-on older servers.
-
-It calls the completion callback with either C<undef>, which means a
-nonretryable error occured, C<0> when the download was partial and should
-be retried, and C<1> if it was successful.
-
-   use AnyEvent::HTTP;
-
-   sub download($$$) {
-      my ($url, $file, $cb) = @_;
-
-      open my $fh, "+<", $file
-         or die "$file: $!";
-
-      my %hdr;
-      my $ofs = 0;
-
-      warn stat $fh;
-      warn -s _;
-      if (stat $fh and -s _) {
-         $ofs = -s _;
-         warn "-s is ", $ofs;
-         $hdr{"if-unmodified-since"} = AnyEvent::HTTP::format_date +(stat _)[9];
-         $hdr{"range"} = "bytes=$ofs-";
-      }
-
-      http_get $url,
-         headers   => \%hdr,
-         on_header => sub {
-            my ($hdr) = @_;
-
-            if ($hdr->{Status} == 200 && $ofs) {
-               # resume failed
-               truncate $fh, $ofs = 0;
-            }
-
-            sysseek $fh, $ofs, 0;
-
-            1
-         },
-         on_body   => sub {
-            my ($data, $hdr) = @_;
-
-            if ($hdr->{Status} =~ /^2/) {
-               length $data == syswrite $fh, $data
-                  or return; # abort on write errors
-            }
-
-            1
-         },
-         sub {
-            my (undef, $hdr) = @_;
-
-            my $status = $hdr->{Status};
-
-            if (my $time = AnyEvent::HTTP::parse_date $hdr->{"last-modified"}) {
-               utime $fh, $time, $time;
-            }
-
-            if ($status == 200 || $status == 206 || $status == 416) {
-               # download ok || resume ok || file already fully downloaded
-               $cb->(1, $hdr);
-
-            } elsif ($status == 412) {
-               # file has changed while resuming, delete and retry
-               unlink $file;
-               $cb->(0, $hdr);
-
-            } elsif ($status == 500 or $status == 503 or $status =~ /^59/) {
-               # retry later
-               $cb->(0, $hdr);
-
-            } else {
-               $cb->(undef, $hdr);
-            }
-         }
-      ;
-   }
-
-   download "http://server/somelargefile", "/tmp/somelargefile", sub {
-      if ($_[0]) {
-         print "OK!\n";
-      } elsif (defined $_[0]) {
-         print "please retry later\n";
-      } else {
-         print "ERROR\n";
-      }
-   };
-
-=head3 SOCKS PROXIES
-
-Socks proxies are not directly supported by AnyEvent::HTTP. You can
-compile your perl to support socks, or use an external program such as
-F<socksify> (dante) or F<tsocks> to make your program use a socks proxy
-transparently.
-
-Alternatively, for AnyEvent::HTTP only, you can use your own
-C<tcp_connect> function that does the proxy handshake - here is an example
-that works with socks4a proxies:
-
-   use Errno;
-   use AnyEvent::Util;
-   use AnyEvent::Socket;
-   use AnyEvent::Handle;
-
-   # host, port and username of/for your socks4a proxy
-   my $socks_host = "10.0.0.23";
-   my $socks_port = 9050;
-   my $socks_user = "";
-
-   sub socks4a_connect {
-      my ($host, $port, $connect_cb, $prepare_cb) = @_;
-
-      my $hdl = new AnyEvent::Handle
-         connect    => [$socks_host, $socks_port],
-         on_prepare => sub { $prepare_cb->($_[0]{fh}) },
-         on_error   => sub { $connect_cb->() },
-      ;
-
-      $hdl->push_write (pack "CCnNZ*Z*", 4, 1, $port, 1, $socks_user, $host);
-
-      $hdl->push_read (chunk => 8, sub {
-         my ($hdl, $chunk) = @_;
-         my ($status, $port, $ipn) = unpack "xCna4", $chunk;
-
-         if ($status == 0x5a) {
-            $connect_cb->($hdl->{fh}, (format_address $ipn) . ":$port");
-         } else {
-            $! = Errno::ENXIO; $connect_cb->();
-         }
-      });
-
-      $hdl
-   }
-
-Use C<socks4a_connect> instead of C<tcp_connect> when doing C<http_request>s,
-possibly after switching off other proxy types:
-
-   AnyEvent::HTTP::set_proxy undef; # usually you do not want other proxies
-
-   http_get 'http://www.google.com', tcp_connect => \&socks4a_connect, sub {
-      my ($data, $headers) = @_;
-      ...
-   };
-
-=head1 SEE ALSO
-
-L<AnyEvent>.
-
-=head1 AUTHOR
-
-   Marc Lehmann <schmorp@schmorp.de>
-   http://home.schmorp.de/
-
-With many thanks to Дмитрий Шалашов, who provided countless
-testcases and bugreports.
-
-=cut
-
-1
-
Index: perl/modules/Facebook/lib/Ouch.pm
===================================================================
--- perl/modules/Facebook/lib/Ouch.pm	(revision bbd0cf162e91b3b75e5ee8670e46db64431aa63b)
+++ 	(revision )
@@ -1,448 +1,0 @@
-use strict;
-use warnings;
-package Ouch;
-BEGIN {
-  $Ouch::VERSION = '0.0401';
-}
-use Carp qw(longmess shortmess);
-use parent 'Exporter';
-use overload bool => sub {1}, q{""} => 'scalar', fallback => 1;
-
-our @EXPORT = qw(bleep ouch kiss hug barf);
-our @EXPORT_OK = qw(try throw catch catch_all caught caught_all);
-our %EXPORT_TAGS = ( traditional => [qw(try throw catch catch_all)], trytiny => [qw( throw caught caught_all )] );
-
-sub new {
-  my ($class, $code, $message, $data) = @_;
-  bless {code => $code, message => $message, data => $data, shortmess => shortmess($message), trace => longmess($message) }, $class;
-}
-
-sub try (&) {
-  my $try = shift;
-  eval { $try->() };
-  return $@;
-}
-
-sub ouch {
-  my ($code, $message, $data) = @_;
-  my $self = __PACKAGE__->new($code, $message, $data);
-  die $self;
-}
-
-sub throw {  # alias
-  ouch @_;
-}
-
-sub kiss {
-  my ($code, $e) = @_;
-  $e ||= $@;
-  if (ref $e eq 'Ouch' && $e->code eq $code) {
-    return 1;
-  }
-  return 0;
-}
-
-sub catch {
-  kiss @_;
-}
-
-sub caught {
-  kiss @_;
-}
-
-sub hug {
-  my ($e) = @_;
-  $e ||= $@;
-  return $@ ? 1 : 0;
-}
-
-sub catch_all {
-  hug @_;
-}
-
-sub caught_all {
-  hug @_;
-}
-
-sub bleep {
-  my ($e) = @_;
-  $e ||= $@;
-  if (ref $e eq 'Ouch') {
-    return $e->message;
-  }
-  else {
-    my $message = $@;
-    if ($message =~ m{^(.*)\s+at\s.*line\s\d+.}xms) {
-        return $1;
-    }
-    else {
-        return $message;
-    }
-  }
-}
-
-sub barf {
-    my ($e) = @_;
-    my $code;
-    $e ||= $@;
-    if (ref $e eq 'Ouch') {
-        $code = $e->code;
-    } 
-    else {
-        $code = 1;
-    }
-
-    print STDERR bleep($e)."\n";
-    exit $code;
-}
-
-sub scalar {
-  my $self = shift;
-  return $self->{shortmess};
-}
-
-sub trace {
-  my $self = shift;
-  return $self->{trace};
-}
-
-sub hashref {
-  my $self = shift;
-  return {
-    code    => $self->{code},
-    message => $self->{message},
-    data    => $self->{data},
-  };
-}
-
-sub code {
-  my $self = shift;
-  return $self->{code};
-}
-
-sub message {
-  my $self = shift;
-  return $self->{message};
-}
-
-sub data {
-  my $self = shift;
-  return $self->{data};
-}
-
-=head1 NAME
-
-Ouch - Exceptions that don't hurt.
-
-=head1 VERSION
-
-version 0.0401
-
-=head1 SYNOPSIS
-
- use Ouch;
-
- eval { ouch(404, 'File not found.'); };
-
- if (kiss 404) {
-   check_elsewhere();
- }
-
- say $@;           # These two lines do the
- say $@->scalar;   # same thing.
-
-=head1 DESCRIPTION
-
-Ouch provides a class for exception handling that doesn't require a lot of boilerplate, nor any up front definition. If L<Exception::Class>
-is working for you, great! But if you want something that is faster, easier to use, requires less typing, and has no prereqs, but still gives 
-you much of that same functionality, then Ouch is for you.
-
-=head2 Why another exception handling module?
-
-It really comes down to L<Carp> isn't enough for me, and L<Exception::Class> does what I want but makes me type way too much. Also, I tend to work on a lot of protocol-based systems that use error codes (HTTP, FTP, SMTP, JSON-RPC) rather than error classes, so that feels more natural to me. Consider the difference between these:
-
-B<Ouch>
-
- use Ouch;
- ouch 404, 'File not found.', 'file';
-
-B<Exception::Class>
-
- use Exception::Class (
-    'FileNotFound' => {
-        fields  => [ 'code', 'field' ],
-    },
- );
- FileNotFound->throw( error => 'File not found.', code => 404, field => 'file' );
-
-And if you want to catch the exception you're looking at:
-
-B<Ouch>
-
- if (kiss 404) {
-   # do something
- }
-
-B<Exception::Class>
-
- my $e;
- if ($e = Exception::Class->caught('FileNotFound')) {
-   # do something
- }
-
-Those differences may not seem like a lot, but over any substantial program with lots of exceptions it can become a big deal. 
-
-=head2 Usage
-
-Most of the time, all you need to do is:
-
- ouch $code, $message, $data;
- ouch -32700, 'Parse error.', $request; # JSON-RPC 2.0 error
- ouch 441, 'You need to specify an email address.', 'email'; # form processing error
- ouch 'missing_param', 'You need to specify an email address.', 'email';
-
-You can also go long form if you prefer:
-
- die Ouch->new($code, $message, $data);
-
-=head2 Functional Interface
-
-=head3 ouch
-
-Some nice sugar instead of using the object oriented interface.
-
- ouch 2121, 'Did not do the big thing.';
-
-=over
-
-=item code
-
-An error code. An integer or string representing error type. Try to stick to codes used in whatever domain you happen to be working in. HTTP Status codes. JSON-RPC error codes, etc.
-
-=item message
-
-A human readable error message.
-
-=item data
-
-Optional. Anything you want to attach to the exception to help a developer catching it decide what to do. For example, if you're doing form processing, you might want this to be the name of the field that caused the exception. 
-
-B<WARNING:> Do not include objects or code refs in your data. This should only be stuff that is easily serializable like scalars, array refs, and hash refs.
-
-=back
-
-=head3 kiss
-
-Some nice sugar to trap an Ouch.
-
- if (kiss $code) {
-    # make it go
- }
-
-=over
-
-=item code
-
-The code you're looking for.
-
-=item exception
-
-Optional. If you like you can pass the exception into C<kiss>. If not, it will just use whatever is in C<$@>. You might want to do this if you've saved the exception before running another C<eval>, for example.
-
-=back
-
-
-=head3 hug
-
-Some nice sugar to trap any exception.
-
- if (hug) {
-   # make it stop
- }
-
-=over 
-
-=item exception
-
-Optional. If you like you can pass the exception into C<hug>. If not, it will just use whatever is in C<$@>.
-
-=back
-
-
-=head3 bleep 
-
-A little sugar to make exceptions human friendly. Returns a clean error message from any exception, including an Ouch.
-
- File not found.
-
-Rather than:
-
- File not found. at /Some/File.pm line 63.
-
-=over
-
-=item exception
-
-Optional. If you like you can pass the exception into C<bleep>. If not, it will just use whatever is in C<$@>.
-
-=back
-
-=head3
-
-Calls C<bleep>, and then exits with error code
-
-=over
-
-=item exception
-
-Optional. You can pass an exception into C<barf> which then gets passed to C<bleep> otherwise it will use whatever's in C<$@>
-
-=back
-
-
-=head2 Object-Oriented Interface
-
-=head3 new
-
-Constructor for the object-oriented interface. Takes the same parameters as C<ouch>.
-
- Ouch->new($code, $message, $data);
-
-=head3 scalar
-
-Returns the scalar form of the error message:
-
- Crap! at /Some/File.pm line 43.
-
-Just as if you had done:
-
- die 'Crap!';
-
-Rather than:
-
- ouch $code, 'Crap!'; 
-
-=head3 trace
-
-Call this if you want the full stack trace that lead up to the ouch.
-
-=head3 hashref
-
-Returns a formatted hash reference of the exception, which can be useful for handing off to a serializer like L<JSON>.
-
- {
-   code     => $code,
-   message  => $message,
-   data     => $data,
- }
-
-=head3 code
-
-Returns the C<code> passed into the constructor.
-
-=head3 message
-
-Returns the C<messsage> passed into the constructor.
-
-=head3 data
-
-Returns the C<data> passed into the constructor.
-
-=head2 Traditional Interface
-
-Some people just can't bring themselves to use the sugary cuteness of Ouch. For them there is the C<:traditional> interface. Here's how it works:
-
- use Ouch qw(:traditional);
-
- my $e = try {
-   throw 404, 'File not found.';
- };
-
- if ( catch 404, $e ) {
-   # do the big thing
- }
- elsif ( catch_all $e ) {
-   # make it stop
- }
- else {
-   # make it go
- }
-
-B<NOTE:> C<try> also populates C<$@>, and C<catch> and C<catch_all> will also use C<$@> if you don't specify an exception.
-
-=head3 try
-
-Returns an exception. Is basically just a nice wrapper around C<eval>.
-
-=over
-
-=item block
-
-Try accepts a code ref, anonymous subroutine, or a block. 
-
-B<NOTE:> You need a semi-colon at the end of a C<try> block.
-
-=back
-
-=head3 throw
-
-Works exactly like C<ouch>. See C<ouch> for details.
-
-=head3 catch
-
-Works exactly like C<kiss>. See C<kiss> for details.
-
-=head3 catch_all
-
-Works exactly like C<hug>. See C<hug> for details.
-
-=head2 Try::Tiny
-
-Many Ouch users, like to use Ouch with L<Try::Tiny>, and some of them are sticks in the mud who can't bring themselves to C<ouch> and C<kiss>, and don't like that C<:traditional> walks all over C<try> and C<catch> For them, there is the C<:trytiny> interface. Here's how it works:
-
- use Try::Tiny;
- use Ouch qw(:trytiny);
-
- try {
-    throw(404, 'File not found!';
- }
- catch {
-    if (caught($_)) {
-        # do something
-    }
-    else {
-        throw($_); # rethrow
-    }
- };
-
-
-=head1 SUPPORT
-
-=over
-
-=item Repository
-
-L<http://github.com/rizen/Ouch>
-
-=item Bug Reports
-
-L<http://github.com/rizen/Ouch/issues>
-
-=back
-
-
-=head1 SEE ALSO
-
-If you're looking for something lighter, check out L<Carp> that ships with Perl. Or if you're looking for something heavier check out L<Exception::Class>.
-
-=head1 AUTHOR
-
-JT Smith <jt_at_plainblack_dot_com>
-
-=head1 LEGAL
-
-Ouch is Copyright 2011 Plain Black Corporation (L<http://www.plainblack.com>) and is licensed under the same terms as Perl itself.
-
-=cut
-
-1;
Index: perl/modules/Facebook/lib/URI/Encode.pm
===================================================================
--- perl/modules/Facebook/lib/URI/Encode.pm	(revision bbd0cf162e91b3b75e5ee8670e46db64431aa63b)
+++ 	(revision )
@@ -1,230 +1,0 @@
-package URI::Encode;
-
-use 5.008001;
-use warnings;
-use strict;
-use Carp;
-use Encode qw();
-
-our $VERSION = 0.03;
-
-## Exporter
-use base qw(Exporter);
-our @EXPORT_OK = qw(uri_encode uri_decode);
-
-## OOP Intrerface
-
-# Constructor
-sub new {
-    my $class = shift;
-    my $self = bless {}, $class;
-    return $self;
-}
-
-# Encode
-sub encode {
-    my ( $self, $url, $encode_reserved ) = @_;
-    return unless $url;
-
-    # Encode URL into UTF-8
-    $url = Encode::encode( 'utf-8-strict', $url );
-
-    # Create character map
-    my %map = map { chr($_) => sprintf( "%%%02X", $_ ) } ( 0 ... 255 );
-
-    # Create Regex
-    my $reserved =
-      qr{([^a-zA-Z0-9\-\_\.\~\!\*\'\(\)\;\:\@\&\=\+\$\,\/\?\%\#\[\]])}x;
-    my $unreserved = qr{([^a-zA-Z0-9\Q-_.~\E])}x;
-
-    # Percent Encode URL
-    if ($encode_reserved) {
-        $url =~ s/$unreserved/$map{$1}/gx;
-    }
-    else {
-        $url =~ s/$reserved/$map{$1}/gx;
-    }
-
-    return $url;
-}
-
-# Decode
-sub decode {
-    my ( $shift, $url ) = @_;
-    return unless $url;
-
-    # Character map
-    my %map = map { sprintf( "%02X", $_ ) => chr($_) } ( 0 ... 255 );
-
-    # Decode percent encoding
-    $url =~ s/%([a-fA-F0-9]{2})/$map{$1}/gx;
-    return $url;
-}
-
-## Traditional Interface
-
-# Encode
-sub uri_encode {
-    my ( $url, $flag ) = @_;
-    my $uri = URI::Encode->new();
-    return $uri->encode( $url, $flag );
-}
-
-# Decode
-sub uri_decode {
-    my ($url) = @_;
-    my $uri = URI::Encode->new();
-    return $uri->decode($url);
-}
-
-## Done
-1;
-__END__
-
-=pod
-
-=head1 NAME
-
-URI::Encode - Simple URI Encoding/Decoding
-
-=head1 VERSION
-
-This document describes URI::Encode version 0.03
-
-=head1 SYNOPSIS
-
-	## OO Interface
-	use URI::Encode;
-	my $uri = URI::Encode->new();
-	my $encoded = $uri->encode($url);
-	my $decoded = $uri->decode($encoded);
-
-	## Using exported functions
-	use URI::Encode qw(uri_encode uri_decode);
-	my $encoded = uri_encode($url);
-	my $decoded = uri_decode($url);
-
-=head1 DESCRIPTION
-
-This modules provides simple URI (Percent) encoding/decoding. This module
-borrows from L<URI::Escape>, but 'tinier'
-
-=head1 METHODS
-
-=head2 new()
-
-Creates a new object, no argumetns are required
-
-	my $encoder = URI::Encode->new();
-
-=head2 encode($url, $including_reserved)
-
-This method encodes the URL provided. The method does not encode any
-L</"Reserved Characters"> unless C<$including_reserved> is true. The $url
-provided is first converted into UTF-8 before percent encoding.
-
-	$uri->encode("http://perl.com/foo bar");      # http://perl.com/foo%20bar
-	$uri->encode("http://perl.com/foo bar", 1);   # http%3A%2F%2Fperl.com%2Ffoo%20bar
-
-=head2 decode($url)
-
-This method decodes a 'percent' encoded URL. If you had encoded the URL using
-this module (or any other method), chances are that the URL was converted to
-UTF-8 before 'percent' encoding. Be sure to check the format and convert back
-if required.
-
-	$uri->decode("http%3A%2F%2Fperl.com%2Ffoo%20bar"); # "http://perl.com/foo bar"
-
-=head1 EXPORTED FUNCTIONS
-
-The following functions are exported upon request. This provides a non-OOP
-interface
-
-=head2 uri_encode($url, $including_reserved)
-
-See L</encode($url, $including_reserved)>
-
-=head2 uri_decode($url)
-
-See L</decode($url)>
-
-=head1 CHARACTER CLASSES
-
-=head2 Reserved Characters
-
-The following characters are considered as reserved (L<RFC
-3986|http://tools.ietf.org/html/rfc3986>). They will be encoded only if requested.
-
-	 ! * ' ( ) ; : @ & = + $ , / ? % # [ ]
-
-=head2 Unreserved Characters
-
-The following characters are considered as Unreserved. They will not be encoded
-
-	a-z
-	A-Z
-	0-9
-	- _ . ~
-
-=head1 DEPENDENCIES
-
-L<Encode>
-
-=head1 ACKNOWLEDGEMENTS
-
-Gisle Aas for L<URI::Escape>
-
-David Nicol for L<Tie::UrlEncoder>
-
-=head1 SEE ALSO
-
-L<RFC 3986|http://tools.ietf.org/html/rfc3986>
-
-L<URI::Escape>
-
-L<URI::Escape::XS>
-
-L<URI::Escape::JavaScript>
-
-L<Tie::UrlEncoder>
-
-=head1 BUGS AND LIMITATIONS
-
-No bugs have been reported.
-
-Please report any bugs or feature requests to C<bug-uri-encode@rt.cpan.org>, or
-through the web interface at L<http://rt.cpan.org>.
-
-=head1 AUTHOR
-
-Mithun Ayachit  C<< <mithun@cpan.org> >>
-
-=head1 LICENCE AND COPYRIGHT
-
-Copyright (c) 2010, Mithun Ayachit C<< <mithun@cpan.org> >>. All rights
-reserved.
-
-This module is free software; you can redistribute it and/or modify it under
-the same terms as Perl itself. See L<perlartistic>.
-
-=head1 DISCLAIMER OF WARRANTY
-
-BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE
-SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE
-STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE
-SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED,
-INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
-FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND
-PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE,
-YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION.
-
-IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY
-COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE
-SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR DAMAGES,
-INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING
-OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO
-LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR
-THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE),
-EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
-DAMAGES.
-
