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, 2006-2019 -- leonerd@leonerd.org.uk 5 6package IO::Async::Handle; 7 8use strict; 9use warnings; 10use base qw( IO::Async::Notifier ); 11 12our $VERSION = '0.800'; 13 14use Carp; 15 16use IO::Handle; # give methods to bare IO handles 17 18use Future; 19use Future::Utils qw( try_repeat ); 20 21use IO::Async::OS; 22 23=head1 NAME 24 25C<IO::Async::Handle> - event callbacks for a non-blocking file descriptor 26 27=head1 SYNOPSIS 28 29This class is likely not to be used directly, because subclasses of it exist 30to handle more specific cases. Here is an example of how it would be used to 31watch a listening socket for new connections. In real code, it is likely that 32the C<< Loop->listen >> method would be used instead. 33 34 use IO::Socket::INET; 35 use IO::Async::Handle; 36 37 use IO::Async::Loop; 38 my $loop = IO::Async::Loop->new; 39 40 my $socket = IO::Socket::INET->new( LocalPort => 1234, Listen => 1 ); 41 42 my $handle = IO::Async::Handle->new( 43 handle => $socket, 44 45 on_read_ready => sub { 46 my $new_client = $socket->accept; 47 ... 48 }, 49 ); 50 51 $loop->add( $handle ); 52 53For most other uses with sockets, pipes or other filehandles that carry a byte 54stream, the L<IO::Async::Stream> class is likely to be more suitable. For 55non-stream sockets, see L<IO::Async::Socket>. 56 57=head1 DESCRIPTION 58 59This subclass of L<IO::Async::Notifier> allows non-blocking IO on filehandles. 60It provides event handlers for when the filehandle is read- or write-ready. 61 62=cut 63 64=head1 EVENTS 65 66The following events are invoked, either using subclass methods or CODE 67references in parameters: 68 69=head2 on_read_ready 70 71Invoked when the read handle becomes ready for reading. 72 73=head2 on_write_ready 74 75Invoked when the write handle becomes ready for writing. 76 77=head2 on_closed 78 79Optional. Invoked when the handle becomes closed. 80 81This handler is invoked before the filehandles are closed and the Handle 82removed from its containing Loop. The C<loop> will still return the containing 83Loop object. 84 85=cut 86 87=head1 PARAMETERS 88 89The following named parameters may be passed to C<new> or C<configure>: 90 91=head2 read_handle => IO 92 93=head2 write_handle => IO 94 95The reading and writing IO handles. Each must implement the C<fileno> method. 96Primarily used for passing C<STDIN> / C<STDOUT>; see the SYNOPSIS section of 97L<IO::Async::Stream> for an example. 98 99=head2 handle => IO 100 101The IO handle for both reading and writing; instead of passing each separately 102as above. Must implement C<fileno> method in way that C<IO::Handle> does. 103 104=head2 read_fileno => INT 105 106=head2 write_fileno => INT 107 108File descriptor numbers for reading and writing. If these are given as an 109alternative to C<read_handle> or C<write_handle> then a new C<IO::Handle> 110instance will be constructed around each. 111 112=head2 on_read_ready => CODE 113 114=head2 on_write_ready => CODE 115 116=head2 on_closed => CODE 117 118CODE references for event handlers. 119 120=head2 want_readready => BOOL 121 122=head2 want_writeready => BOOL 123 124If present, enable or disable read- or write-ready notification as per the 125C<want_readready> and C<want_writeready> methods. 126 127It is required that a matching C<on_read_ready> or C<on_write_ready> are 128available for any handle that is provided; either passed as a callback CODE 129reference or as an overridden the method. I.e. if only a C<read_handle> is 130given, then C<on_write_ready> can be absent. If C<handle> is used as a 131shortcut, then both read and write-ready callbacks or methods are required. 132 133If no IO handles are provided at construction time, the object is still 134created but will not yet be fully-functional as a Handle. IO handles can be 135assigned later using the C<set_handle> or C<set_handles> methods, or by 136C<configure>. This may be useful when constructing an object to represent a 137network connection, before the C<connect(2)> has actually been performed yet. 138 139=cut 140 141sub configure 142{ 143 my $self = shift; 144 my %params = @_; 145 146 if( exists $params{on_read_ready} ) { 147 $self->{on_read_ready} = delete $params{on_read_ready}; 148 undef $self->{cb_r}; 149 150 $self->_watch_read(0), $self->_watch_read(1) if $self->want_readready; 151 } 152 153 if( exists $params{on_write_ready} ) { 154 $self->{on_write_ready} = delete $params{on_write_ready}; 155 undef $self->{cb_w}; 156 157 $self->_watch_write(0), $self->_watch_write(1) if $self->want_writeready; 158 } 159 160 if( exists $params{on_closed} ) { 161 $self->{on_closed} = delete $params{on_closed}; 162 } 163 164 if( defined $params{read_fileno} and defined $params{write_fileno} and 165 $params{read_fileno} == $params{write_fileno} ) { 166 $params{handle} = IO::Handle->new_from_fd( $params{read_fileno}, "r+" ); 167 168 delete $params{read_fileno}; 169 delete $params{write_fileno}; 170 } 171 else { 172 $params{read_handle} = IO::Handle->new_from_fd( delete $params{read_fileno}, "r" ) 173 if defined $params{read_fileno}; 174 175 $params{write_handle} = IO::Handle->new_from_fd( delete $params{write_fileno}, "w" ) 176 if defined $params{write_fileno}; 177 } 178 179 # 'handle' is a shortcut for setting read_ and write_ 180 if( exists $params{handle} ) { 181 $params{read_handle} = $params{handle}; 182 $params{write_handle} = $params{handle}; 183 delete $params{handle}; 184 } 185 186 if( exists $params{read_handle} ) { 187 my $read_handle = delete $params{read_handle}; 188 189 if( defined $read_handle ) { 190 if( !defined eval { $read_handle->fileno } ) { 191 croak 'Expected that read_handle can ->fileno'; 192 } 193 194 unless( $self->can_event( 'on_read_ready' ) ) { 195 croak 'Expected either a on_read_ready callback or an ->on_read_ready method'; 196 } 197 198 my @layers = PerlIO::get_layers( $read_handle ); 199 if( grep m/^encoding\(/, @layers or grep m/^utf8$/, @layers ) { 200 # Only warn for now, because if it's UTF-8 by default but only 201 # passes ASCII then all will be well 202 carp "Constructing a ".ref($self)." with an encoding-enabled handle may not read correctly"; 203 } 204 205 $self->{read_handle} = $read_handle; 206 207 $self->want_readready( defined $read_handle ); 208 } 209 else { 210 $self->want_readready( 0 ); 211 212 undef $self->{read_handle}; 213 } 214 215 # In case someone has reopened the filehandles during an on_closed handler 216 undef $self->{handle_closing}; 217 } 218 219 if( exists $params{write_handle} ) { 220 my $write_handle = delete $params{write_handle}; 221 222 if( defined $write_handle ) { 223 if( !defined eval { $write_handle->fileno } ) { 224 croak 'Expected that write_handle can ->fileno'; 225 } 226 227 unless( $self->can_event( 'on_write_ready' ) ) { 228 # This used not to be fatal. Make it just a warning for now. 229 carp 'A write handle was provided but neither a on_write_ready callback nor an ->on_write_ready method were. Perhaps you mean \'read_handle\' instead?'; 230 } 231 232 $self->{write_handle} = $write_handle; 233 } 234 else { 235 $self->want_writeready( 0 ); 236 237 undef $self->{write_handle}; 238 } 239 240 # In case someone has reopened the filehandles during an on_closed handler 241 undef $self->{handle_closing}; 242 } 243 244 if( exists $params{want_readready} ) { 245 $self->want_readready( delete $params{want_readready} ); 246 } 247 248 if( exists $params{want_writeready} ) { 249 $self->want_writeready( delete $params{want_writeready} ); 250 } 251 252 $self->SUPER::configure( %params ); 253} 254 255# We'll be calling these any of three times 256# adding to/removing from loop 257# caller en/disables readiness checking 258# changing filehandle 259 260sub _watch_read 261{ 262 my $self = shift; 263 my ( $want ) = @_; 264 265 my $loop = $self->loop or return; 266 my $fh = $self->read_handle or return; 267 268 if( $want ) { 269 $self->{cb_r} ||= $self->make_event_cb( 'on_read_ready' ); 270 271 $loop->watch_io( 272 handle => $fh, 273 on_read_ready => $self->{cb_r}, 274 ); 275 } 276 else { 277 $loop->unwatch_io( 278 handle => $fh, 279 on_read_ready => 1, 280 ); 281 } 282} 283 284sub _watch_write 285{ 286 my $self = shift; 287 my ( $want ) = @_; 288 289 my $loop = $self->loop or return; 290 my $fh = $self->write_handle or return; 291 292 if( $want ) { 293 $self->{cb_w} ||= $self->make_event_cb( 'on_write_ready' ); 294 295 $loop->watch_io( 296 handle => $fh, 297 on_write_ready => $self->{cb_w}, 298 ); 299 } 300 else { 301 $loop->unwatch_io( 302 handle => $fh, 303 on_write_ready => 1, 304 ); 305 } 306} 307 308sub _add_to_loop 309{ 310 my $self = shift; 311 my ( $loop ) = @_; 312 313 $self->_watch_read(1) if $self->want_readready; 314 $self->_watch_write(1) if $self->want_writeready; 315} 316 317sub _remove_from_loop 318{ 319 my $self = shift; 320 my ( $loop ) = @_; 321 322 $self->_watch_read(0); 323 $self->_watch_write(0); 324} 325 326sub notifier_name 327{ 328 my $self = shift; 329 330 my @parts; 331 332 if( length( my $name = $self->SUPER::notifier_name ) ) { 333 push @parts, $name; 334 } 335 336 my $r = $self->read_fileno; 337 my $w = $self->write_fileno; 338 339 if( defined $r and defined $w and $r == $w ) { 340 push @parts, "rw=$r"; 341 } 342 elsif( defined $r and defined $w ) { 343 push @parts, "r=$r,w=$w"; 344 } 345 elsif( defined $r ) { 346 push @parts, "r=$r"; 347 } 348 elsif( defined $w ) { 349 push @parts, "w=$w"; 350 } 351 352 return join ",", @parts; 353} 354 355=head1 METHODS 356 357The following methods documented with a trailing call to C<< ->get >> return 358L<Future> instances. 359 360=cut 361 362=head2 set_handle 363 364 $handle->set_handles( %params ) 365 366Sets new reading or writing filehandles. Equivalent to calling the 367C<configure> method with the same parameters. 368 369=cut 370 371sub set_handles 372{ 373 my $self = shift; 374 my %params = @_; 375 376 $self->configure( 377 exists $params{read_handle} ? ( read_handle => $params{read_handle} ) : (), 378 exists $params{write_handle} ? ( write_handle => $params{write_handle} ) : (), 379 ); 380} 381 382=head2 set_handle 383 384 $handle->set_handle( $fh ) 385 386Shortcut for 387 388 $handle->configure( handle => $fh ) 389 390=cut 391 392sub set_handle 393{ 394 my $self = shift; 395 my ( $fh ) = @_; 396 397 $self->configure( handle => $fh ); 398} 399 400=head2 close 401 402 $handle->close 403 404This method calls C<close> on the underlying IO handles. This method will then 405remove the handle from its containing loop. 406 407=cut 408 409sub close 410{ 411 my $self = shift; 412 413 # Prevent infinite loops if there's two crosslinked handles 414 return if $self->{handle_closing}; 415 $self->{handle_closing} = 1; 416 417 $self->want_readready( 0 ); 418 $self->want_writeready( 0 ); 419 420 my $read_handle = delete $self->{read_handle}; 421 $read_handle->close if defined $read_handle; 422 423 my $write_handle = delete $self->{write_handle}; 424 $write_handle->close if defined $write_handle; 425 426 $self->_closed; 427} 428 429sub _closed 430{ 431 my $self = shift; 432 433 $self->maybe_invoke_event( on_closed => ); 434 if( $self->{close_futures} ) { 435 $_->done for @{ $self->{close_futures} }; 436 } 437 $self->remove_from_parent; 438} 439 440=head2 close_read 441 442=head2 close_write 443 444 $handle->close_read 445 446 $handle->close_write 447 448Closes the underlying read or write handle, and deconfigures it from the 449object. Neither of these methods will invoke the C<on_closed> event, nor 450remove the object from the Loop if there is still one open handle in the 451object. Only when both handles are closed, will C<on_closed> be fired, and the 452object removed. 453 454=cut 455 456sub close_read 457{ 458 my $self = shift; 459 460 $self->want_readready( 0 ); 461 462 my $read_handle = delete $self->{read_handle}; 463 $read_handle->close if defined $read_handle; 464 465 $self->_closed if !$self->{write_handle}; 466} 467 468sub close_write 469{ 470 my $self = shift; 471 472 $self->want_writeready( 0 ); 473 474 my $write_handle = delete $self->{write_handle}; 475 $write_handle->close if defined $write_handle; 476 477 $self->_closed if !$self->{read_handle}; 478} 479 480=head2 new_close_future 481 482 $handle->new_close_future->get 483 484Returns a new L<IO::Async::Future> object which will become done when the 485handle is closed. Cancelling the C<$future> will remove this notification 486ability but will not otherwise affect the C<$handle>. 487 488=cut 489 490sub new_close_future 491{ 492 my $self = shift; 493 494 push @{ $self->{close_futures} }, my $future = $self->loop->new_future; 495 $future->on_cancel( 496 $self->_capture_weakself( sub { 497 my $self = shift or return; 498 my $future = shift; 499 500 @{ $self->{close_futures} } = grep { $_ and $_ != $future } @{ $self->{close_futures} }; 501 }) 502 ); 503 504 return $future; 505} 506 507=head2 read_handle 508 509=head2 write_handle 510 511 $handle = $handle->read_handle 512 513 $handle = $handle->write_handle 514 515These accessors return the underlying IO handles. 516 517=cut 518 519sub read_handle 520{ 521 my $self = shift; 522 return $self->{read_handle}; 523} 524 525sub write_handle 526{ 527 my $self = shift; 528 return $self->{write_handle}; 529} 530 531=head2 read_fileno 532 533=head2 write_fileno 534 535 $fileno = $handle->read_fileno 536 537 $fileno = $handle->write_fileno 538 539These accessors return the file descriptor numbers of the underlying IO 540handles. 541 542=cut 543 544sub read_fileno 545{ 546 my $self = shift; 547 my $handle = $self->read_handle or return undef; 548 return $handle->fileno; 549} 550 551sub write_fileno 552{ 553 my $self = shift; 554 my $handle = $self->write_handle or return undef; 555 return $handle->fileno; 556} 557 558=head2 want_readready 559 560=head2 want_writeready 561 562 $value = $handle->want_readready 563 564 $oldvalue = $handle->want_readready( $newvalue ) 565 566 $value = $handle->want_writeready 567 568 $oldvalue = $handle->want_writeready( $newvalue ) 569 570These are the accessor for the C<want_readready> and C<want_writeready> 571properties, which define whether the object is interested in knowing about 572read- or write-readiness on the underlying file handle. 573 574=cut 575 576sub want_readready 577{ 578 my $self = shift; 579 if( @_ ) { 580 my ( $new ) = @_; 581 582 $new = !!$new; 583 return $new if !$new == !$self->{want_readready}; # compare bools 584 585 if( $new ) { 586 defined $self->read_handle or 587 croak 'Cannot want_readready in a Handle with no read_handle'; 588 } 589 590 my $old = $self->{want_readready}; 591 $self->{want_readready} = $new; 592 593 $self->_watch_read( $new ); 594 595 return $old; 596 } 597 else { 598 return $self->{want_readready}; 599 } 600} 601 602sub want_writeready 603{ 604 my $self = shift; 605 if( @_ ) { 606 my ( $new ) = @_; 607 608 $new = !!$new; 609 return $new if !$new == !$self->{want_writeready}; # compare bools 610 611 if( $new ) { 612 defined $self->write_handle or 613 croak 'Cannot want_writeready in a Handle with no write_handle'; 614 } 615 616 my $old = $self->{want_writeready}; 617 $self->{want_writeready} = $new; 618 619 $self->_watch_write( $new ); 620 621 return $old; 622 } 623 else { 624 return $self->{want_writeready}; 625 } 626} 627 628=head2 socket 629 630 $handle->socket( $ai ) 631 632Convenient shortcut to creating a socket handle, as given by an addrinfo 633structure, and setting it as the read and write handle for the object. 634 635C<$ai> may be either a C<HASH> or C<ARRAY> reference of the same form as given 636to L<IO::Async::OS>'s C<extract_addrinfo> method. 637 638This method returns nothing if it succeeds, or throws an exception if it 639fails. 640 641=cut 642 643sub socket 644{ 645 my $self = shift; 646 my ( $ai ) = @_; 647 648 # TODO: Something about closing the old one? 649 650 my ( $family, $socktype, $protocol ) = IO::Async::OS->extract_addrinfo( $ai ); 651 652 my $sock = IO::Async::OS->socket( $family, $socktype, $protocol ); 653 $sock->blocking( 0 ); 654 655 $self->set_handle( $sock ); 656} 657 658=head2 bind 659 660 $handle = $handle->bind( %args )->get 661 662Performs a C<getaddrinfo> resolver operation with the C<passive> flag set, 663and then attempts to bind a socket handle of any of the return values. 664 665=head2 bind (1 argument) 666 667 $handle = $handle->bind( $ai )->get 668 669When invoked with a single argument, this method is a convenient shortcut to 670creating a socket handle and C<bind()>ing it to the address as given by an 671addrinfo structure, and setting it as the read and write handle for the 672object. 673 674C<$ai> may be either a C<HASH> or C<ARRAY> reference of the same form as given 675to L<IO::Async::OS>'s C<extract_addrinfo> method. 676 677The returned future returns the handle object itself for convenience. 678 679=cut 680 681sub bind 682{ 683 my $self = shift; 684 685 if( @_ == 1 ) { 686 my ( $ai ) = @_; 687 688 $self->socket( $ai ); 689 my $addr = ( IO::Async::OS->extract_addrinfo( $ai ) )[3]; 690 691 $self->read_handle->bind( $addr ) or 692 return Future->fail( "Cannot bind - $!", bind => $self->read_handle, $addr, $! ); 693 694 return Future->done( $self ); 695 } 696 697 $self->loop->resolver->getaddrinfo( passive => 1, @_ )->then( sub { 698 my @addrs = @_; 699 700 try_repeat { 701 my $ai = shift; 702 703 $self->bind( $ai ); 704 } foreach => \@addrs, 705 until => sub { shift->is_done }; 706 }); 707} 708 709=head2 connect 710 711 $handle = $handle->connect( %args )->get 712 713A convenient wrapper for calling the C<connect> method on the underlying 714L<IO::Async::Loop> object. 715 716=cut 717 718sub connect 719{ 720 my $self = shift; 721 my %args = @_; 722 723 my $loop = $self->loop or croak "Cannot ->connect a Handle that is not in a Loop"; 724 725 $self->debug_printf( "CONNECT " . join( ", ", 726 # These args should be stringy 727 ( map { defined $args{$_} ? "$_=$args{$_}" : () } qw( host service family socktype protocol local_host local_service ) ) 728 ) ); 729 730 return $self->loop->connect( %args, handle => $self ); 731} 732 733=head1 SEE ALSO 734 735=over 4 736 737=item * 738 739L<IO::Handle> - Supply object methods for I/O handles 740 741=back 742 743=head1 AUTHOR 744 745Paul Evans <leonerd@leonerd.org.uk> 746 747=cut 748 7490x55AA; 750