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