The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use Test::More;
use Test::Deep;
use Data::Dumper;
$Data::Dumper::Deparse=1;
use IO::Handle::Record;
use IO::Socket::UNIX;
use IO::Select;
use Errno qw/EAGAIN/;

#########################

sub check_afunix {
  my ($r, $w);
  return unless eval {
    socketpair $r, $w, AF_UNIX, SOCK_STREAM, PF_UNSPEC and
      sockaddr_family( getsockname $r ) == AF_UNIX
  };
}

if( check_afunix ) {
  plan tests=>7;
} else {
  plan skip_all=>'need a working socketpair based on AF_UNIX sockets';
}

my ($p, $c)=IO::Socket::UNIX->socketpair( AF_UNIX,SOCK_STREAM,PF_UNSPEC );
my $pid;
while( !defined( $pid=fork ) ) {select undef, undef, undef, .1}

if( $pid ) {
  close $c; undef $c;
  my $got;
  $p->blocking(0);
  my $sel=IO::Select->new($p);

  my $again=0;
  $p->fds_to_send=[map {open my($fh), $_; $fh} 'Changes', 'MANIFEST'];
  if( $sel->can_write and !$p->write_record( ('xyzabc123')x90000 ) ) {
    $again++;
    while( $sel->can_write and !$p->write_record ) {
      $again++;
    }
  }
  print "# again=$again\n";

  $p->blocking(1);
  ($got, my $nremaining_fds, my $filecontent)=$p->read_record;
  cmp_deeply $got, code(sub {
			  $_[0] eq 'xyzabc123'x90000
			    ? 1
			    : "expected 90000 repetitions of 'xyzabc123'"}),
             'nonblocking write';

  # cmp_deeply $again, code(sub{$_[0]>0 ? 1 : (0, "expected >0, got $_[0]")}),
  #            'again>0';

  cmp_deeply $filecontent, [map {
    local $/;
    my $f;
    open $f, $_ and scalar <$f>;
  } 'Changes', 'MANIFEST'], 'file content';

  cmp_deeply $nremaining_fds, 0, "no remaining fds in _remaining_fds";


  # pass another record without files

  $p->blocking(0);

  $again=0;
  if( $sel->can_write and !$p->write_record( ('cba321zyx')x90000 ) ) {
    $again++;
    while( $sel->can_write and !$p->write_record ) {
      $again++;
    }
  }
  print "# again=$again\n";

  $p->blocking(1);
  ($got, $nremaining_fds, $filecontent)=$p->read_record;

  cmp_deeply $got, code(sub {
			  $_[0] eq 'cba321zyx'x90000
			    ? 1
			    : "expected 90000 repetitions of 'cba321zyx'"}),
             'nonblocking write (2)';

  # cmp_deeply $again, code(sub{$_[0]>0 ? 1 : (0, "expected >0, got $_[0]")}),
  #            'again>0';

  cmp_deeply $filecontent, [], 'empty file content';

  cmp_deeply $nremaining_fds, 0, "no remaining fds in _remaining_fds";

  close $p; undef $p;
  wait;
  cmp_deeply $?, 0, 'wait for child';
} else {
  close $p; undef $p;
  select undef, undef, undef, 0.5;
  while( my @l=$c->read_record ) {
    local $/;
    my @fds=@{$c->received_fds || []};
    $c->write_record( join('', @l),
		      0+@{$c->_received_fds}, [map {scalar <$_>} @fds] );
  }
  exit 0;
}

# Local Variables: #
# mode: cperl #
# End: #