view release on metacpan or  search on metacpan

local/lib/perl5/IO/Async/Handle.pm  view on Meta::CPAN

         }

         unless( $self->can_event( 'on_read_ready' ) ) {
            croak 'Expected either a on_read_ready callback or an ->on_read_ready method';
         }

         my @layers = PerlIO::get_layers( $read_handle );
         if( grep m/^encoding\(/, @layers or grep m/^utf8$/, @layers ) {
            # Only warn for now, because if it's UTF-8 by default but only
            # passes ASCII then all will be well
            carp "Constructing a ".ref($self)." with an encoding-enabled handle may not read correctly";
         }

         $self->{read_handle} = $read_handle;

         $self->want_readready( defined $read_handle );
      }
      else {
         $self->want_readready( 0 );

         undef $self->{read_handle};
      }

      # In case someone has reopened the filehandles during an on_closed handler
      undef $self->{handle_closing};
   }

   if( exists $params{write_handle} ) {
      my $write_handle = delete $params{write_handle};

      if( defined $write_handle ) {
         if( !defined eval { $write_handle->fileno } ) {
            croak 'Expected that write_handle can ->fileno';
         }

         unless( $self->can_event( 'on_write_ready' ) ) {
            # This used not to be fatal. Make it just a warning for now.
            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?';
         }

         $self->{write_handle} = $write_handle;
      }
      else {
         $self->want_writeready( 0 );

         undef $self->{write_handle};
      }

      # In case someone has reopened the filehandles during an on_closed handler
      undef $self->{handle_closing};
   }

   if( exists $params{want_readready} ) {
      $self->want_readready( delete $params{want_readready} );
   }

   if( exists $params{want_writeready} ) {
      $self->want_writeready( delete $params{want_writeready} );
   }

   $self->SUPER::configure( %params );
}

# We'll be calling these any of three times
#   adding to/removing from loop
#   caller en/disables readiness checking
#   changing filehandle

sub _watch_read
{
   my $self = shift;
   my ( $want ) = @_;

   my $loop = $self->loop or return;
   my $fh = $self->read_handle or return;

   if( $want ) {
      $self->{cb_r} ||= $self->make_event_cb( 'on_read_ready' );

      $loop->watch_io(
         handle => $fh,
         on_read_ready => $self->{cb_r},
      );
   }
   else {
      $loop->unwatch_io(
         handle => $fh,
         on_read_ready => 1,
      );
   }
}

sub _watch_write
{
   my $self = shift;
   my ( $want ) = @_;

   my $loop = $self->loop or return;
   my $fh = $self->write_handle or return;

   if( $want ) {
      $self->{cb_w} ||= $self->make_event_cb( 'on_write_ready' );

      $loop->watch_io(
         handle => $fh,
         on_write_ready => $self->{cb_w},
      );
   }
   else {
      $loop->unwatch_io(
         handle => $fh,
         on_write_ready => 1,
      );
   }
}

sub _add_to_loop
{
   my $self = shift;
   my ( $loop ) = @_;

   $self->_watch_read(1)  if $self->want_readready;
   $self->_watch_write(1) if $self->want_writeready;
}

sub _remove_from_loop
{
   my $self = shift;
   my ( $loop ) = @_;

   $self->_watch_read(0);
   $self->_watch_write(0);
}

sub notifier_name
{
   my $self = shift;
   if( length( my $name = $self->SUPER::notifier_name ) ) {
      return $name;
   }

   my $r = $self->read_fileno;
   my $w = $self->write_fileno;
   return "rw=$r"     if defined $r and defined $w and $r == $w;
   return "r=$r,w=$w" if defined $r and defined $w;
   return "r=$r"      if defined $r;
   return "w=$w"      if defined $w;
   return "no";
}

=head1 METHODS

The following methods documented with a trailing call to C<< ->get >> return
L<Future> instances.

=cut

=head2 set_handle

   $handle->set_handles( %params )

Sets new reading or writing filehandles. Equivalent to calling the
C<configure> method with the same parameters.

=cut

sub set_handles
{
   my $self = shift;
   my %params = @_;

   $self->configure(
      exists $params{read_handle}  ? ( read_handle  => $params{read_handle} )  : (),
      exists $params{write_handle} ? ( write_handle => $params{write_handle} ) : (),
   );
}

=head2 set_handle

   $handle->set_handle( $fh )

Shortcut for

 $handle->configure( handle => $fh )

=cut

sub set_handle
{
   my $self = shift;
   my ( $fh ) = @_;

   $self->configure( handle => $fh );
}

=head2 close

   $handle->close