#!/usr/bin/perl
use strict;use warnings;
use IO::Select;
use IO::Socket;
use Data::Dumper;
$Data::Dumper::Terse  = 1;
$Data::Dumper::Useqq  = 1;
$Data::Dumper::Indent = 0;
# unbuffer STDOUT so you can watch the output real time
select STDOUT;$| = 1;

# create a listen socket, on port 7777
my $l = IO::Socket::INET->new( Listen => 1, LocalPort => 7777, 
  ReuseAddr => 1 ) or die("Can't listen: $!\n"); 
# create an IO::Select object
my $sel     = IO::Select->new($l);
my $timeout = 0.1;
my @waiting;
while (1) {
    # @waiting ->  sockets with "something ready to read",
    # (including the listen socket)
    @waiting = $sel->can_read($timeout);
    my $nwaiting = scalar(@waiting);
    printf "%d sockets are readable...\n", $nwaiting;
    if ($nwaiting) {
        foreach my $fh (@waiting) {
            if ( $fh == $l ) {
                # listener has a new connection for us...
                print "\tlistener accepting connection..\n";
                my $newconn = $l->accept();

                # add this new connection to the select mask
                $sel->add($newconn);
            } else {
                # one of the connected clients wrote something to us
                print "\tsocket has unread data\n";
                my $buf;

                # read 255 byte chunk. if they sent more
                # than that, we'll get it the next go-round
                if ( $fh->sysread( $buf, 255 ) ) {
                    printf "\tgot [%s] from socket\n", Dumper($buf);
                } else {
                    # client disconnected
                    print "\t client gone, closing socket\n";
                    $fh->close();
                    $sel->remove($fh);
                }

                # read from $fh here...
            }
        }
    } else {
        print "\tyou could do other stuff here...\n";
    }
    # sleep to avoid a tight loop
    # probably too long for a real app, but useful
    # to watch STDOUT in real time
    sleep(2);
}
[download]