#!/usr/bin/perl
use strict;
use warnings;

use IO::Socket;
use File::Basename;
use POSIX ":sys_wait_h";

use Communication;

my $Debug = 0;

my $server_port = 4714;

my $server = IO::Socket::INET->new(
    LocalPort => $server_port,
    Type      => SOCK_STREAM,
    Reuse     => 1,
    Listen    => 10,
) or die "Kann keinen TCP-Server an Port $server_port sein: $@\n";
print "Server ", basename($0), " is starting on port $server_port ...\n";

main();
close($server);
exit;


sub main {
    CLIENT: while (my $client = $server->accept()) {
        pipe PREAD, CWRITE; # child -> parent
        chomp(my $input = <$client>);
        print "Client sagt '$input'\n" if $Debug;

        unless ($input eq Communication::RE_REQUEST) {
            print $client Communication::DECLINE, "\n";
        }
        else {
            print $client Communication::ACCEPT, "\n";
            my $timeout = <$client>;
            unless (defined $timeout) {
                warn "Client schickte falsche Daten, Abbruch!\n";
                next CLIENT;
            }
            my $txt     = <$client>;
            unless (defined $txt) {
                warn "Client schickte falsche Daten, Abbruch!\n";
                next CLIENT;
            }
            my $re      = <$client>;
            unless (defined $re) {
                warn "Client schickte falsche Daten, Abbruch!\n";
                next CLIENT;
            }
            chomp ($timeout, $txt, $re);
            unless ($timeout =~ /^\d+$/) {
                warn "Timeoutwert '$timeout' ist keine natürliche Zahl\n";
                next CLIENT;
            }
            print "Client sagt timeout = '$timeout'\n",
                  "Client sagt txt     = '$txt'\n",
                  "Client sagt re      = '$re'\n" if $Debug;
print '.';
            if (my $pid = fork()) {
                parent($pid, $client, $timeout);
            }
            else {
                child($txt, $re);
            }
            
        }
    }
} # sub main


sub child {
    my ($txt, $re) = @_;

    $server->shutdown(0); # nur im Kind schließen

    close PREAD; # child - close parent end of pipe
    #print "child: id $$ dad $parent_pid\n";

    print "child: start of proccess\n" if $Debug;
    use re 'eval';
    if (my @all = $txt =~ /$re/) {
        print CWRITE "$_\n" for $`, $&, $', @all; 
    }
    else {
        print CWRITE "-1\n"; 
    }
    print "child: end of proccess\n" if $Debug;
    exit;
} # sub child


sub parent {
    my ($pid, $client, $timeout) = @_;
    close CWRITE; # parent - close child end of pipes
    print "parent id $$ child $pid\n" if $Debug;

    my @erg;
    eval { 
        local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required
        alarm $timeout;
        while (waitpid($pid, WNOHANG) == 0) {
            #print "parent: kind lebt noch\n";
            #sleep 1;
        }
        alarm 0;
    };
    alarm 0; # Ist das wirklich notwendig?
    if ($@) {
        die "other error : $@"
            unless $@ eq "alarm\n";   # propagate unexpected errors
        warn "parent : child got time out!\n" if $Debug;
        print $client Communication::TIME_OUT, "\n";
    }
    else {
        chomp(@erg = <PREAD>);
        print "parent got ", join(' - ', @erg), "\n" if $Debug;
        if (@erg == 1 and $erg[0] eq -1) {
            print $client Communication::NO_MATCH, "\n";
        }
        else {
            print $client "$_\n" for @erg;
        }
    }
    #kill TERM => $pid; # Kind abschießen (in beiden Fällen, einmal als Zombie,
                       # einmal läuft es noch und verbraucht Rechenzeit)
} # sub parent