view release on metacpan or  search on metacpan

lib/LWP/Parallel/UserAgent.pm  view on Meta::CPAN

      size	=> $size, 
      content_size => 0,
      redirect_ok => $self->{'handle_response'},
    } );
    # if the user specified 
    $entry->redirect_ok($redirect) if defined $redirect;
    
    # store new entry by request (only new entries)
    $self->{'entries_by_requests'}->{$request} = $entry;
    
    # new requests are put at the end
    #  (first make sure we have an array to push things onto)
    $self->{'pending_connections'}->{$netloc} = []
      unless $self->{'pending_connections'}->{$netloc};
    push (@{$self->{'pending_connections'}->{$netloc}}, $entry);
    push (@{$self->{'ordpend_connections'}}, $entry);
  }
  # duplicates handling: remember this entry
  if ($handle_duplicates) {
    $previous_requests->{$request->url->as_string} = $entry;
  }
  
  return;
}

# Create a netloc from the url or return an alias netloc for file: proto
# Fix netloc for file: reqs to generic localhost.file - this can be changed
# if necessary.  Test to ensure url->scheme doesn't return undef (JB)
sub _netloc {
    my $self = shift;
    my $url = shift;

    my $netloc;
    if ($url->scheme eq 'file') {
      $netloc = 'localhost.file';
    } else {
      $netloc = $url->host_port; # eg www.cs.washington.edu:8001
    }
    $netloc;
}


# this method will take the pending entries one at a time and
# decide wether we have enough bandwith (as specified by the
# values in 'max_req' and 'max_hosts') to connect this request.
# If not, the entry will stay on the stack (w/o changing the
# order)
sub _make_connections {
  my $self = shift;
  if ($self->{'handle_in_order'}) {
    $self->_make_connections_in_order;
  } else {
    $self->_make_connections_unordered;
  }
}

sub _make_connections_in_order {
  my $self = shift;
  LWP::Debug::trace('()');
  
  my ($entry, @queue, %busy);
  # get first entry from pending connections
  while ( $entry = shift @{ $self->{'ordpend_connections'} } ) {
    my $netloc = $self->_netloc($entry->request->url);
    push (@queue, $entry), next  if $busy{$netloc};
    unless ($self->_check_bandwith($entry)) {
      push (@queue, $entry);
      $busy{$netloc}++;
    };
  };
  # the un-connected entries form the new stack
  $self->{'ordpend_connections'} = \@queue;
}

# unordered connections have the advantage that we do not have to 
# care about screwing up our list of pending connections. This will
# speed up our iteration through the list
sub _make_connections_unordered {
  my $self = shift;
  LWP::Debug::trace('()');
  
  my ($entry, $queue, $netloc);
  # check every host in sequence (use 'each' for better performance)
  my %delete;
 SERVER:
  while (($netloc, $queue) = each %{$self->{'pending_connections'}}) {
    # get first entry from pending connections at this host
  ENTRY:
    while ( $entry = shift @$queue ) {
      unless ( $self->_check_bandwith($entry) ) {
	# we don't have enough bandwith -- put entry back on queue
	LWP::Debug::debug("Not enough bandwidth for request to $netloc");
	unshift @$queue, $entry;
	# we can stop here for this server
	next SERVER;
      }
    } # of while ENTRY
    # mark for deletion if we emptied the queue at this location
  LWP::Debug::debug("Queue for $netloc contains ". scalar @$queue . " pending connections");
    $delete{$netloc}++ unless scalar @$queue;
  } # of while SERVER
  # delete all netlocs that we completely handled
  foreach (keys %delete) { 
    LWP::Debug::debug("Deleting queue for $_");
      delete $self->{'pending_connections'}->{$_} 
  }
}

	
# this method checks the available bandwith and either connects
# the request and returns 1, or, in case we didn't have enough
# bandwith, returns undef
sub _check_bandwith {
    my ( $self, $entry ) = @_;
    LWP::Debug::trace("($entry [".$entry->request->url."] )");

    my($failed_connections, $remember_failures ) =
      @{$self}{qw(failed_connections remember_failures)};
    
    my ($request, $response) = ($entry->request, $entry->response);
    my $url  = $request->url;
    my $netloc = $self->_netloc($url);

    if ( $remember_failures and $failed_connections->{$netloc} ) {
	$response->code (&HTTP::Status::RC_INTERNAL_SERVER_ERROR);
	$response->message ("Server unavailable");
	# simulate immediate response from server
	$self->on_failure ($request, $response, $entry);