view release on metacpan or  search on metacpan

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

This method adds a segment of data to be sent, or sends it immediately,
according to the C<autoflush> parameter. C<$flags> and C<$addr> are optional.

If the C<autoflush> option is set, this method will try immediately to send
the data to the underlying filehandle, optionally using the given flags and
destination address. If this completes successfully then it will have been
sent by the time this method returns. If it fails to send, then the data is
queued as if C<autoflush> were not set, and will be flushed as normal.

=cut

sub send
{
   my $self = shift;
   my ( $data, $flags, $addr ) = @_;

   croak "Cannot send data to a Socket with no write_handle" unless my $handle = $self->write_handle;

   my $sendqueue = $self->{sendqueue} ||= [];
   push @$sendqueue, [ $data, $flags, $addr ];

   if( $self->{autoflush} ) {
      while( @$sendqueue ) {
         my ( $data, $flags, $addr ) = @{ $sendqueue->[0] };
         my $len = $handle->send( $data, $flags, $addr );

         last if !$len; # stop on any errors and defer back to the non-autoflush path

         shift @$sendqueue;
      }

      if( !@$sendqueue ) {
         $self->want_writeready( 0 );
         return;
      }
   }

   $self->want_writeready( 1 );
}

sub on_read_ready
{
   my $self = shift;

   my $handle = $self->read_handle;

   while(1) {
      my $addr = $handle->recv( my $data, $self->{recv_len} );

      if( !defined $addr ) {
         return if $! == EAGAIN || $! == EWOULDBLOCK || $! == EINTR;

         my $errno = $!;

         $self->maybe_invoke_event( on_recv_error => $errno )
            or $self->close;

         return;
      }

      if( !length $data ) {
         $self->close;
         return;
      }

      $self->invoke_event( on_recv => $data, $addr );

      last unless $self->{recv_all};
   }
}

sub on_write_ready
{
   my $self = shift;

   my $handle = $self->write_handle;

   my $sendqueue = $self->{sendqueue};

   while( $sendqueue and @$sendqueue ) {
      my ( $data, $flags, $addr ) = @{ shift @$sendqueue };
      my $len = $handle->send( $data, $flags, $addr );

      if( !defined $len ) {
         return if $! == EAGAIN || $! == EWOULDBLOCK || $! == EINTR;

         my $errno = $!;

         $self->maybe_invoke_event( on_send_error => $errno )
            or $self->close;

         return;
      }

      if( $len == 0 ) {
         $self->close;
         return;
      }

      last unless $self->{send_all};
   }

   if( !$sendqueue or !@$sendqueue ) {
      $self->want_writeready( 0 );

      $self->maybe_invoke_event( on_outgoing_empty => );
   }
}

=head1 EXAMPLES

=head2 Send-first on a UDP Socket

C<UDP> is carried by the C<SOCK_DGRAM> socket type, for which the string
C<'dgram'> is a convenient shortcut:

 $socket->connect(
    host     => $hostname,
    service  => $service,
    socktype => 'dgram',
    ...