1#  You may distribute under the terms of either the GNU General Public License
2#  or the Artistic License (the same terms as Perl itself)
3#
4#  (C) Paul Evans, 2011 -- leonerd@leonerd.org.uk
5
6package IO::Async::Protocol;
7
8use strict;
9use warnings;
10
11our $VERSION = '0.800';
12
13use base qw( IO::Async::Notifier );
14
15use Carp;
16
17=head1 NAME
18
19C<IO::Async::Protocol> - base class for transport-based protocols
20
21=head1 DESCRIPTION
22
23This subclass of L<IO::Async:Notifier> provides storage for a
24L<IO::Async::Handle> object, to act as a transport for some protocol. It
25contains an instance of the transport object, which it adds as a child
26notifier, allowing a level of independence from the actual transport being
27used. For example, a stream may actually be an L<IO::Async::SSLStream> to
28allow the protocol to be used over SSL.
29
30This class is not intended to be used directly, instead, see one of the
31subclasses
32
33=over 4
34
35=item L<IO::Async::Protocol::Stream> - base class for stream-based protocols
36
37=back
38
39=cut
40
41=head1 EVENTS
42
43The following events are invoked, either using subclass methods or CODE
44references in parameters:
45
46=head2 on_closed
47
48Optional. Invoked when the transport handle becomes closed.
49
50=cut
51
52=head1 PARAMETERS
53
54The following named parameters may be passed to C<new> or C<configure>:
55
56=head2 transport => IO::Async::Handle
57
58The L<IO::Async::Handle> to delegate communications to.
59
60=head2 on_closed => CODE
61
62CODE reference for the C<on_closed> event.
63
64When a new C<transport> object is given, it will be configured by calling the
65C<setup_transport> method, then added as a child notifier. If a different
66transport object was already configured, this will first be removed and
67deconfigured using the C<teardown_transport>.
68
69=cut
70
71sub configure
72{
73   my $self = shift;
74   my %params = @_;
75
76   for (qw( on_closed )) {
77      $self->{$_} = delete $params{$_} if exists $params{$_};
78   }
79
80   if( exists $params{transport} ) {
81      my $transport = delete $params{transport};
82
83      if( $self->{transport} ) {
84         $self->remove_child( $self->transport );
85
86         $self->teardown_transport( $self->transport );
87      }
88
89      $self->{transport} = $transport;
90
91      if( $transport ) {
92         $self->setup_transport( $self->transport );
93
94         $self->add_child( $self->transport );
95      }
96   }
97
98   $self->SUPER::configure( %params );
99}
100
101=head1 METHODS
102
103=cut
104
105=head2 transport
106
107   $transport = $protocol->transport
108
109Returns the stored transport object
110
111=cut
112
113sub transport
114{
115   my $self = shift;
116   return $self->{transport};
117}
118
119=head2 connect
120
121   $protocol->connect( %args )
122
123Sets up a connection to a peer, and configures the underlying C<transport> for
124the Protocol.
125
126Takes the following named arguments:
127
128=over 8
129
130=item socktype => STRING or INT
131
132Required. Identifies the socket type, and the type of continuation that will
133be used. If this value is C<"stream"> or C<SOCK_STREAM> then C<on_stream>
134continuation will be used; otherwise C<on_socket> will be used.
135
136=item on_connected => CODE
137
138Optional. If supplied, will be invoked once the connection has been
139established.
140
141   $on_connected->( $protocol )
142
143=item transport => IO::Async::Handle
144
145Optional. If this is provided, it will immediately be configured as the
146transport (by calling C<configure>), and the C<on_connected> callback will be
147invoked. This is provided as a convenient shortcut.
148
149=back
150
151Other arguments will be passed to the underlying L<IO::Async::Loop> C<connect>
152call.
153
154=cut
155
156sub connect
157{
158   my $self = shift;
159   my %args = @_;
160
161   my $on_connected = delete $args{on_connected};
162
163   if( my $transport = $args{transport} ) {
164      $self->configure( transport => $transport );
165
166      $on_connected->( $self ) if $on_connected;
167
168      return;
169   }
170
171   my $socktype = $args{socktype} or croak "Expected socktype";
172
173   my $on_transport = do {
174      no warnings 'numeric';
175      $socktype eq "stream" || $socktype == Socket::SOCK_STREAM()
176   } ? "on_stream" : "on_socket";
177
178   my $loop = $self->loop or croak "Cannot ->connect a ".ref($self)." that is not in a Loop";
179
180   $loop->connect(
181      %args,
182      socktype => "stream",
183
184      $on_transport => sub {
185         my ( $transport ) = @_;
186
187         $self->configure( transport => $transport );
188
189         $on_connected->( $self ) if $on_connected;
190      },
191   );
192}
193
194=head1 TRANSPORT DELEGATION
195
196The following methods are delegated to the transport object
197
198   close
199
200=cut
201
202sub close { shift->transport->close }
203
204=head1 SUBCLASS METHODS
205
206C<IO::Async::Protocol> is a base class provided so that specific subclasses of
207it provide more specific behaviour. The base class provides a number of
208methods that subclasses may wish to override.
209
210If a subclass implements any of these, be sure to invoke the superclass method
211at some point within the code.
212
213=cut
214
215=head2 setup_transport
216
217   $protocol->setup_transport( $transport )
218
219Called by C<configure> when a new C<transport> object is given, this method
220should perform whatever setup is required to wire the new transport object
221into the protocol object; typically by setting up event handlers.
222
223=cut
224
225sub setup_transport
226{
227   my $self = shift;
228   my ( $transport ) = @_;
229
230   $transport->configure(
231      on_closed => $self->_capture_weakself( sub {
232         my $self = shift or return;
233         my ( $transport ) = @_;
234
235         $self->maybe_invoke_event( on_closed => );
236
237         $self->configure( transport => undef );
238      } ),
239   );
240}
241
242=head2 teardown_transport
243
244   $protocol->teardown_transport( $transport )
245
246The reverse of C<setup_transport>; called by C<configure> when a previously
247set-up transport object is about to be replaced.
248
249=cut
250
251sub teardown_transport
252{
253   my $self = shift;
254   my ( $transport ) = @_;
255
256   $transport->configure(
257      on_closed => undef,
258   );
259}
260
261=head1 AUTHOR
262
263Paul Evans <leonerd@leonerd.org.uk>
264
265=cut
266
2670x55AA;
268