view release on metacpan or  search on metacpan

lib/HTTP/MultiGet.pm  view on Meta::CPAN

  }

  $self->block_loop;
  foreach my $id (@check) {
    next unless exists $self->results->{$id};

    ++$ok;

    $results->{$id}=$self->results->{$id};
    delete $self->results->{$id};
  }

  delete @{$self->retry}{@ids};
  return $self->new_true($results) if $ok!=0;
  return $self->new_false("Request(s) timed out");
}

=item * my $class=$self->SENDER_CLASS

$class is the class used to send requests.

=cut

sub SENDER_CLASS { 'AnyEvent::HTTP::Request' }

=item * my $req=$self->create_request($req,$id)

Internal method.  Returns a new instance of $self->SENDER_CLASS for Teh given $request and $id.

=cut 

sub create_request {
  my ($self,$obj,$id)=@_;
  
  my $req;
  my $opt={
      params=>{%{$self->request_opts}},
  };
  if(is_plain_arrayref($obj)) {
    my @args;
    ($req,@args)=@{$obj};
    my $code=$self->que_function($req,$id);
    while(my ($key,$value)=splice(@args,0,2)) {
      if($key eq 'on_body') {
        my $code=sub {
	        my ($body,$headers)=@_;
	        my $header=new HTTP::Headers( %{$headers});
	        $value->($self,$req,$header,$body);
	      };
	      $opt->{params}->{$key}=$code;
      } else {
        $opt->{params}->{$key}=$value;
      }
    }
    $opt->{cb}=$code;
  } else {
    $req=$obj;
    my $code=$self->que_function($req,$id);
    $opt->{cb}=$code;
  }
  foreach my $key (qw(keepalive persistent)) {
    $opt->{params}->{$key}=0 unless exists $opt->{params}->{$key};
  }
  my $request=$self->SENDER_CLASS->new(
    $req,
    $opt,
  );

  return $request;
}

=item * my $code=$self->que_function($req,$id);

Internal method.  Creates a code refrence for use in the que process.

=cut

sub que_function {
  my ($self,$req,$id)=@_;
  my $loop_id=$self->loop_id;

  my $code;
  $code=sub {
    my $response=$self->RESPONSE_CLASS->new(@_)->to_http_message;
    $self->log_debug("Got Response for id: [$id] Status Line: ".$response->status_line);

    # work around for unit testing;
    --$self->{que_count} if $self->{que_count} > 0;

    if(exists $self->retry->{$id} and $response->code > 594 and $self->retry->{$id}-- > 0) {
      $self->log_info("Request negotiation error: ".$response->code." for id: $id retry count is: ".( 1 + $self->retry->{$id} )." will retry");
      $self->add_by_id($id=>$req);
      $self->run_next;
      return;
    }

    delete $self->retry->{$id};

    if(exists $self->running->{$id}) {
      delete $self->running->{$id};
    } else {
      $self->log_debug("$id never ran, but the cb is being used");
      $self->stack->remove($id);
    }
    
    $self->results->{$id}=$self->new_true($response);
    
    $self->run_next;
    if($self->in_control_loop) {
      if($self->que_count==0) {
        $self->loop_control->send if $self->loop_control;
      }
      undef $code;
      return;
    }

    if($self->{que_count}==0) {
      $self->log_debug('Que Count has reached 0');
      if($loop_id!=$self->loop_id) {
        $self->log_info("A result outside of it's lifecycle has arived loop_id: $loop_id que_id: $id, but we are in loop_id: ".$self->loop_id);
        undef $code;