view release on metacpan or  search on metacpan

lib/Net/Curl/Parallel.pm  view on Meta::CPAN

    # need to handle the 100 response
    push @$headers, "Expect:"
      unless grep{ $_ =~ /^Expect:/i } @$headers;
  }

  push @{$self->requests}, [$method, $uri, $headers, $content, $die];
  return $idx;
}

sub setup_curl {
  my ($self, $idx) = @_;
  my ($method, $uri, $headers, $content, $die) = @{$self->requests->[$idx]};
  # Both sides of the // can never be false because Net::Curl::Easy->new
  # will always return true.
  # uncoverable condition false
  my $curl = shift(@{$self->avail_curl_pool}) // Net::Curl::Easy->new({});

  # This is okay because the first parameter to Net::Curl::Easy->new() is the
  # base object. We can put whatever we want into here.
  $curl->{private} = {
    response => Net::Curl::Parallel::Response->new,
    idx  => $idx,
    uri  => $uri,
    die  => $die,
  };

  # Basic config and tcp setup
  $curl->setopt(CURLOPT_NOPROGRESS, 1);
  $curl->setopt(CURLOPT_TCP_NODELAY, 1);

  # Set connection timeout
  $curl->setopt(CURLOPT_CONNECTTIMEOUT_MS, $self->connect_timeout)
    if $self->connect_timeout;

  # Keep idle TCP connections alive longer. Note - this option is available
  # starting in libcurl 7.25.0
  # uncoverable branch false
  $curl->setopt(CURLOPT_TCP_KEEPALIVE, 1)
    if &CURLOPT_TCP_KEEPALIVE;

  # Set verbosity
  $curl->setopt(CURLOPT_VERBOSE, 1)
    if $self->verbose;

  # HTTP
  $curl->setopt(CURLOPT_ACCEPT_ENCODING, '');
  $curl->setopt(CURLOPT_PROTOCOLS, CURLPROTO_HTTP | CURLPROTO_HTTPS);
  $curl->setopt(CURLOPT_USERAGENT, $self->agent);
  $curl->setopt(CURLOPT_URL, $uri);

  if ($method eq 'POST') {
    $curl->setopt(CURLOPT_POST, 1);
    $curl->setopt(CURLOPT_POSTFIELDS, $content);
  }

  # Configure headers
  $curl->setopt(CURLOPT_HTTPHEADER, $headers)
    if @$headers;

  $curl->setopt(CURLOPT_WRITEDATA,   $curl->{private}{response}->fh_body);
  $curl->setopt(CURLOPT_WRITEHEADER, $curl->{private}{response}->fh_head);

  # Configure redirect behavior
  $curl->setopt(CURLOPT_FOLLOWLOCATION, $self->max_redirects > 0);
  $curl->setopt(CURLOPT_MAXREDIRS,      $self->max_redirects);
  $curl->setopt(CURLOPT_AUTOREFERER,    1);

  # Allow user override of ssl certificate verification
  $curl->setopt(CURLOPT_SSL_VERIFYPEER, $self->verify_ssl_peer);

  # Set request timeout
  $curl->setopt(CURLOPT_TIMEOUT_MS, $self->request_timeout)
    if $self->request_timeout;

  # Clean up memory a little, but leave an undef at the index in the requests
  # array since we are using the index as the key.
  $self->requests->[$idx] = undef;

  return $curl;
}

sub perform {
  my $self    = shift;
  my $total   = @{$self->requests};
  my $pending = 0;
  my $idx     = 0;

  $self->{responses} = []; # clear responses state from any prior runs
  scope_guard{ $self->{requests} = [] }; # clear state for next run

  until ($idx == $total && $pending == 0) {
    # Fill empty slots
    while ($idx < $total && $pending < $self->slots) {
      $self->curl_multi->add_handle($self->setup_curl($idx));
      ++$pending;
      ++$idx;
    }

    $self->curl_multi->wait(1);
    my $running = $self->curl_multi->perform;

    # At least one request is complete
    if ($running != $pending) {
      my ($msg, $curl, $result) = $self->curl_multi->info_read;

      # A request is complete
      if ($msg) {
        scope_guard{
          --$pending;

          $self->curl_multi->remove_handle($curl);

          delete $curl->{private};
          $curl->reset;

          # Ignore max_curls while perform() is running
          push @{$self->avail_curl_pool}, $curl;
        };

        my $ridx = $curl->{private}{idx};