view release on metacpan or  search on metacpan

t/2_rank.t  view on Meta::CPAN

rank_get 'http://perlmonks.org', host => "$host:$port", sub {
	my ($rank, $headers) = @_;
	is($rank, 8, 'perlmonks.org rank');
	
	ok(time()-$start > 5, 'perlmonks.org non-blocking');
	$cv->end;
};

AnyEvent::Google::PageRank->new(host => "$host:$port")->get(
	'http://cpan.org',
	sub {
		my ($rank, $headers) = @_;
		is($rank, 7, 'cpan.org rank');
		
		ok(time()-$start < 5, 'cpan.org non-blocking');
		$cv->end;
	}
);

$cv->recv;
kill 15, $pid;
done_testing();

# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~`

sub make_rank_server {
	my %table = @_;
	my $serv = IO::Socket::INET->new(Listen => 3)
		or die $@;
		
	my $child = fork();
	die 'fork: ', $! unless defined $child;
	
	if ($child == 0) {
		while (1) {
			my $client = $serv->accept()
				or next;
			
			my $child = fork();
			die 'subfork: ', $! unless defined $child;
			
			if ($child == 0) {
				my $headers;
				while (1) {
					$client->sysread($headers, 1024, length $headers)
						or last;
					if (rindex($headers, "\015\012\015\012") != -1) {
						last;
					}
				}
			
				my ($path) = $headers =~ /GET\s+(\S+)/
					or exit;
				
				$path =~ /ch=([^&]+)/
					or exit;
				
				my ($url) = $path =~ /info:(.+)/
					or exit;
				$url = uri_unescape($url);
				
				my $response;
				if (exists $table{$url}) {
					$response = $table{$url}[0];
					sleep $table{$url}[1];
				}
				else {
					$response = 'xxx';
				}
				
				$client->syswrite(
					join(
						"\015\012",
						"HTTP/1.1 200 OK",
						"Connection: close",
						"Content-Type: text/html",
						"\015\012"
					) . "Rank_321:123:$response"
				);
				
				exit;
			}
		}
		
		exit;
	}
	
	return ($child, $serv->sockhost eq "0.0.0.0" ? "127.0.0.1" : $serv->sockhost, $serv->sockport);
}