The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use warnings;

use Carp qw(croak);
use Log::Dispatch;
use IO::Select;
use IO::Socket::INET;
use Readonly;
use Socket qw(SOCK_DGRAM);

use Test::More tests => 3;

Readonly::Scalar my $PORT_NUMBER    => 9000;
Readonly::Scalar my $BIND_ADDRESS   => '127.0.0.1';
Readonly::Scalar my $MESSAGE_LENGTH => 8192;
Readonly::Scalar my $TIMEOUT        => 2;

sub perform_udp_listen {
    my ( $callback ) = @_;

    my $pid = fork;
    if($pid) {
        my $sock = IO::Socket::INET->new(
            Proto     => 'udp',
            Type      => SOCK_DGRAM,
            LocalHost => $BIND_ADDRESS,
            LocalPort => $PORT_NUMBER,
        );
        my $select = IO::Select->new;
        my $message;

        croak $! unless $sock;

        $select->add($sock);

        if($select->can_read($TIMEOUT)) {
            $sock->recv($message, $MESSAGE_LENGTH, 0);
        } else {
            kill TERM => $pid;
            $message = undef;
        }

        waitpid $pid, 0;

        return $message;
    } elsif(defined $pid) {
        sleep 1; # give the parent time to establish a listening socket

        $callback->();

        exit 0;
    } else {
        croak $!;
    }
}

sub expect_message {
    my ( $expected_message, $callback, $name ) = @_;

    local $Test::Builder::Level = $Test::Builder::Level + 1;

    my $message = perform_udp_listen($callback);

    if(defined $message) {
        is $message, $expected_message, $name;
    } else {
        fail 'timeout';
    }
}

sub expect_timeout {
    my ( $callback, $name ) = @_;

    local $Test::Builder::Level = $Test::Builder::Level + 1;

    my $message = perform_udp_listen($callback);

    if(defined $message) {
        fail 'timeout expected';
    } else {
        pass $name;
    }
}

expect_message 'test message', sub {
    my $log = Log::Dispatch->new(
        outputs => [
            [ 'UDP',
               host      => $BIND_ADDRESS,
               port      => $PORT_NUMBER,
               min_level => 'info',
            ],
        ],
    );

    $log->info('test message');
};

expect_message "test message\n", sub {
    my $log = Log::Dispatch->new(
        outputs => [
            [ 'UDP',
               host      => $BIND_ADDRESS,
               port      => $PORT_NUMBER,
               min_level => 'info',
               newline   => 1,
            ],
        ],
    );

    $log->info('test message');
};

expect_timeout sub {
    my $log = Log::Dispatch->new(
        outputs => [
            [ 'UDP',
               host      => $BIND_ADDRESS,
               port      => $PORT_NUMBER,
               min_level => 'error',
               newline   => 1,
            ],
        ],
    );

    $log->info('test message');
};