#! perl -slw
use strict;
use IO::Socket;
use IO::Select;
use constant PACKET => pack 'C*', 0 .. 255;

print "Perl -v: ", $];
print "IO::Socket: ", $IO::Socket::VERSION;
print "IO::Select: ", $IO::Select::VERSION;
printf "%s\n", unpack 'H*', PACKET;

my $noBlock = 1;
my $lsn = IO::Socket::INET->new(
    Reuse => 1, Proto => 'tcp', Listen => 100, LocalPort => 12345
) or die "Server failed to create listener: $^E";
print "Listener created";
ioctl( $lsn, 0x8004667e, \$noBlock );
binmode $lsn;

my $sel = IO::Select->new( $lsn );

while( 1 ) {
    warn 'Registered handles:',  $sel->handles;
    warn 'Count: ', $sel->count();
    my @ready = $sel->can_read(10);
    warn "handles ready:[ @ready ]"; <STDIN>;
    for my $ready ( @ready ) {
        if( $ready == $lsn ) {
            my $client = $lsn->accept or next;
            binmode $client;
            ioctl( $client, 0x8004667e, \$noBlock );
            $sel->add( $client );
            warn "Added $client";
        }
        else {
            {
                $ready->recv( my $in, 4, 0 )              or warn( "recv  failed: [$^E]" ), last;
                length $in == 4                           or warn( "Wrong length: [$^E]" ), last;
                my $bytes = unpack 'N', $in;
                $ready->recv( my $dataIn, $bytes, 0 )     or warn( "recv  failed: [$^E]" ), last;
                length $dataIn == $bytes                  or warn( "Wrong length: [$^E]" ), last;
                $dataIn eq PACKET                         or warn( "Data corrupt: [$^E]" ), last;
                printf "Got: (%d) '%s'\n", $bytes, unpack 'H*', $dataIn;
                $ready->send( pack( 'N', 256 ), 0 )       or warn( "Send  failed: [$^E]" ), last;
                $ready->send( $dataIn, 0 )                or warn( "Send  failed: [$^E]" ), last;
            }
            $ready->shutdown( 2 );
            $ready->close;
            $sel->remove( $ready );
            warn "Removed $ready";
        }
    }
}

close $lsn;