Here's a threaded solution. It seems to handle pretty much everything I've thought to throw at it with near instant response times.

I've segregated the code into server and client scripts as it allows me to see the cpu load and memory consumption of the server separate from the clients that would normally be on the other machines. It also make it easier to develop.

Despite their relatively small combined size, between them the do everything your code above does (I think).

Server:

#! perl -slw
use strict;
use threads;
use threads::shared;
use IO::Socket::INET;

my %db :shared;
async {
    my $tid = threads->self->tid;
    warn "$tid: In-bound server running\n";

    my $receiver = IO::Socket::INET->new(
        Proto => 'udp', LocalAddr => '127.0.0.1:12345', ReuseAddr => 1
+,
    ) or warn 'No $socket: ', $!;

    while( 1 ) {
        $receiver->recv( my $message, 4096, );
        my $time = time;
        warn $tid, ' adding message ', $message, ' time ', $time;
        {
            lock %db;
            $db{ $time } = $message;
        }
    }
    warn "$tid: In-bound server stopping\n";
}->detach;

my $sender = IO::Socket::INET->new(
    Proto => 'tcp', LocalAddr => '127.0.0.1:54321',
    Listen => 50, ReuseAddr => 1,
) or die 'No $socket: ', $!;

my $running :shared = 0;
while( 1 ) {
    warn 'TOL';
    async {
        warn"before lock";
        { lock $running; ++$running ; }
        warn"after lock";
        my $tid = threads->self->tid;
        warn "$tid: Out-bound server running\n";

        for( 1 .. 1000 ) {
            my $client = $sender->accept;
            warn "$tid: Out: Connection on $client\n";
            lock %db;
            $client->send(
                "$tid\n" . join "\n", map{ "$_ -> $db{ $_ }" } keys %d
+b
            );
        }
        warn "$tid: Out-bound server ending\n";
        { lock $running; --$running; }
    }->detach;
    warn "running: $running";
    sleep 1 while $running > 19;
    warn 'looping';
}
[download]

client

#! perl -slw
use strict;
use threads;
use threads::shared;
use IO::Socket::INET;

async {
    while( 1 ) {
        my $socket = IO::Socket::INET->new(
            PeerAddr => '127.0.0.1:54321',
        ) or warn 'No $socket: ', $! and sleep 1 and next;
        $socket->recv( my $message, 4096 );
        Win32::Sleep( ( 100, 200, 300, 400, 500 )[ rand 3 ] );
    }
    sleep 1;
}->detach for 1 .. 40;

while( <STDIN> ) {
    chomp;
    if( m[^msg: \s* (.*) \s* $ ]x ) {
        my $socket = IO::Socket::INET->new(
            Proto     => 'udp',
            PeerAddr  => '127.0.0.1:12345',
            ReuseAddr => 1,
        ) or warn 'No socket: ', $! and next;
        $socket->send( $1 || 'A standard message' );
    }
    elsif( m[^dump] ) {
        my $socket = IO::Socket::INET->new(
            PeerAddr => '127.0.0.1:54321',
        ) or warn 'No socket: ', $! and next;
        $socket->recv( my $message, 4096 );
        print $message;
    }
    elsif( m[^listeners: \s* ( \d* ) ]x ) {
        async {
            while( 1 ) {
                my $socket = IO::Socket::INET->new(
                    Proto => 'udp', PeerAddr => '127.0.0.1:54321',
                ) or warn 'No socket: ', $! and next;
                $socket->recv( my $message, 4096 );
                Win32::Sleep( ( 100, 200, 300, 400, 500 )[ rand 3 ] );
            }
        }->detach for 1 .. $1 || 10;
    }
    else {
        print "Unknown command '$_'\n";
        print <<'HELP';
msg: message text
listeners: nn
dump
HELP
    }

}
[download]