[SCM] libmessage-passing-perl Debian packaging branch, master, updated. debian/0.111-3-14-g44f6e88

Tomas Doran bobtfish at bobtfish.net
Mon May 6 11:57:05 UTC 2013


The following commit has been merged in the master branch:
commit 6fbb12247998f83f4dfa451160e503b403ccb33b
Author: Tomas Doran <bobtfish at bobtfish.net>
Date:   Thu May 31 19:48:02 2012 +0100

    Make timing out connections work

diff --git a/lib/Message/Passing/Role/ConnectionManager.pm b/lib/Message/Passing/Role/ConnectionManager.pm
index 41d65d3..9ed8224 100644
--- a/lib/Message/Passing/Role/ConnectionManager.pm
+++ b/lib/Message/Passing/Role/ConnectionManager.pm
@@ -10,6 +10,16 @@ sub BUILD {
     $self->connection;
 }
 
+has timeout => (
+    isa => 'Int',
+    is => 'ro',
+    default => sub { 30 },
+);
+
+has _timeout_timer => (
+    is => 'rw',
+);
+
 has connected => (
     is => 'ro',
     isa => 'Bool',
@@ -24,6 +34,17 @@ has connection => (
     clearer => '_clear_connection'
 );
 
+after _build_connection => sub {
+    my $self = shift;
+    weaken($self);
+    $self->_timeout_timer(AnyEvent->timer(
+        after => $self->timeout,
+        cb => sub {
+            $self->_set_connected(0);
+        },
+    ));
+};
+
 has _connect_subscribers => (
     isa => 'ArrayRef',
     is => 'ro',
diff --git a/t/role_connectionmanager.t b/t/role_connectionmanager.t
index 343a35b..699beda 100644
--- a/t/role_connectionmanager.t
+++ b/t/role_connectionmanager.t
@@ -1,6 +1,7 @@
 use strict;
 use warnings;
 use Test::More;
+use AnyEvent;
 
 {
     package Connection::Subscriber;
@@ -32,6 +33,10 @@ use Test::More;
 
     with 'Message::Passing::Role::ConnectionManager';
 
+    has '+timeout' => (
+        default => sub { 0 },
+    );
+
     sub _build_connection {
         my $self = shift;
         weaken($self);
@@ -68,5 +73,15 @@ ok $sub2->{am_connected};
 is_deeply $i->_connect_subscribers, [$sub2];
 ok !$sub;
 
+$i = My::Connection::Wrapper->new;
+my $cv = AnyEvent->condvar;
+my $t; $t = AnyEvent->timer(
+    after => 0.1,
+    cb => sub { $cv->send },
+);
+ok $i->{connection};
+$cv->recv;
+ok !$i->{connection};
+
 done_testing;
 

-- 
libmessage-passing-perl Debian packaging



More information about the Pkg-perl-cvs-commits mailing list