#!/usr/bin/perl


#!! use strict;
#!! use warnings;

use IO::Socket;
use IO::Handle;

use Sys::Hostname;
use POSIX qw(:sys_wait_h);

#++  see advice of other monks regarding REAP (not applied here)
#++2 just to clarify, THIS is YOUR version of sub REAP ;-) (well, warn
+(..) added for debugging purpose)
#++3 please study "perldoc perlipc" carefully - it holds a full sample
+ of a spawning server, that you 
#++3 could easily adapt - or see CPAN Net::Server (i.e.)
sub REAP {
  warn("REAP... \n"); #++
  1 until (-1 == waitpid(-1, WNOHANG));
  $SIG{CHLD} = \&REAP;
}
$SIG{CHLD} = \&REAP;


#--(this would create/destroy the sever socket - don't!)
#--    while (1) {
  my $sock = new IO::Socket::INET (
                   LocalHost => 'localhost',
                   LocalPort => '1818',
                   Proto => 'tcp',
                   Listen => 255,
                   Reuse => 1,
                   Timeout => '15',);
  $sock or die "no socket :$!";
  STDOUT->autoflush(1);
  my($new_sock, $buf, $kid);


#--  while ($new_sock = $sock->accept()) {
while (1) { #++  endlessly accept new connections 
            #++  accept() blocks or timeouts after 15s (here)
  warn ("Sever waiting...\n"); #++
  if ($new_sock = $sock->accept()) { #++
    $new_sock->autoflush(1);
    warn "New client...\n"; #++
    # execute a fork, if this is
    # the parent, its work is done,
    # go straight to continue
    next if $kid = fork;
    die "fork: $!" unless defined $kid;
    # child now...
    # close the server - not needed
#--(you want the server socket to survive!)
#--    close $sock ;

    warn("Child ($$) reading...\n"); #++
    while (defined($buf = <$new_sock>)) {

#---- removed distracting stuff

      #++ minimum functionality added
      print $new_sock "ECHO ($$): $buf\n"; #++
      last if $buf =~ /quit/;              #++

    $new_sock->flush;

#-- Alas! Code formatting, Grashopper!
#--      }
    }
    warn "Child ($$) quits.\n"; #++
    close $new_sock; #++ (well, explicite here since exit() would clos
+e() it for you...)
    exit;
#--  } continue {
    # parent closes the client since
    # it is not needed
#--    close $new_sock;
  } else { #++
    #++ Check if a problem occured or a signal was received...(see per
+lipc).
    #++ Since Timeout=>15, this will be visited every 15s! Chose Timeo
+ut=>undef
    #++ to block the server unless a client wants to connect (is accep
+t()'ed).
    warn "Server: $!\n"; #++
  }#++


#--  close($new_sock);
}
[download]