view release on metacpan or  search on metacpan

HTTP.pm  view on Meta::CPAN

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);
   ()
}

our %IDEMPOTENT = (
   DELETE		=> 1,
   GET			=> 1,
   HEAD			=> 1,
   OPTIONS		=> 1,
   PUT			=> 1,
   TRACE		=> 1,

   ACL			=> 1,
   "BASELINE-CONTROL"	=> 1,
   BIND			=> 1,
   CHECKIN		=> 1,
   CHECKOUT		=> 1,
   COPY			=> 1,
   LABEL		=> 1,
   LINK			=> 1,
   MERGE		=> 1,
   MKACTIVITY		=> 1,
   MKCALENDAR		=> 1,
   MKCOL		=> 1,
   MKREDIRECTREF	=> 1,
   MKWORKSPACE		=> 1,
   MOVE			=> 1,
   ORDERPATCH		=> 1,
   PROPFIND		=> 1,
   PROPPATCH		=> 1,
   REBIND		=> 1,
   REPORT		=> 1,
   SEARCH		=> 1,
   UNBIND		=> 1,
   UNCHECKOUT		=> 1,
   UNLINK		=> 1,
   UNLOCK		=> 1,
   UPDATE		=> 1,
   UPDATEREDIRECTREF	=> 1,
   "VERSION-CONTROL"	=> 1,
);

sub http_request($$@) {
   my $cb = pop;
   my ($method, $url, %arg) = @_;