diff -rub POE-Component-Client-Keepalive-0.272/MANIFEST POE-Component-Client-Keepalive-0.272-PG1/MANIFEST
--- POE-Component-Client-Keepalive-0.272/MANIFEST 2014-07-08 13:54:50.000000000 -0400
+++ POE-Component-Client-Keepalive-0.272-PG1/MANIFEST 2015-04-29 15:44:15.758937462 -0400
@@ -30,3 +30,5 @@
t/51_reiss_reuse.t
t/release-pod-coverage.t
t/release-pod-syntax.t
+t/61_noreuse.t
diff -rub POE-Component-Client-Keepalive-0.272/dist.ini POE-Component-Client-Keepalive-0.272-PG1/dist.ini
--- POE-Component-Client-Keepalive-0.272/dist.ini 2014-07-08 13:54:50.000000000 -0400
+++ POE-Component-Client-Keepalive-0.272-PG1/dist.ini 2015-04-29 14:34:32.826397948 -0400
@@ -7,6 +7,7 @@
Net::IP::Minimal = 0.02
POE = 1.311
POE::Component::Resolver = 0.917
+Test::POE::Server::TCP = 1.14
[MetaResources]
bugtracker =
http://rt.cpan.org/Public/Dist/Display.html?Name=POE-Component-Client-Keepalive
diff -rub POE-Component-Client-Keepalive-0.272/t/61_noreuse.t POE-Component-Client-Keepalive-0.272-PG1/t/61_noreuse.t
--- POE-Component-Client-Keepalive-0.272/t/61_noreuse.t 2015-04-29 15:43:43.067944006 -0400
+++ POE-Component-Client-Keepalive-0.272-PG1/t/61_noreuse.t 2015-04-29 15:39:21.397984969 -0400
@@ -0,0 +1,233 @@
+#!/usr/bin/perl
+# vim: ts=2 sw=2 filetype=perl expandtab
+
+# Philip Gwyn's test for never reusing a connection
+
+use warnings;
+use strict;
+
+use Test::More;
+use Test::POE::Server::TCP;
+use POE qw(Filter::Stream Component::Client::HTTP);
+use HTTP::Request::Common qw(GET);
+
+use_ok( 'POE::Component::Client::Keepalive' );
+
+# These connections should never be reused
+my $once = POE::Component::Client::Keepalive->new( keep_alive => 0 );
+# These connections should be reused
+my $reuse = POE::Component::Client::Keepalive->new( keep_alive => 10 );
+
+plan tests => 30;
+
+POE::Session->create(
+ inline_states => {
+ _start => \&start,
+ testd_registered => \&testd_start,
+ testd_client_input => \&testd_input,
+
+ first_conn => \&first_conn,
+ first_response => \&first_response,
+ first_done => \&first_done,
+
+ second_conn => \&second_conn,
+ second_response => \&second_response,
+ second_done => \&second_done,
+
+ third_conn => \&third_conn,
+ third_response => \&third_response,
+ third_done => \&third_done,
+
+ fourth_conn => \&fourth_conn,
+ fourth_response => \&fourth_response,
+ done => \&done,
+ },
+ heap => {
+ once => $once,
+ reuse => $reuse
+ }
+);
+
+sub start {
+ my( $kernel, $heap ) = @_[KERNEL, HEAP];
+ $kernel->alias_set( 'tester' );
+
+ $heap->{testd} = Test::POE::Server::TCP->spawn(
+ Filter => POE::Filter::Stream->new,
+ address => 'localhost',
+ );
+}
+
+sub get_conn
+{
+ my( $heap, $type, $event, $ctx ) = @_;
+ $ctx ||= {};
+
+ my $cm = $heap->{$type};
+
+ $ctx->{rid} = $cm->allocate( scheme => 'http',
+ addr => 'localhost',
+ port => $heap->{port},
+ event => $event,
+ context => $ctx );
+ return $ctx->{rid};
+}
+
+
+sub testd_start {
+ my ($kernel, $heap) = @_[KERNEL, HEAP];
+
+ my $port = $heap->{testd}->port;
+ $heap->{port} = $port;
+
+ my $rid = get_conn( $heap, 'once', 'first_conn' );
+ ok( $rid, "Allocating first connection" );
+
+};
+
+sub done {
+ pass( 'done' );
+ $_[HEAP]->{testd}->shutdown;
+ delete( $_[HEAP]->{once} )->shutdown;
+ delete( $_[HEAP]->{reuse} )->shutdown;
+}
+
+#######################################################################
+sub conn2wheel
+{
+ my( $heap, $resp, $event ) = @_;
+
+ my $conn = $resp->{connection};
+ ok( $conn, "Got a connection" );
+ my $wheel = $conn->start(
+ Driver => POE::Driver::SysRW->new(),
+ InputEvent => $event,
+ ErrorEvent => 'got_socket_error',
+ );
+ $heap->{id2w}{ $wheel->ID } = $wheel;
+ $heap->{id2conn}{ $wheel->ID } = $conn;
+ return $wheel;
+}
+
+
+###################################
+sub first_conn {
+ my( $kernel, $heap, $resp ) = @_[ KERNEL, HEAP, ARG0...$#_ ];
+ my $wheel = conn2wheel( $heap, $resp, 'first_response' );
+ $wheel->put( "first" );
+}
+
+sub first_response {
+ my( $kernel, $heap, $line, $id ) = @_[KERNEL, HEAP, ARG0..$#_];
+
+ ok( $line, "Got response" );
+ $heap->{first} = $line;
+
+ my $wheel = delete $heap->{id2w}{$id};
+ ok( $wheel, " ... on a known wheel" );
+ my $conn = delete $heap->{id2conn}{$id};
+ ok( $conn, " ... for a known request" );
+
+ # give up slices so that the connection can be destroyed
+ $kernel->yield( 'first_done' );
+}
+
+sub first_done {
+ my( $kernel, $heap ) = @_[ KERNEL, HEAP ];
+
+ my $rid = get_conn( $heap, 'once', 'second_conn' );
+ ok( $rid, "Allocating second connection" );
+}
+
+###################################
+sub second_conn {
+ my( $kernel, $heap, $resp ) = @_[ KERNEL, HEAP, ARG0...$#_ ];
+ my $wheel = conn2wheel( $heap, $resp, 'second_response' );
+ $wheel->put( "second" );
+}
+
+sub second_response {
+ my( $kernel, $heap, $line, $id ) = @_[KERNEL, HEAP, ARG0..$#_];
+
+ ok( $line, "Got response" );
+ isnt( $heap->{first}, $line, " ... on a different connection" );
+
+ my $wheel = delete $heap->{id2w}{$id};
+ ok( $wheel, " ... on a known wheel" );
+ my $conn = delete $heap->{id2conn}{$id};
+ ok( $conn, " ... for a known request" );
+ $kernel->yield( 'second_done' );
+}
+
+sub second_done {
+ my( $kernel, $heap ) = @_[ KERNEL, HEAP ];
+
+ my $rid = get_conn( $heap, 'reuse', 'third_conn' );
+ pass( "Allocating third connection" );
+}
+
+###################################
+sub third_conn {
+ my( $kernel, $heap, $resp ) = @_[ KERNEL, HEAP, ARG0...$#_ ];
+ my $wheel = conn2wheel( $heap, $resp, 'third_response' );
+ $wheel->put( "third" );
+}
+
+sub third_response {
+ my( $kernel, $heap, $line, $id ) = @_[KERNEL, HEAP, ARG0..$#_];
+
+ ok( $line, "Got response" );
+ $heap->{third} = $line;
+ isnt( $heap->{first}, $line, " ... on a different connection" );
+
+ my $wheel = delete $heap->{id2w}{$id};
+ ok( $wheel, " ... on a known wheel" );
+ my $conn = delete $heap->{id2conn}{$id};
+ ok( $conn, " ... for a known request" );
+ $kernel->yield( 'third_done' );
+}
+
+sub third_done {
+ my( $kernel, $heap ) = @_[ KERNEL, HEAP ];
+
+ my $rid = get_conn( $heap, 'reuse', 'fourth_conn' );
+ pass( "Allocating fourth connection" );
+}
+
+###################################
+sub fourth_conn {
+ my( $kernel, $heap, $resp ) = @_[ KERNEL, HEAP, ARG0...$#_ ];
+ my $wheel = conn2wheel( $heap, $resp, 'fourth_response' );
+ $wheel->put( "fourth" );
+}
+
+sub fourth_response {
+ my( $kernel, $heap, $line, $id ) = @_[KERNEL, HEAP, ARG0..$#_];
+
+ ok( $line, "Got response" );
+ is( $heap->{third}, $line, " ... on the same connection" );
+
+ my $wheel = delete $heap->{id2w}{$id};
+ ok( $wheel, " ... on a known wheel" );
+ my $conn = delete $heap->{id2conn}{$id};
+ ok( $conn, " ... for a known request" );
+ $kernel->yield( 'done' );
+}
+
+
+
+#######################################################################
+sub testd_input {
+ my ($kernel, $heap, $id, $input) = @_[KERNEL, HEAP, ARG0, ARG1];
+
+ my $I = $heap->{testd}->client_info( $id );
+ my $info = join '->', "$I->{peeraddr}:$I->{peerport}",
+ "$I->{sockaddr}:$I->{sockport}";
+ pass( "Input $info" );
+ $heap->{testd}->send_to_client( $id, "$info\n" );
+}
+
+#######################################################################
+POE::Kernel->run();
+pass( "Sane shutdown" );
+exit;
