select.pl

#!/usr/bin/env perl
use strict;
use warnings;
use Data::Dumper;
use Socket;
use IO::Handle;
use autodie;
use 5.12.1;

my $port = 5001;

socket(my $waiting, PF_INET, SOCK_STREAM, 0);
setsockopt($waiting, SOL_SOCKET, SO_REUSEADDR, 1);
bind($waiting, pack_sockaddr_in($port, INADDR_ANY));
listen($waiting, SOMAXCONN);

say 'Accepting connections at 127.0.0.1:5001';

my $sockets = {};
my $client_num = 0;

my $rin = set_bits($waiting);
while (1) {
    my $rout = $rin;
    my $ret = select($rout, undef, undef, undef);

    # connecting new clinet
    if (vec $rout, fileno($waiting), 1) {
        my $new_socket;
        my $sockaddr = accept $new_socket, $waiting;
        my ($port, $iaddr) = unpack_sockaddr_in($sockaddr);
        my $hostname = gethostbyaddr($iaddr, AF_INET);
        my $ip = inet_ntoa($iaddr);

        say ": connected $hostname ($ip) : $port";
        $new_socket->autoflush;
        $sockets->{$new_socket} = {
            sock => $new_socket,
            port => $port,
            ip   => $ip,
            host => $hostname,
        };

        $rin = set_bits($waiting, map { $_->{sock} } values %$sockets);
        $client_num++;
    }
    # readed data
    elsif ($ret) {
        for my $socket (values %$sockets) {
            my $sock = $socket->{sock};
            if (vec $rout, fileno($sock), 1) {
                if (my $in = <$sock>) {
                    printf ': from %s (%s) : %s - %s', @$socket{qw/host ip port/}, $in;
                    print {$sock} $in;
                }
                else {
                    say sprintf ': closed %s (%s) : %s', @$socket{qw/host ip port/};
                    close $sock;
                    delete $sockets->{$sock};
                    $rin = set_bits($waiting, map { $_->{sock} } values %$sockets);
                }
            }
        }
    }
}

sub set_bits {
    my @sockets = @_;
    my $rin = '';
    vec($rin, fileno($_), 1) = 1 for @sockets;
    return $rin;
}

__END__