File Coverage

blib/lib/IO/Async/Socket.pm
Criterion Covered Total %
statement 73 77 94.8
branch 29 40 72.5
condition 14 23 60.8
subroutine 11 11 100.0
pod 4 4 100.0
total 131 155 84.5


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