File Coverage

blib/lib/IO/Async/Socket.pm
Criterion Covered Total %
statement 74 78 94.8
branch 29 40 72.5
condition 14 23 60.8
subroutine 11 11 100.0
pod 4 4 100.0
total 132 156 84.6


line stmt bran cond sub pod time code
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-2015 -- leonerd@leonerd.org.uk
5              
6             package IO::Async::Socket;
7              
8 5     5   2265 use strict;
  5         11  
  5         201  
9 5     5   33 use warnings;
  5         13  
  5         317  
10              
11             our $VERSION = '0.801';
12              
13 5     5   35 use base qw( IO::Async::Handle );
  5         19  
  5         1233  
14              
15 5     5   54 use Errno qw( EAGAIN EWOULDBLOCK EINTR );
  5         10  
  5         379  
16              
17 5     5   38 use Carp;
  5         20  
  5         4427  
18              
19             =head1 NAME
20              
21             C - event callbacks and send buffering for a socket
22             filehandle
23              
24             =head1 SYNOPSIS
25              
26             use IO::Async::Socket;
27              
28             use IO::Async::Loop;
29             my $loop = IO::Async::Loop->new;
30              
31             my $socket = IO::Async::Socket->new(
32             on_recv => sub {
33             my ( $self, $dgram, $addr ) = @_;
34              
35             print "Received reply: $dgram\n",
36             $loop->stop;
37             },
38             on_recv_error => sub {
39             my ( $self, $errno ) = @_;
40             die "Cannot recv - $errno\n";
41             },
42             );
43             $loop->add( $socket );
44              
45             $socket->connect(
46             host => "some.host.here",
47             service => "echo",
48             socktype => 'dgram',
49             )->get;
50              
51             $socket->send( "A TEST DATAGRAM" );
52              
53             $loop->run;
54              
55             =head1 DESCRIPTION
56              
57             This subclass of L contains a socket filehandle. It
58             provides a queue of outgoing data. It invokes the C handler when new
59             data is received from the filehandle. Data may be sent to the filehandle by
60             calling the C method.
61              
62             It is primarily intended for C or C sockets (such as UDP
63             or packet-capture); for C sockets (such as TCP) an instance of
64             L is more appropriate.
65              
66             =head1 EVENTS
67              
68             The following events are invoked, either using subclass methods or CODE
69             references in parameters:
70              
71             =head2 on_recv $data, $addr
72              
73             Invoke on receipt of a packet, datagram, or stream segment.
74              
75             The C handler is invoked once for each packet, datagram, or stream
76             segment that is received. It is passed the data itself, and the sender's
77             address.
78              
79             =head2 on_recv_error $errno
80              
81             Optional. Invoked when the C method on the receiving handle fails.
82              
83             =head2 on_send_error $errno
84              
85             Optional. Invoked when the C method on the sending handle fails.
86              
87             The C and C handlers are passed the value of
88             C<$!> at the time the error occurred. (The C<$!> variable itself, by its
89             nature, may have changed from the original error by the time this handler
90             runs so it should always use the value passed in).
91              
92             If an error occurs when the corresponding error callback is not supplied, and
93             there is not a subclass method for it, then the C method is
94             called instead.
95              
96             =head2 on_outgoing_empty
97              
98             Optional. Invoked when the sending data buffer becomes empty.
99              
100             =cut
101              
102             sub _init
103             {
104 12     12   27 my $self = shift;
105              
106 12         60 $self->{recv_len} = 65536;
107              
108 12         93 $self->SUPER::_init( @_ );
109             }
110              
111             =head1 PARAMETERS
112              
113             The following named parameters may be passed to C or C:
114              
115             =head2 read_handle => IO
116              
117             The IO handle to receive from. Must implement C and C methods.
118              
119             =head2 write_handle => IO
120              
121             The IO handle to send to. Must implement C and C methods.
122              
123             =head2 handle => IO
124              
125             Shortcut to specifying the same IO handle for both of the above.
126              
127             =head2 on_recv => CODE
128              
129             =head2 on_recv_error => CODE
130              
131             =head2 on_outgoing_empty => CODE
132              
133             =head2 on_send_error => CODE
134              
135             =head2 autoflush => BOOL
136              
137             Optional. If true, the C method will atempt to send data to the
138             operating system immediately, without waiting for the loop to indicate the
139             filehandle is write-ready.
140              
141             =head2 recv_len => INT
142              
143             Optional. Sets the buffer size for C calls. Defaults to 64 KiB.
144              
145             =head2 recv_all => BOOL
146              
147             Optional. If true, repeatedly call C when the receiving handle first
148             becomes read-ready. By default this is turned off, meaning at most one
149             fixed-size buffer is received. If there is still more data in the kernel's
150             buffer, the handle will stil be readable, and will be received from again.
151              
152             This behaviour allows multiple streams and sockets to be multiplexed
153             simultaneously, meaning that a large bulk transfer on one cannot starve other
154             filehandles of processing time. Turning this option on may improve bulk data
155             transfer rate, at the risk of delaying or stalling processing on other
156             filehandles.
157              
158             =head2 send_all => INT
159              
160             Optional. Analogous to the C option, but for sending. When
161             C is enabled, this option only affects deferred sending if the
162             initial attempt failed.
163              
164             The condition requiring an C handler is checked at the time the
165             object is added to a Loop; it is allowed to create a C
166             object with a read handle but without a C handler, provided that
167             one is later given using C before the stream is added to its
168             containing Loop, either directly or by being a child of another Notifier
169             already in a Loop, or added to one.
170              
171             =cut
172              
173             sub configure
174             {
175 22     22 1 3882 my $self = shift;
176 22         68 my %params = @_;
177              
178 22         73 for (qw( on_recv on_outgoing_empty on_recv_error on_send_error
179             recv_len recv_all send_all autoflush )) {
180 176 100       390 $self->{$_} = delete $params{$_} if exists $params{$_};
181             }
182              
183 22         127 $self->SUPER::configure( %params );
184              
185 22 100 100     79 if( $self->loop and defined $self->read_handle ) {
186 2 50       8 $self->can_event( "on_recv" ) or
187             croak 'Expected either an on_recv callback or to be able to ->on_recv';
188             }
189             }
190              
191             sub _add_to_loop
192             {
193 8     8   20 my $self = shift;
194              
195 8 100       27 if( defined $self->read_handle ) {
196 6 100       23 $self->can_event( "on_recv" ) or
197             croak 'Expected either an on_recv callback or to be able to ->on_recv';
198             }
199              
200 7         55 $self->SUPER::_add_to_loop( @_ );
201             }
202              
203             =head1 METHODS
204              
205             =cut
206              
207             =head2 send
208              
209             $socket->send( $data, $flags, $addr )
210              
211             This method adds a segment of data to be sent, or sends it immediately,
212             according to the C parameter. C<$flags> and C<$addr> are optional.
213              
214             If the C option is set, this method will try immediately to send
215             the data to the underlying filehandle, optionally using the given flags and
216             destination address. If this completes successfully then it will have been
217             sent by the time this method returns. If it fails to send, then the data is
218             queued as if C were not set, and will be flushed as normal.
219              
220             =cut
221              
222             sub send
223             {
224 7     7 1 37 my $self = shift;
225 7         26 my ( $data, $flags, $addr ) = @_;
226              
227 7 50       60 croak "Cannot send data to a Socket with no write_handle" unless my $handle = $self->write_handle;
228              
229 7   100     51 my $sendqueue = $self->{sendqueue} ||= [];
230 7         31 push @$sendqueue, [ $data, $flags, $addr ];
231              
232 7 100       37 if( $self->{autoflush} ) {
233 2         8 while( @$sendqueue ) {
234 3         6 my ( $data, $flags, $addr ) = @{ $sendqueue->[0] };
  3         10  
235 3         13 my $len = $handle->send( $data, $flags, $addr );
236              
237 3 50       210 last if !$len; # stop on any errors and defer back to the non-autoflush path
238              
239 3         13 shift @$sendqueue;
240             }
241              
242 2 50       6 if( !@$sendqueue ) {
243 2         9 $self->want_writeready( 0 );
244 2         5 return;
245             }
246             }
247              
248 5         24 $self->want_writeready( 1 );
249             }
250              
251             sub on_read_ready
252             {
253 10     10 1 26 my $self = shift;
254              
255 10         42 my $handle = $self->read_handle;
256              
257 10         17 while(1) {
258 13         75 my $addr = $handle->recv( my $data, $self->{recv_len} );
259              
260 13 100       406 if( !defined $addr ) {
261 2 50 66     46 return if $! == EAGAIN || $! == EWOULDBLOCK || $! == EINTR;
      66        
262              
263 1         4 my $errno = $!;
264              
265 1 50       7 $self->maybe_invoke_event( on_recv_error => $errno )
266             or $self->close;
267              
268 1         12 return;
269             }
270              
271 11 50       35 if( !length $data ) {
272 0         0 $self->close;
273 0         0 return;
274             }
275              
276 11         114 $self->invoke_event( on_recv => $data, $addr );
277              
278 11 100       121 last unless $self->{recv_all};
279             }
280             }
281              
282             sub on_write_ready
283             {
284 4     4 1 15 my $self = shift;
285              
286 4         29 my $handle = $self->write_handle;
287              
288 4         18 my $sendqueue = $self->{sendqueue};
289              
290 4   33     127 while( $sendqueue and @$sendqueue ) {
291 4         10 my ( $data, $flags, $addr ) = @{ shift @$sendqueue };
  4         23  
292 4         58 my $len = $handle->send( $data, $flags, $addr );
293              
294 4 100       333 if( !defined $len ) {
295 1 50 33     18 return if $! == EAGAIN || $! == EWOULDBLOCK || $! == EINTR;
      33        
296              
297 1         3 my $errno = $!;
298              
299 1 50       5 $self->maybe_invoke_event( on_send_error => $errno )
300             or $self->close;
301              
302 1         10 return;
303             }
304              
305 3 50       10 if( $len == 0 ) {
306 0         0 $self->close;
307 0         0 return;
308             }
309              
310 3 50       11 last unless $self->{send_all};
311             }
312              
313 3 100 66     34 if( !$sendqueue or !@$sendqueue ) {
314 2         37 $self->want_writeready( 0 );
315              
316 2         40 $self->maybe_invoke_event( on_outgoing_empty => );
317             }
318             }
319              
320             =head1 EXAMPLES
321              
322             =head2 Send-first on a UDP Socket
323              
324             C is carried by the C socket type, for which the string
325             C<'dgram'> is a convenient shortcut:
326              
327             $socket->connect(
328             host => $hostname,
329             service => $service,
330             socktype => 'dgram',
331             ...
332             )
333              
334             =head2 Receive-first on a UDP Socket
335              
336             A typical server pattern with C involves binding a well-known port
337             number instead of connecting to one, and waiting on incoming packets.
338              
339             $socket->bind(
340             service => 12345,
341             socktype => 'dgram',
342             )->get;
343              
344             =head1 SEE ALSO
345              
346             =over 4
347              
348             =item *
349              
350             L - Supply object methods for I/O handles
351              
352             =back
353              
354             =head1 AUTHOR
355              
356             Paul Evans
357              
358             =cut
359              
360             0x55AA;