#!/usr/bin/perl

use warnings;
use strict;

use IO::Socket;
use IO::Select;
use POSIX qw( BUFSIZ );

my $ALIVE = 1;
$SIG{ INT } = sub { warn "killed by interupt"; $ALIVE--; };

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

my $server = IO::Socket::INET->new(
               Listen => 1,
               LocalPort => 8080,
             ) or die $@;

$sock_group->add( $server );

while ( $ALIVE ) {

  foreach my $sock ( $sock_group->can_read() ) {

    if ( $sock == $server ) {
      $sock_group->add( $server->accept() );
    } else {

      # first we try to read
      my $buf;
      my $rrv = sysread( $sock, $buf, BUFSIZ );

      # if there is a read error
      unless ( $rrv ) {
        # we first report the error
        if ( $rrv == 0 ) {
          warn "$sock reached end of file";
        } elsif ( not defined $rrv ) {
          warn "$sock had error: $!";
        } else {
          warn "sock had an untrappable error";
        }
        # and then remove the socket from our set
        $sock_group->remove( $sock );
        $sock->close();
        next;
      }

      # echo back what was said
      my $wrv = syswrite( $sock, $buf );
      unless ( $wrv == length( $buf ) ) {
        if ( defined $wrv ) {
          warn "incomplete write on $sock";
        } else {
          warn "write had error: $!";
        }
        $sock_group->remove( $sock );
        $sock->close();
      }
    }

  }

}