1#!/usr/bin/perl
2# vim: filetype=perl
3
4# Test connection queuing.  Set the per-connection queue to be really
5# small (one in all), and then try to allocate two connections.  The
6# second should queue.
7
8use warnings;
9use strict;
10use lib qw(./mylib ../mylib);
11use Test::More tests => 8;
12
13sub POE::Kernel::ASSERT_DEFAULT () { 1 }
14
15use POE;
16use POE::Component::Client::Keepalive;
17use POE::Component::Resolver;
18use Socket qw(AF_INET);
19
20use TestServer;
21my $server_port = TestServer->spawn(0);
22
23POE::Session->create(
24  inline_states => {
25    _child          => sub { },
26    _start          => \&start,
27    _stop           => sub { },
28    got_error       => \&got_error,
29    got_first_conn  => \&got_first_conn,
30    got_fourth_conn => \&got_fourth_conn,
31    got_third_conn => \&got_third_conn,
32    got_timeout     => \&got_timeout,
33    test_pool_alive => \&test_pool_alive,
34  }
35);
36
37sub start {
38  my $heap = $_[HEAP];
39
40  $heap->{cm} = POE::Component::Client::Keepalive->new(
41    max_per_host => 1,
42    resolver     => POE::Component::Resolver->new(af_order => [ AF_INET ]),
43  );
44
45  # Count the number of times test_pool_alive is called.  When that's
46  # 2, we actually do the test.
47
48  $heap->{test_pool_alive} = 0;
49
50  # Make two identical tests.  They're both queued because the free
51  # pool is empty at this point.
52
53  {
54    $heap->{cm}->allocate(
55      scheme  => "http",
56      addr    => "localhost",
57      port    => $server_port,
58      event   => "got_first_conn",
59      context => "first",
60    );
61  }
62
63  {
64    $heap->{cm}->allocate(
65      scheme  => "http",
66      addr    => "localhost",
67      port    => $server_port,
68      event   => "got_first_conn",
69      context => "second",
70    );
71  }
72}
73
74sub got_first_conn {
75  my ($kernel, $heap, $stuff) = @_[KERNEL, HEAP, ARG0];
76
77  my $conn = $stuff->{connection};
78  my $which = $stuff->{context};
79
80  if (defined $conn) {
81    pass "$which request honored asynchronously";
82  }
83  else {
84    fail(
85      "$which request $stuff->{function} error $stuff->{error_num}: " .
86      $stuff->{error_str}
87    );
88  }
89
90  if ($which eq 'first') {
91    ok(not (defined ($stuff->{from_cache})), "$which not from cache");
92  } else {
93    is($stuff->{from_cache}, 'deferred', "$which deferred from cache");
94  }
95
96  $kernel->yield("test_pool_alive");
97}
98
99sub got_third_conn {
100  my ($kernel, $heap, $stuff) = @_[KERNEL, HEAP, ARG0];
101
102  my $conn = $stuff->{connection};
103  my $which = $stuff->{context};
104
105  if (defined $conn) {
106    pass "$which request honored asynchronously";
107  }
108  else {
109    fail(
110      "$which request $stuff->{function} error $stuff->{error_num}: " .
111      $stuff->{error_str}
112    );
113  }
114
115  is($stuff->{from_cache}, 'immediate', "$which connection request honored from pool immediately");
116}
117
118# We need a free connection pool of 2 or more for this next test.  We
119# want to allocate and free one of them to make sure the pool is not
120# destroyed.  Yay, Devel::Cover, for making me actually do this.
121
122sub test_pool_alive {
123  my ($kernel, $heap) = @_[KERNEL, HEAP];
124
125  $heap->{test_pool_alive}++;
126  return unless $heap->{test_pool_alive} == 2;
127
128  $heap->{cm}->allocate(
129    scheme  => "http",
130    addr    => "localhost",
131    port    => $server_port,
132    event   => "got_third_conn",
133    context => "third",
134  );
135
136  $heap->{cm}->allocate(
137    scheme  => "http",
138    addr    => "localhost",
139    port    => $server_port,
140    event   => "got_fourth_conn",
141    context => "fourth",
142  );
143}
144
145sub got_fourth_conn {
146  my ($kernel, $heap, $stuff) = @_[KERNEL, HEAP, ARG0];
147
148  my $conn = delete $stuff->{connection};
149
150  if (defined $conn) {
151    pass "fourth request established asynchronously";
152  }
153  else {
154    fail(
155      "fourth request $stuff->{function} error $stuff->{error_num}: " .
156      $stuff->{error_str}
157    );
158  }
159
160  is ($stuff->{from_cache}, 'deferred', "connection from pool");
161
162  $conn = undef;
163
164  TestServer->shutdown();
165  $heap->{cm}->shutdown();
166}
167
168POE::Kernel->run();
169exit;
170