#!/usr/bin/perl

#use strict;

use POSIX ":sys_wait_h";
use IPC::Open2;
use Time::Local;
use FileHandle;
use XML::Generator;

use FindBin qw($Bin $Script);

use AppConfig qw/:argcount :expand/;

my $home = $ENV{'HOME'};

sub REAPER {
    my $waitedpid = wait;
}

$SIG{CHLD} = \&REAPER;


######################################################################
# Reading configuration and options

my $config = AppConfig->new({ CREATE => '_(cmd|options|label|lexer|forest|examples)',
			      GLOBALS => { ARGCOUNT => ARGCOUNT_ONE
				       }
			      },
			    "setsid!"      => { DEFAULT  => 1 },
			    "path=f@"      => { DEFAULT  => [ qw{/usr/ucb /bin} ] },
			    "logfile=f"    => { DEFAULT  => '/tmp/dyalog_server.log' },
			    "maxclients=i" => { DEFAULT => 5 },
			    "port=i"       => { DEFAULT => 8999 },
			    "parsers=s",
			    ## options
			    "verbose|v!",
			    #"file|f",
			    "out|o",
			    "xml|x",
			    "from|f=s"     => { DEFAULT  => 1 },
			    "to|t=s"       => { DEFAULT  => 10 },
			    "step|s=s"     => { DEFAULT  => 1 },
			    "parser|p=s",
			    "sentence|s",
			    "patfile=s",
			    );

# read configuration file
$config->file("$Bin/parserd.conf") || die "can't open configuration file";


my %parser = ();

my %cfg = (
	   'cmd' => { 'mandatory' => 1},
	   'label' => { 'mandatory' => 1},
	   'options' => { 'default' => [], 
			  'action' => \&split_options},
	   'forest' => { 'default' => 'lp' },
	   'examples' => { 'action' => \&open_examples},
	   'lexer' => { 'default' => \&lexer, 
			'action' => \&get_lexer}
	   );

foreach my $parser (split(/\s+/,$config->parsers())) {
    my %info = ();
    my %tmp = $config->varlist("^".$parser."_",1);
    foreach my $key (keys %cfg) {
	my $cfg = $cfg{$key};
	if ( defined($cfg->{'mandatory'}) && !defined $tmp{$key}) {
	    die "Missing mandatory information for parser=$parser and key=$key";
	} elsif ($tmp{$key}) {
	    my $val = $tmp{$key};
	    $val = &{$cfg->{'action'}}($val,\%info) if (defined $cfg->{'action'});
	    $info{$key} = $val;
	} elsif (defined $cfg->{'default'}) {
	    $info{$key} = $cfg->{'default'};
	} 
    }
    $parser{$parser} = { %info };
}

######################################################################
# patterns

my %patterns = (
	     'de' => q/"Yves aime " . ("la fille de " x $n) . "Sabine"/,
	     'qui' => q/"Yves regarde Sabine " . ("qui regarde Yves qui regarde Sabine " x $n)/,
	     'quide' => q/"Yves " . ("qui regarde Sabine qui regarde Yves " x $n) . "aime " . ("la fille de " x $n) . "Sabine"/,
	     'deinqui' => q/"Yves regarde " . ("la fille de " x $n) . "Sabine " . (("qui regarde Yves qui regarde " . ("la fille de " x $n) . "Sabine ") x $n) /
	     );

######################################################################
# Reading options

$ENV{TIME} = 'time %U';
$ENV{LC_ALL} = 'C';

my $from    = $config->from;
my $to      = $config->to;
my $step    = $config->step;
my $pattern;
my @parsers = ();

$pattern    = $config->sentence unless (!$config->sentence);

my $patfile = $config->patfile;
open(PATTERNS,"<$patfile") || die "can't open pattern file $patfile";
while(<PATTERNS>) {
    next unless /^(\w+)\s*:\s*(.*)/;
    $patterns{$1} = $2;
}
close(PATTERNS);

push(@parsers, $config->parser);


my @parsers = sort @parsers;

#push(@ARGV,$opt_f) if (defined $opt_f);

my $x = new XML::Generator;

my $id=0;

my $date = localtime();

   print <<EOF ;
<?xml version="1.0"?>
<!DOCTYPE stats SYSTEM "stats.dtd,xml">
<stat date="$date">
EOF

foreach my $parser (@parsers){
    print <<EOF;
    <parser name="$parser">$parser{$parser}->{label}</parser>
EOF
}

    print "\t<latence>\n";
foreach my $parser (@parsers) {
    local $cmd = $parser{$parser}{'latence'};
    local $time = 0;
    local $repeat = 0;
    while ($time < 10 && $repeat < 10){
	local $pid = open2(*CMD, *WRITER,
			   "time $parser{$parser}->{cmd} @{$parser{$parser}->{options}} 2>&1 >/dev/null"
			   ) || die "couldn't run parser";
	close WRITER || die "cannot close: $!";
	waitpid($pid,0);
	my %info = split(/\s+/,<CMD>);
	$time += $info{time};
	$repeat++;
	close(CMD) || die "cannot close: $!";
    }
    $time = POSIX::ceil($time / $repeat * 1000);
    print "\t\t<parser name=\"$parser\">$time</parser>\n";
    $parser{$parser}{'clatence'} = $time;
}
print "\t</latence>\n";

if ($pattern) {
    run_pattern();
} else {
    run_sentences();
}

sub run_pattern {
    for (my $i=$from ; $i <= $to ; $i += $step, $id++) {
	my $sentence=&build_sentence($pattern,$i);
	print "\t<entry>\n";
	print "\t\t<sentence id=\"$id\">$sentence</sentence>\n\t\t<n>$i</n>\n";
	map( &treat_sentence($sentence,$_), @parsers );
#    map( &treat_sentence($sentence,$_), 'gxtag' );
	print "\t</entry>\n";
    }
}

