view release on metacpan or  search on metacpan

lib/POE/Component/Curl/Multi.pm  view on Meta::CPAN

  # maybe deal with all error conditions the same way
  $kernel->refcount_increment( $sender_id, __PACKAGE__ )
        unless ref $args->{response} eq 'POE::Session::AnonEvent';
  {
    my $easy = Net::Curl::Easy->new;
    my $req = $args->{request};
    $easy->setopt(CURLOPT_URL, $req->uri);
    my $verifypeer;
    if ( defined $args->{verifypeer} ) {
      $verifypeer = $args->{verifypeer};
    }
    elsif ( defined $self->{verifypeer} ) {
      $verifypeer = $self->{verifypeer};
    }
    $easy->setopt(CURLOPT_SSL_VERIFYPEER, $verifypeer) if defined $verifypeer;
    my $verifyhost;
    if ( defined $args->{verifyhost} ) {
      $verifypeer = $args->{verifyhost};
    }
    elsif ( defined $self->{verifyhost} ) {
      $verifypeer = $self->{verifyhost};
    }
    $easy->setopt(CURLOPT_SSL_VERIFYHOST, $verifyhost) if defined $verifyhost;
    $easy->setopt(CURLOPT_DNS_CACHE_TIMEOUT, 0);
    my $ipresolve = $args->{ipresolve} || $self->{ipresolve};
    if ( $ipresolve ) {
      $easy->setopt(CURLOPT_IPRESOLVE, CURL_IPRESOLVE_V4) if $ipresolve eq '4';
      $easy->setopt(CURLOPT_IPRESOLVE, CURL_IPRESOLVE_V6) if $ipresolve eq '6';
    }
    $easy->setopt(CURLOPT_ENCODING, '');
    if ( $self->{agent} ) {
      my $agent = $self->{agent}->[ rand @{ $self->{agent} } ];
      $easy->setopt(CURLOPT_USERAGENT, $agent);
    }
    {
      my $proxy = $args->{proxy} || $self->{proxy};
      $easy->setopt(CURLOPT_PROXY, $proxy) if $proxy;
    }

    my @extra_headers;
    if (my $content = $req->content) {
        $easy->setopt(CURLOPT_POSTFIELDS, $content);
        push @extra_headers, 'Expect:';
    }

    $easy->setopt(CURLOPT_TIMEOUT, $self->{timeout});
    $easy->setopt( $methods{ $req->method }, 1 );
    $easy->setopt(CURLOPT_CUSTOMREQUEST, $req->method);
    $easy->setopt(CURLOPT_HTTPHEADER,
        [ split( m!\x0D\x0A!, $req->headers_as_string("\x0D\x0A") ), @extra_headers ]);

    $easy->setopt(CURLOPT_VERBOSE, 1) if $self->{curl_debug};

    if ( $self->{followredirects} ) {
      $easy->setopt(CURLOPT_FOLLOWLOCATION, 1);
      $easy->setopt(CURLOPT_MAXREDIRS, $self->{followredirects} );
    }
    my $id = refaddr $easy;
    my ($response, $header);
    $easy->setopt(CURLOPT_WRITEDATA, \$response);
    $easy->setopt(CURLOPT_WRITEHEADER, \$header);
    #$easy->setopt(CURLOPT_PRIVATE, $id);
    $args->{id} = $id;
    $args->{easy} = $easy;
    $args->{body} = \$response;
    $args->{header} = \$header;
    push @{ $self->{queue} }, $args;
    $self->{req_to_id}->{$req} = $id;
    if ( $args->{progress} ) {
      $easy->setopt(CURLOPT_NOPROGRESS,0);
      $easy->setopt(CURLOPT_PROGRESSFUNCTION,
        $me->callback( '_progress', $args->{sender}, $args->{progress}, $req, $args->{tag} ) );
    }
  }
  $poe_kernel->yield( '_dequeue' );
  return;
}

sub _dequeue {
  my ($kernel,$self) = @_[KERNEL,OBJECT];
  while ( $self->{max_concurrency} == 0 ||
          scalar keys %{ $self->{state} } < $self->{max_concurrency}) {
    my $dequeued = shift @{ $self->{queue} };
    last unless $dequeued;
    $self->{state}->{ refaddr($dequeued->{easy}) } = $dequeued;
    $self->{multi}->add_handle( $dequeued->{easy} );
  }
  $kernel->delay( '_perform', 0.5 );
  return;
}

sub _perform {
  my ($kernel,$self) = @_[KERNEL,OBJECT];

  $self->{multi}->perform;

  while (my ($msg, $easy, $rv) = $self->{multi}->info_read) {
    my $id = refaddr $easy;
    if ($id) {
      my $state = delete $self->{state}->{ $id };
      my $req = $state->{request};
      my $easy = $state->{easy};
      my $stats = {
         total_time => $easy->getinfo(CURLINFO_TOTAL_TIME),
         dns_time => $easy->getinfo(CURLINFO_NAMELOOKUP_TIME),
         connect_time => $easy->getinfo(CURLINFO_CONNECT_TIME),
         start_transfer_time =>
             $easy->getinfo(CURLINFO_STARTTRANSFER_TIME),
         download_bytes =>
             $easy->getinfo(CURLINFO_SIZE_DOWNLOAD),
         upload_bytes => $easy->getinfo(CURLINFO_SIZE_UPLOAD),
      };
      if ($rv) {
         $kernel->yield( '_result', $state, [ 0+$rv, $easy->error ], $stats );
      }
      else {
         my $last_header = (split(/\r?\n\r?\n/,
                               ${$state->{header}}))[-1];
         my $response = HTTP::Response->parse($last_header .
                                              "\n\n" .
                                              ( ${ $state->{body} } || '' )