The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# Objective:
# ----------
#
# This script will trigger the destructor of still 
# pending events and they should indeed be deleted and
# cleaned up.

use strict;
use warnings;

use IO::Socket;
use Event::Lib;
use Test;

BEGIN {
    plan tests => 6;
}

my $PATH = "t/sock-$$";

my $pid = fork;
die "couldn't fork: $!" unless defined $pid;

$SIG{PIPE} = 'IGNORE';

select STDERR;

unless ($pid) {
    # CHILD
    sleep 1;
    for my $try (1..2) {
	my $real_client = IO::Socket::UNIX->new(Peer => $PATH, Blocking  => 0)
            or die "child: Can't open $PATH: $@";
	$real_client->autoflush(1);
	
        for (1..3) {
            $real_client->syswrite("foobar");
            my $read = $real_client->sysread(my $buf, 1024);
        }
        $real_client->close;
        select undef, undef, undef, 0.5;
    }
    exit;
}
else {
    # PARENT
    my $sock = IO::Socket::UNIX->new(
                    Blocking  => 0,
		    Local     => $PATH,
                    Listen    => 1,
                ) or die "parent: Can't open $PATH: $@";

    $sock->listen() or die $!;

    my $ctx = { sock => $sock };

    my $e = event_new($sock, EV_READ|EV_PERSIST, \&handle_incoming, $ctx);
    $ctx->{incoming_event} = $e;
    $e->add;
    event_mainloop();
    wait;
}

sub handle_incoming {
    my ($e, $e_type, $ctx) = @_;

    $ctx->{fh}->close if exists $ctx->{fh};
    
    $ctx->{fh} = $ctx->{sock}->accept() or die $!;

    $ctx->{read_event}  = event_new($ctx->{fh}, EV_READ,  \&do_read,  $ctx);
    $ctx->{write_event} = event_new($ctx->{fh}, EV_WRITE, \&do_write, $ctx);

    $ctx->{read_event}->add;
}

my $ok = 0;
sub do_read {
    my ($e, $e_type, $ctx) = @_;
    my $read = sysread($ctx->{fh}, my $buf, 1024);
    if (defined $read) {
        if ($read) {
            $ok++;
            ok($buf, "foobar");
            $ctx->{write_event}->add;
            exit if $ok == 6;
        }
        else {
            return;
        }
    }
    else {
        return;
    }
}

sub do_write {
    my ($e, $e_type, $ctx) = @_;
    my $sent = syswrite($ctx->{fh}, "ok", 2, 0);
    unless (defined $sent) {
        return;
    }
    $ctx->{read_event}->add;
}

END {
    unlink $PATH;
}