1#!/usr/bin/perl
2
3# Test rapid connection reuse.  Sets the maximum overall connections
4# to a low number.  Allocate up to the maximum.  Reuse one of the
5# connections, and allocate a completely different connection.  The
6# allocation shuld be deferred, and one of the free sockets in the
7# keep-alive pool should be discarded to make room for it.
8
9use warnings;
10use strict;
11use lib qw(./mylib ../mylib);
12use Test::More tests => 7;
13
14sub POE::Kernel::ASSERT_DEFAULT () { 1 }
15
16use POE;
17use POE::Component::Client::Keepalive;
18use POE::Component::Resolver;
19use Socket qw(AF_INET);
20
21use TestServer;
22
23my $port_a = TestServer->spawn(0);
24my $port_b = TestServer->spawn(0);
25
26POE::Session->create(
27  inline_states => {
28    _child           => sub { },
29    _start           => \&start,
30    _stop            => sub { },
31    got_another_conn => \&got_another_conn,
32    got_conn         => \&got_conn,
33    got_error        => \&got_error,
34  }
35);
36
37sub start {
38  my $heap = $_[HEAP];
39
40  $heap->{cm} = POE::Component::Client::Keepalive->new(
41    max_open => 2,
42    resolver => POE::Component::Resolver->new(af_order => [ AF_INET ]),
43  );
44
45  $heap->{conn_count} = 0;
46
47  {
48    $heap->{cm}->allocate(
49      scheme  => "http",
50      addr    => "localhost",
51      port    => $port_a,
52      event   => "got_conn",
53      context => "first",
54    );
55  }
56
57  {
58    $heap->{cm}->allocate(
59      scheme  => "http",
60      addr    => "localhost",
61      port    => $port_a,
62      event   => "got_conn",
63      context => "second",
64    );
65  }
66}
67
68sub got_conn {
69  my ($heap, $response) = @_[HEAP, ARG0];
70
71  my $conn  = delete $response->{connection};
72  my $which = $response->{context};
73
74  if (defined $conn) {
75    pass "$which request established asynchronously";
76  }
77  else {
78    fail(
79      "$which request $response->{function} error $response->{error_num}: " .
80      $response->{error_str}
81    );
82  }
83
84  ok(!defined($response->{from_cache}), "$which connection request deferred");
85
86  $conn = undef;
87
88  return unless ++$heap->{conn_count} == 2;
89
90  # Re-allocate one of the connections.
91
92  $heap->{cm}->allocate(
93    scheme  => "http",
94    addr    => "localhost",
95    port    => $port_a,
96    event   => "got_another_conn",
97    context => "third",
98  );
99
100
101  $heap->{cm}->allocate(
102    scheme  => "http",
103    addr    => "localhost",
104    port    => $port_b,
105    event   => "got_another_conn",
106    context => "fourth",
107  );
108}
109
110sub got_another_conn {
111  my ($heap, $response) = @_[HEAP, ARG0];
112
113  # Deleting here to avoid a copy of the connection in %$response.
114  my $conn  = delete $response->{connection};
115  my $which = $response->{context};
116
117  if ($which eq 'third') {
118    is(
119      $response->{from_cache}, 'immediate',
120      "$which connection request honored from pool"
121    );
122    return;
123  }
124
125  if ($which eq 'fourth') {
126    ok(
127      !defined ($response->{from_cache}),
128      "$which connection request honored from pool"
129    );
130
131    if (defined $conn) {
132      pass "$which request established asynchronously";
133    }
134    else {
135      fail(
136        "$which request $response->{function} error $response->{error_num}: " .
137        $response->{error_str}
138      );
139    }
140
141    # Free the connection first.
142    $conn = undef;
143
144    TestServer->shutdown();
145    $heap->{cm}->shutdown();
146    return;
147  }
148
149  die;
150}
151
152POE::Kernel->run();
153exit;
154