view release on metacpan or  search on metacpan

Server/t/lib/Apache/AppCluster/Client.pm  view on Meta::CPAN

			my $href = {
				method => $self->{_requests}->{$index}->{method},
				params => $self->{_requests}->{$index}->{params},
				};

			my $data = freeze($href);
			my $digest = md5_hex($data);
			my $send_data = '<frozen>' . $digest . $data . '</frozen>';
			my $content_length = length($send_data);
			my $uri = $self->{_requests}->{$index}->{uri};
			my $host = $self->{_requests}->{$index}->{server};

#I'm guessing that octet-stream is the correct mime type for this sort of thing.
			print {$self->{_requests}->{$index}->{sock}} <<"EOF";
POST $uri HTTP/1.0
Accept: application/octet-stream
Accept: */*
Host: $host
Connection: close
User-Agent: Apache::AppCluster::Client v0.1
Content-Length: $content_length
Content-Type: application/octet-stream;

$send_data
EOF

			$self->{_requests}->{$index}->{sock}->flush();
		}
	}





	my $cutoff_time = Time::HiRes::time() + $timeout;

	my $sockets_pending = $connected_sockets;

	while((Time::HiRes::time() < $cutoff_time) && $sockets_pending)
	{
		my $sockets_finished = 0;
		foreach my $index (keys %{$self->{_requests}})
		{
			if($self->{_requests}->{$index}->{status} == REQ_INCOMPLETE) 
			{
				my $buf;
				my $bytes_read = sysread($self->{_requests}->{$index}->{sock}, $buf, 1024);
				if(defined($bytes_read) )
				{
					if($bytes_read == 0)
					{
						close($self->{_requests}->{$index}->{sock});
						$self->{_requests}->{$index}->{status} = REQ_SUCCESS; #finished
						$sockets_pending--;
					} else
					{
						$self->{_requests}->{$index}->{data} .= $buf;
					}
				} else #no data to read yet
				{
					if($! == EAGAIN()) #socket would have blocked
					{
						#keep going until there is more data on the socket
					} else
					{
						$self->{_requests}->{$index}->{status} = REQ_SUCCESS;
						$sockets_pending--;
					}
				}
			} 
		}
		
	}

	foreach my $index (keys %{$self->{_requests}})
	{
		if($self->{_requests}->{$index}->{status} == REQ_SUCCESS)
		{
			if($self->{_requests}->{$index}->{data} =~ m/<frozen>(.*)<\/frozen>/s)
			{
				my $input = $1;
				my $digest = substr($input, 0, 32);
				my $data = substr($input, 32);
				my $response;
				if($digest eq md5_hex($data))
				{
					$response = thaw($data);
					if($response->{status} == SRV_SUCCESS) #remote success
					{
						$self->{_requests}->{$index}->{data} = $response->{data};
						$self->{_total_success}++;
					} else
					{
						$self->{_requests}->{$index}->{data} = undef;
						$self->{_requests}->{$index}->{status} = $response->{status};
						$self->{_requests}->{$index}->{method_error} = $response->{method_error};
						$self->{_total_failed}++;
					}
				} else
				{
					warn "Digest failed." if($VERBOSE);
					$self->{_requests}->{$index}->{data} = undef;
					$self->{_requests}->{$index}->{status} = REQ_RESPONSE_NOT_UNDERSTOOD;
					$self->{_total_failed}++;
				}

			} else
			{
				warn "Regex not matched." if($VERBOSE);
				$self->{_requests}->{$index}->{data} = undef;
				$self->{_requests}->{$index}->{status} = REQ_RESPONSE_NOT_UNDERSTOOD;
				$self->{_total_failed}++;
			}
		} else
		{
			if($self->{_requests}->{$index}->{status} == REQ_INCOMPLETE)
			{
				$self->{_requests}->{$index}->{status} = REQ_REMOTE_TIMEOUT;
			}
			$self->{_total_failed}++;
		}