view release on metacpan or  search on metacpan

lib/IO/Handle/Record.pm  view on Meta::CPAN

    my $L=($I->record_opts && $I->record_opts->{local_encoding}) ? 'L' : 'N';
    if( $I->can('expect_fds') ) {
      ($I->expected, $I->expect_fds)=unpack $L.'2', $I->read_buffer;
    } else {
      ($I->expected)=unpack $L.'2', $I->read_buffer;
    }
    $I->read_buffer='';
  }

  my $wanted=$I->expected;
  my $buflen=length($I->read_buffer);
  while( $buflen<$wanted ) {
    my $len=$reader->( $I, $I->read_buffer, $wanted-$buflen, $buflen );

    if( defined $len and $len>0 ) {
      $buflen+=$len;
    } elsif( defined $len ) {	# EOF
      $len=length $I->read_buffer;
      undef $I->read_buffer;
      croak "IO::Handle::Record: premature end of file";
    } elsif( $!==EAGAIN ) {
      return;
    } elsif( $!==EINTR ) {
      next;
    } else {
      undef $I->read_buffer;
      croak "IO::Handle::Record: sysread";
    }
  }

  if( $I->can('expect_fds') and
      $I->expect_fds>0 and defined $I->_received_fds ) {
    $I->received_fds=[splice @{$I->_received_fds}, 0, $I->expect_fds];
  }
  my $rc=eval {
    local $Storable::Eval;
    $I->record_opts and $Storable::Eval=$I->record_opts->{receive_CODE};
    Storable::thaw( $I->read_buffer );
  };
  if( $@ ) {
    my $e=$@;
    $e=~s/ at .*//s;
    croak $e;
  }

  undef $I->expected;
  undef $I->read_buffer;

  return @{$rc};
}

sub write_record {
  my $I=shift;

  my $writer=(issock($I)
	      ? sub { sendmsg( $_[0], $_[1], $_[2], (@_>3?$_[3]:0) ); }
	      : sub { syswrite $_[0], $_[1], $_[2], (@_>3?$_[3]:()); });

  my $can_fds_to_send=$I->can('fds_to_send');
  if( @_ ) {
    croak "IO::Handle::Record: busy"
      if( defined $I->write_buffer );
    my $L=($I->record_opts && $I->record_opts->{local_encoding}) ? 'L' : 'N';
    my $msg=eval {
      local $Storable::Deparse;
      local $Storable::forgive_me;
      $I->record_opts and do {
	$Storable::forgive_me=$I->record_opts->{forgive_me};
	$Storable::Deparse=$I->record_opts->{send_CODE};
      };
      local $SIG{__WARN__}=sub {};
      $L eq 'L'
	? Storable::freeze \@_
	: Storable::nfreeze \@_;
    };
    if( $@ ) {
      my $e=$@;
      $e=~s/ at .*//s;
      croak $e;
    }

    if( $can_fds_to_send ) {
      $I->write_buffer=pack( $L.'2', length($msg),
			     (defined $I->fds_to_send
			      ? 0+@{$I->fds_to_send}
			      : 0) ).$msg;
    } else {
      $I->write_buffer=pack( $L.'2', length($msg), 0 ).$msg;
    }
    $I->written=0;
  }

  my $written;

  # if there are file descriptors to send send them first along with the length
  # header only. (work around a bug in the suse 11.1 kernel)
  if( $I->written==0 and
      $can_fds_to_send and
      defined $I->fds_to_send and
      @{$I->fds_to_send} ) {
    while(!defined ($written=$writer->($I, $I->write_buffer, HEADERLENGTH))) {
      if( $!==EINTR ) {
	next;
      } elsif( $!==EAGAIN ) {
	return;
      } else {
	croak "IO::Handle::Record: syswrite";
      }
    }
    $I->written+=$written;
  }

  while( $I->written<length($I->write_buffer) and
	 (defined ($written=$writer->($I, $I->write_buffer,
				      length($I->write_buffer)-$I->written,
				      $I->written)) or
	  $!==EINTR) ) {
    if( defined $written ) {
      $I->written+=$written;
    }
  }

lib/IO/Handle/Record.pm  view on Meta::CPAN

=item B<@data=$handle-E<gt>read_record>

reads one record of perl data structures.

On success it returns the record as list. An empty list is returned if
C<$handle> is in non blocking mode and not enough data has been read.
Check $!==EAGAIN to catch this condition. When the handle becomes ready
just repeat the operation to read the next data chunk. If a complete record
has arrived it is returned.

On EOF an empty list is returned. To distinguish this from the non blocking
empty list return check C<$handle-E<gt>end_of_input>.

EINTR is handled internally.

Example:

 ($array, $sub, $hash)=$handle->read_record;

=item B<$handle-E<gt>end_of_input>

When an end of file condition is read this is set to true.

=item B<($pid, $uid, $gid)=$handle-E<gt>peercred>

B<ONLY FOR UNIX DOMAIN SOCKETS ON LINUX>

Return the PID, eUID and eGID of the peer at the time of the connect.

=item B<$handle-E<gt>read_buffer>

=item B<$handle-E<gt>expected>

=item B<$handle-E<gt>expect_fds>

=item B<$handle-E<gt>_received_fds>

=item B<$handle-E<gt>write_buffer>

=item B<$handle-E<gt>written>

these methods are used internally to provide a read and write buffer for
non blocking operations.

=back

=head2 Exceptions

=over 4

=item * C<IO::Handle::Record: sysread>

thrown in C<read_record>. Check C<$!> for more information.

=item * C<IO::Handle::Record: premature end of file>

thrown in C<read_record> on end of file if according to the internal
protocol more input is expected.

=item * C<IO::Handle::Record: busy>

thrown in C<write_record> if a non-blocking write is not yet finished. There
may be only one write operation at a time. If that hits you organise a queue.

=item * C<IO::Handle::Record: syswrite>

thrown in C<write_record> on an error of the underlying transport method.
Check C<$!> for more information.

=item * Other exceptions

thrown in C<read_record> and C<write_record> if something cannot be encoded
or decoded by the C<Storable> module. If that hits you the C<Storable> module
at one side is probably too old.

=back

=head2 EXPORT

None.

=head1 Data Transfer Format

The Perl data is serialized using Storable::freeze or Storable::nfreeze.
Storable::freeze is used if the C<local_encoding> option is set,
Storable::nfreeze otherwise.

The length in bytes of this data chunk and the number of file handles
that are passed along with the data are then each C<pack()>ed as a 4 byte
binary value using the C<L> or C<N> template. C<L> is used of C<local_encoding>
is in effect.

If there are file descriptors to be passed they are sent by a separate
sendmsg call along with 2 length fields only.

Both fields is the prepended to the data chunk:

 +-----------------+------------------------+
 | data length (N) | number of file handles |
 | 4 bytes         | 4 bytes                |
 +-----------------+------------------------+
 |                                          |
 |                                          |
 |                                          |
 |                                          |
 |                   data                   |
 |                                          |
 |                 N bytes                  |
 |                                          |
 |                                          |
 |                                          |
 |                                          |
 |                                          |
 +------------------------------------------+

B<WARNING:> The transfer format has changed in version 0.07 (never made it
to CPAN) and again in version 0.08.

=head1 TODO