1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
#!/usr/bin/perl
# Test connection queuing. Set the per-connection queue to be really
# small (one in all), and then try to allocate two connections. The
# second should queue.
use warnings;
use strict;
use lib qw(./mylib ../mylib);
use Test::More tests => 7;
sub POE::Kernel::ASSERT_DEFAULT () { 1 }
use POE;
use POE::Component::Client::Keepalive;
use POE::Component::Resolver;
use Socket qw(AF_INET);
use TestServer;
my $server_port = TestServer->spawn(0);
POE::Session->create(
inline_states => {
_child => sub { },
_start => \&start,
_stop => sub { },
got_error => \&got_error,
got_first_conn => \&got_first_conn,
cleanup1 => \&cleanup1,
cleanup => \&cleanup,
error => \&error,
input => \&input,
}
);
sub start {
my $heap = $_[HEAP];
$heap->{cm} = POE::Component::Client::Keepalive->new(
max_per_host => 1,
resolver => POE::Component::Resolver->new(af_order => [ AF_INET ]),
);
# Count the number of times test_pool_alive is called. When that's
# 2, we actually do the test.
$heap->{test_pool_alive} = 0;
# Make two identical tests. They're both queued because the free
# pool is empty at this point.
{
$heap->{cm}->allocate(
scheme => "http",
addr => "localhost",
port => $server_port,
event => "got_first_conn",
context => "first",
);
}
{
$heap->{cm}->allocate(
scheme => "http",
addr => "localhost",
port => $server_port,
event => "got_first_conn",
context => "second",
);
}
}
sub got_first_conn {
my ($kernel, $heap, $stuff) = @_[KERNEL, HEAP, ARG0];
my $conn = $stuff->{connection};
my $which = $stuff->{context};
ok(defined($conn), "$which connection established asynchronously");
if ($which eq 'first') {
ok(not (defined ($stuff->{from_cache})), "$which not from cache");
my $wheel = $conn->start(
ErrorEvent => 'error',
InputEvent => 'cleanup1',
);
$heap->{conn} = $conn;
TestServer->send_something;
} else {
ok(not (defined ($stuff->{from_cache})), "$which not from cache");
my $wheel = $conn->start(
ErrorEvent => 'error',
InputEvent => 'input',
);
TestServer->send_something;
$heap->{conn} = $conn;
$kernel->delay_add ('cleanup', 1);
}
}
sub cleanup1 {
is ($_[ARG1], $_[HEAP]->{conn}->wheel->ID, "input for correct wheel");
$_[HEAP]->{wheelid} = $_[ARG1];
TestServer->shutdown_clients;
delete $_[HEAP]->{conn};
}
sub cleanup {
delete $_[HEAP]->{conn};
TestServer->shutdown;
}
sub error {
my $heap = $_[HEAP];
is ($heap->{wheelid}, $heap->{conn}->wheel->ID, "eof arrives at same wheel");
delete $_[HEAP]->{wheelid};
$heap->{conn}->wheel->shutdown_input;
$heap->{conn}->wheel->shutdown_output;
delete $heap->{conn};
}
sub input {
$_[HEAP]->{wheelid} = $_[ARG1];
ok (1, "input arrives from new socket");
TestServer->shutdown_clients;
}
POE::Kernel->run();
exit;
|
