File Coverage

blib/lib/Message/Passing/Role/ConnectionManager.pm
Criterion Covered Total %
statement 48 48 100.0
branch 4 6 66.6
condition n/a
subroutine 14 14 100.0
pod 1 2 50.0
total 67 70 95.7


line stmt bran cond sub pod time code
1             package Message::Passing::Role::ConnectionManager;
2 2     2   33730 use Moo::Role;
  2         5  
  2         18  
3 2     2   1772 use MooX::Types::MooseLike::Base qw/ Bool ArrayRef /;
  2         12989  
  2         206  
4 2     2   15 use Scalar::Util qw/ blessed weaken /;
  2         5  
  2         110  
5 2     2   10 use Carp qw/ confess /;
  2         2  
  2         89  
6 2     2   1384 use Message::Passing::Exception::ConnectionDisconnected;
  2         6  
  2         70  
7 2     2   1749 use Message::Passing::Exception::ConnectionTimeout;
  2         7  
  2         73  
8 2     2   31 use namespace::clean -except => 'meta';
  2         4  
  2         15  
9              
10             requires '_build_connection';
11              
12             sub BUILD {
13 2     2 0 435 my $self = shift;
14 2         10 $self->connection;
15             }
16              
17             with qw/
18             Message::Passing::Role::HasTimeoutAndReconnectAfter
19             Message::Passing::Role::HasErrorChain
20             /;
21              
22             has _timeout_timer => (
23             is => 'rw',
24             );
25              
26             has connected => (
27             is => 'ro',
28             isa => Bool,
29             default => sub { 0 },
30             writer => '_set_connected',
31             );
32              
33             has connection => (
34             is => 'ro',
35             lazy => 1,
36             predicate => '_has_connection',
37             builder => '_build_connection',
38             clearer => '_clear_connection',
39             );
40              
41             after _build_connection => sub {
42             my $self = shift;
43             weaken($self);
44             $self->_timeout_timer($self->_build_timeout_timer);
45             };
46              
47             sub _build_timeout_timer {
48 3     3   8 my $self = shift;
49 3         12 weaken($self);
50             AnyEvent->timer(
51             after => $self->timeout,
52             cb => sub {
53 1     1   92162 $self->error->consume(Message::Passing::Exception::ConnectionTimeout->new(
54             after => $self->timeout,
55             ));
56 1         19 $self->_timeout_timer(undef);
57 1         36 $self->_set_connected(0); # Use public API, causing reconnect timer to be built
58             },
59 3         67 );
60             }
61              
62             sub _build_reconnect_timer {
63 1     1   3 my $self = shift;
64 1         4 weaken($self);
65             AnyEvent->timer(
66             after => $self->reconnect_after,
67             cb => sub {
68             # $self->error->consume("Reconnecting to ...");
69 1     1   70484 $self->_timeout_timer(undef);
70 1         10 $self->connection; # Just rebuild the connection object
71             },
72 1         15 );
73             }
74              
75             before _clear_connection => sub {
76             my $self = shift;
77             return unless $self->_has_connection;
78             $self->_timeout_timer($self->_build_reconnect_timer);
79             };
80              
81             has _connect_subscribers => (
82             isa => ArrayRef,
83             is => 'ro',
84             default => sub { [] },
85             writer => '_set_connect_subscribers',
86             );
87              
88             sub __clean_subs {
89 5     5   9 my $self = shift;
90 5         8 my $subs = [ grep { weaken($_); defined $_ } @{$self->_connect_subscribers} ];
  2         18  
  2         7  
  5         37  
91 5         19 $self->_set_connect_subscribers($subs);
92             }
93              
94             sub subscribe_to_connect {
95 2     2 1 8101 my ($self, $subscriber) = @_;
96 2 50       12 confess "Subscriber '$subscriber' is not blessed" unless blessed $subscriber;
97 2 50       18 confess "Subscriber '$subscriber' does not have a ->connected method" unless $subscriber->can('connected');
98 2         7 $self->__clean_subs;
99 2         663 my $subs = $self->_connect_subscribers;
100 2         4 push(@$subs, $subscriber);
101 2 100       13 if ($self->connected) {
102 1         5 $subscriber->connected($self->connection);
103             }
104             }
105              
106             after _set_connected => sub {
107             my ($self, $connected) = @_;
108             $self->__clean_subs;
109             my $method = $connected ? 'connected' : 'disconnected';
110             foreach my $sub (@{$self->_connect_subscribers}) {
111             $sub->$method($self->connection) if $sub->can($method);
112             }
113             $self->_timeout_timer(undef) if $connected;
114             if (!$connected && $self->_has_connection) {
115             $self->error->consume(Message::Passing::Exception::ConnectionDisconnected->new);
116             $self->_clear_connection;
117             }
118             };
119              
120             1;
121              
122             =head1 NAME
123              
124             Message::Passing::Role::ConnectionManager - A simple manager for inputs and outputs that need to make network connections.
125              
126             =head1 DESCRIPTION
127              
128             This role is for components which make network connections, and need to handle the connection not starting,
129             timeouts, disconnects etc.
130              
131             It provides a simple abstraction for multiple other classes to be able to use the same connection manager, and
132             a notifies
133              
134             =head1 REQUIRED METHODS
135              
136             =head2 _build_connection
137              
138             Build and return the connection we're managing, start the connection
139             process.
140              
141             Your connection should use the API as documented below to achieve notification of connect and disconnect events.
142              
143             =head1 API FOR CONNECTIONS
144              
145             =head2 _set_connected (1)
146              
147             Notify clients that the connection is now ready for use.
148              
149             =head2 _set_connected (0)
150              
151             Notify clients that the connection is no longer ready for use.
152              
153             Will cause the connection to be terminated and retried.
154              
155             =head1 API FOR CLIENTS
156              
157             To use a connection manager, you should register yourself like this:
158              
159             $manager->subscribe_to_connect($self);
160              
161             The manager will call C<< $self->connected($connection) >> and C<< $self->disconnected() >> when appropriate.
162              
163             If the manager is already connected when you subscribe, it will immediately call back into your
164             C<< connected >> method, if it is not already connected then this will happen at a later point
165             once the connection is established.
166              
167             See L for a role to help with dealing with a connection manager.
168              
169             =head1 ATTRIBUTES
170              
171             =head2 connected
172              
173             A Boolean indicating if the connection is currently considered fully connected
174              
175             =head2 connection
176              
177             The connection object (if we are connected, or connecting currently) - can
178             be undefined if we are during a reconnect timeout.
179              
180             =head2 timeout
181              
182             Connections will be timed out and aborted after this time if they haven't
183             successfully connected.
184              
185             Defaults to 30s
186              
187             =head2 reconnect_after
188              
189             The number of seconds to wait before starting a reconnect after a connection has timed out
190             or been aborted.
191              
192             Defaults to 2s
193              
194             =head1 METHODS
195              
196             =head2 subscribe_to_connect ($subscriber)
197              
198             This is called by your Input or Output, as C<< $self->connection_manager->subscribe_to_connect($self) >>.
199              
200             This is done for you by L usually..
201              
202             This arranges to store a weak reference to your component, allowing the
203             connection manager to call the C<< ->connect >>
204             or C<< ->disconnect >> methods for any components registered when a connection is established or destroyed.
205              
206             Note that if the connection manager is already connected, it will B call the C<< ->connect >> method.
207              
208             =head1 SPONSORSHIP
209              
210             This module exists due to the wonderful people at Suretec Systems Ltd.
211             who sponsored its development for its
212             VoIP division called SureVoIP for use with
213             the SureVoIP API -
214            
215              
216             ==head1 AUTHOR, COPYRIGHT AND LICENSE
217              
218             See L.
219              
220             =cut