#!/usr/bin/perl
#!C:\Programme\Perl\bin\perl.exe

use strict;
use IO::Socket;
use POSIX;
print "--- Perl Forking Server Demo ---\n";

##### Vorgaben #####
my $srv_port = 9991;
my(@array,$count);
$count = 0;

##### Socket #####
my $sock = new IO::Socket::INET(
LocalPort => $srv_port,
Proto => 'tcp',
Listen => SOMAXCONN);
$sock or die "Error: No socket: $!\n";
STDOUT->autoflush(1);
my($csock,$cline,$ppid,$cpid);
$ppid=$$; # parent PID


##### Listen-Schleife #####
while ($csock = $sock->accept()) {
$cpid = fork();
if (!defined($cpid)) {die "Fork error ";}
if ($cpid) {
print "Parent: ppid=$ppid, cpid=$cpid\n";
close $csock;
}
else{ # Child process if cpid=0
print "Child: ppid=$ppid, cpid=$$\n";
close $sock;
$count ++;
print "nr $count - neuer client: " . $csock . "\n";

@array[$count] = $csock;

print $csock "Here is the forking server.\n";
while (defined($cline = <$csock>)) {
$cline=~s/[\x0D\x0A]//g; # trim
print "child cline=<$cline>\n";
if($cline=~m/help/i || $cline=~m/\?/) {
print $csock "help, date, time, quit, stop\n";
}
elsif($cline=~m/date/i) {
print $csock strftime('%Y-%m-%d',localtime(time()))."\n";
}
elsif($cline=~m/time/i) {
print $csock strftime('%H:%M:%S',localtime(time()))."\n";
}
elsif($cline=~m/alert/i) {
  print $sock "ALERT!!!\n";
foreach (@array){
print "$_ ";
}
}
elsif($cline=~m/quit/i) {
print $csock "Quit detected";
print "Client Quit detected\n";
last;
}
elsif($cline=~m/stop/i) {
print $csock "STOP detected";
print "Server STOP detected\n";
kill 9,$ppid;
last;
}
else{print $csock "Unknown: <$cline>\n";}
} # end while
print "Child exit\n";
exit 0;
} # end child process
} # end while accept
print "Never executed\n";