#!/usr/local/bin/pyrperl -w
### Server
use strict;
use warnings;

use IO::Socket::INET;
use IO::Select;

# flush after every write
    $| = 1;

$SIG{PIPE} = 'IGNORE';
our ( $socket, $select, @ready_clients, %All_Clients );

my $localhost = '127.0.0.1'; my $port = 12345;

# creating object interface of IO::Socket::INET modules which internally does
# socket creation, binding and listening at the specified port address.
    $socket = new IO::Socket::INET (
                                        LocalHost => $localhost,
                                        LocalPort => $port,
                                        Proto => 'tcp',
                                        Listen => 5,
                                        Reuse => 1,
                                    ) or die "ERROR in Socket Creation : $!\n";

    $socket->autoflush;
    binmode $socket; $| = 1;
    $select = new IO::Select() or die "IO::Select $!";
    $select->add($socket);        # add the main socket to the set

    $All_Clients{$socket} = 1;
    print "SERVER Waiting for client connection on port $port\n";
    my $rdata = ""; for ( 0..255) { $rdata .= chr($_); }
    my $len = pack 'N',length($rdata);
    my $sdata = $len . $rdata;
    my $start = 0; my $finish = 0; my $tasks = 0;

    while(1)
    {
        my @ready = $select->can_read(.025);
        foreach my $client (@ready)
        {
            if ( $client == $socket )        #{ next; }
                                            #    if ( ! exists $All_Clients{$client} )
            {    # Create a new socket
                my $new = $client->accept();
                #    binmode $new; $| = 1;
                 $select->add($new); $All_Clients{$new} = 1;
                    $start++; $tasks++; print "  Client connected\n";
            }
            else
            {    # Process socket
                my $lost = 0;
                my $ret = recv( $client, my $in, 4, 0 );
                if ( ! defined $ret ) { $lost++; }
                if ( ( $lost==0 )&&( length($in)==4 ) )
                {    my $len = unpack('N',$in);            #    print "**** received ****\n";
                    $ret = recv( $client, my $data, $len, 0 );
                    if ( ! defined $ret ) { $lost++; }
                    if ( $lost==0 )
                    {    if ( $rdata ne $data ) { die "3.\n$rdata\n$data \n"; }
                        $ret = send( $client,  $sdata, length($sdata), 0 );
                        if ( ! defined $ret ) { $lost++; }
                    }
                }
                if ( $lost > 0 )
                 {    # Maybe we have finished with the socket
                    $select->remove($client);
                    $client->close;
                    $tasks--; my $total = $select->count();
                    print "  Client dis-connected, $tasks left  $total\n";
                }
            }
        }
        my $total = $select->count();
        if ( ( $start )&&( $total == 1 ) )
        {    if ( $finish == 0 ) { $finish = time; }
            else
            {    if ( time - $finish > 3 ) { exit; }
            }
        }
    }

exit;