sub run_sentences {
    my $id=0;
    while (<>) {
	next unless (/^[a-zA-Z]/);
	chop;
	my $sentence=$_;
	$i++;
	print "\t<entry>\n";
	print "\t\t<sentence id=\"$i\">$sentence</sentence>\n";
	map( &treat_sentence($sentence,$_), @parsers );
#    map( &treat_sentence($sentence,$_), 'gxtag' );
	print "\t</entry>\n";
    }
}

print "</stat>\n";

sub treat_sentence{
    local ($sentence,$parser)=@_;
    local $cmd=join(' ',@{$grammars{$grammar}{'lexer'}}) 
	. " | " 
	    . join(' ','time',$grammars{$grammar}{'cmd'},@{$grammars{$grammar}{'options'}},'-');
    # this seems to be necessary
#    print "$cmd\n";
    local $time=0;
    local $repeat=0;
    while ($time < 10 && $repeat < 10) {
	local $pid = open2(*READER, *WRITER,
			   "time $parser{$parser}->{cmd} @{$parser{$parser}->{options}} 2>&1 >/dev/null"
			   ) || die "couldn't run parser";
	&{$parser{$parser}->{lexer}}(*WRITER,$sentence,$parser);
	close WRITER || die "cannot close: $!";
	waitpid($pid,0);
#    print "TRUE\n" if (<READER> =~ /Answer/);
	my %info = split(/\s+/,<READER>);
	$time += $info{'time'};
	$repeat++;
	close READER || die "cannot close: $!";
    }
    $time = POSIX::ceil($time / $repeat * 1000);
    if (defined $parser{$parser}{'clatence'}) {
	$time -= $parser{$parser}{'clatence'} ;
	print "\t\t<parser name=\"$parser\" latence=\"$parser{$parser}{'clatence'}\">$time</parser>\n";
    } else {
	print "\t\t<parser name=\"$parser\">$time</parser>\n";
    }
}

sub lexer {
    local *WRITER = shift;
    my $sentence = shift;
    my $i = 0;

    foreach ($sentence =~ /\S+/g) {
        last if (/\#/);
        if (/^(\d+)$/) {
            print WRITER "'C'($i,$1,",++$i,").\n";
        } else {
            print WRITER "'C'($i,'",$_,"',",++$i,").\n" ;
        }
    }
    print WRITER "'N'(",$i,").\n";
}

sub remote_lexer {
    local *WRITER = shift;
    my $sentence = shift;
    my $parser = shift;
    my @lexer = @{$parser{$parser}{'remote_lexer'}};
    $| = 1; # $| = 0; # Flush
    open2(*LEXOUT,*LEXIN,"@lexer 2> /dev/null") || die "couldn't run lexer";
    print LEXIN "$sentence";
    close LEXIN || die "can't close: $!";
    print WRITER <LEXOUT>;
    close LEXOUT || die "can't close: $!";
}

sub build_sentence {
    my ($pattern,$n) = @_;

    return eval($patterns{$pattern}) if (defined $patterns{$pattern});

    die "Not a valid id for a sentence pattern";
}

######################################################################
# Handling configuration file

sub split_options {
    my $options = shift;
    return [ split(/\s+/,$options) ];
}

sub get_lexer {
    my $lexer = shift;
    my $info = shift;
    my @lexer = split(/\s+/,$lexer);
    $lexer = shift @lexer;
    if ($lexer eq 'default') {
	return \&lexer;
    } elsif ($lexer eq 'remote') {
	$info->{'remote_lexer'} = [ @lexer ] ;
	return \&remote_lexer;
    } elsif ($lexer eq 'dummy') {
	return \&dummy_lexer;
    } else {
	die "bad configuration file";
    }
}

sub notify_cfg {
    my $state = shift;
    my $var   = shift;
    my $val   = shift;
    
    print "$var set to $val\n";
}

sub open_examples {
    my $file = shift;
    open(EXAMPLES,"<$file") || return [];
    my @sentences = ();
    while (<EXAMPLES>) {
	next if (/^\d*\s*$/);
	next if (/^\#/);
	push(@sentences, clean_sentence($_));
    }
    return [@sentences];
}

sub clean_sentence {
    my $sentence=shift;
    $sentence =~ s/\s+/ /og;
    $sentence =~ s/^\s+//og;
    $sentence =~ s/\s+$//og;
    return $sentence;
}

######################################################################
# Lexers

sub dummy_lexer {
    local *WRITER = shift;
    my $sentence = shift;
    print WRITER "$sentence";
}

sub lexer {
    
    local *WRITER = shift;
    my $sentence = shift;
    my $i = 0;

    foreach ($sentence =~ /\S+/g) {
        last if (/\#/);
        if (/^(\d+)$/) {
            print WRITER "'C'($i,$1,",++$i,").\n";
        } else {
            print WRITER "'C'($i,'",$_,"',",++$i,").\n" ;
        }
    }
    print WRITER "'N'(",$i,").\n";
}

sub remote_lexer {
    local *WRITER = shift;
    my $sentence = shift;
    my $parser = shift;
    my @lexer = @{$parser{$parser}{'remote_lexer'}};
    $| = 1; # $| = 0; # Flush
    open2(*LEXOUT,*LEXIN,@lexer) || die "couldn't run lexer";
    print LEXIN "$sentence";
    close LEXIN || die "can't close: $!";
    print WRITER <LEXOUT>;
    close LEXOUT || die "can't close: $!";
}


