0  #!/usr/bin/perl
  1  # file: eliza_inetd_server.pl
  2  use Chatbot::Eliza;
  3  use IO::Socket;
  4  use POSIX 'WNOHANG';
        
  5  use constant TIMEOUT => 1; # 1 minute default
  6  my $timeout = shift || TIMEOUT;
    
  7  # signal handler for timeout
  8  $SIG{ALRM} = sub { exit 0 };
  9  # signal handler for child die events
 10  $SIG{CHLD} = sub { while ( waitpid(-1,WNOHANG)>0 ) { } };
    
 11  # retrieve socket from STDIN
 12  die "STDIN is not a socket" unless -S STDIN;
 13  my $listen_socket = IO::Socket->new_from_fd(STDIN,"r+") 
 14    || die "Can't create socket: $!";
    
 15  warn "Server ready.  Waiting for connections...\n";   
    
 16  while (my $connection = $listen_socket->accept) {
 17    die "Can't fork: $!" unless defined (my $child = fork());
 18    if ($child == 0) {
 19        alarm(0);
 20        $listen_socket->close;
 21        interact($connection);
 22        exit 0;
 23    }
 24  } continue {
 25      $connection->close;
 26      alarm ($timeout * 60);
 27  }
    
 28  sub interact {
 29    my $sock = shift;
 30    STDIN->fdopen($sock,"r")  || die "Can't reopen STDIN: $!";
 31    STDOUT->fdopen($sock,"w") || die "Can't reopen STDOUT: $!";
 32    STDERR->fdopen($sock,"w") || die "Can't reopen STDERR: $!";
 33    STDOUT->autoflush(1);
 34    Chatbot::Eliza->new->command_interface;
 35  }