#!/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 internal
+ly 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_Cl
+ients{$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$da
+ta \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;
[download]

#!/usr/local/bin/pyrperl -w
#Client
use strict;
use Time::HiRes qw[ time usleep ];
use IO::Socket::INET;

$\ = $/ = chr(13).chr(10);
my $rdata = ""; for ( 0..255) { $rdata .= chr($_); }
my $len = pack 'N',length($rdata);
my $sdata = $len . $rdata;
print length($rdata),"\n";
my $svr = IO::Socket::INET->new( "localhost:12345" )
    or die "Client: First client connect failed $^E";
binmode $svr; $| = 1;
print "Client connected";

    my $last = time + 1; my $exchanges = 0;
    while( 1 )
    {    send( $svr, $sdata, length($sdata), 0 ) or die "$! / $^E";
        my $in;
        recv ( $svr, $in, 4, 0 );
        if ( defined $in )
        {    my $len = unpack('N',$in);
            recv ( $svr, my $data, $len, 0 );
            if ( $rdata ne $data ) { die "3. $! \n"; }
            ++$exchanges; # print "$len\t$exchanges\n";
           if( time > $last )
            {
               my $rate = sprintf( "%.f", $exchanges );
                   print "$$ Rate: $rate exchanges/sec\n";
                $last = time + 1; $exchanges = 0;
            }
        }
   }
[download]