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