#!/usr/bin/perl
#
## descriptioin ############################################
#
# $Id: SIM.pl,v 1.2 2006/11/13 02:32:50 nishi Exp $
#
# to @SIM set SRM_Recog = START
# to @SIM set SRM_Julian = GramJulian/vfr/vfr
# to @SIM set SRM_XML_File = GramJulian/renraku/renraku.xml
# to @SIM set SRM_XML_String = <grammar ....>...</grammar>
#
############################################################
#
# based on:
#	dummy module Ver. 0.31 for IPA	2001.07.04
#	code by matsusita yoshinori,	matsuy@jaist.ac.jp
#	checked on perl version 5.005_03 built for sun4-solaris
#
#	usage: perl DummyModule.pl [initfile]
#	inq Run
#	rep LIVE
#
#	you can change:
#		default init file ---------- $initfile = "filename"
#		switch to verbouse mode ---- $debug = 1
#
#	avaliable property is: AutoOutput
#
############################################################

use strict;
use FileHandle;


## disenable buffer ########################################
#select(STDIN);$|=1;
#select(STDOUT);$|=1;

## grobal valiables ########################################
my( $initfile ) = "sim.init";	#default initialize file
my( $debug ) = 0 ;	# set verbose mode if 1
my( $ModuleVersion ) = "\"SIM Ver. 0.1\"";
my( $ProtocolVersion ) = "\"Protocol Ver. 1.0\"" ;

my( %SLOT );	# normal slot
my( %MACRO );	# macro slot
my( %PROPERTY );	# property

my( %COUNT );	# counter for various action

## main ####################################################
main();
exit 0;

sub main{
	init();	# initialize
	while(<STDIN>){
		analyzetoken($_);	# main process
		$COUNT{"input"}++;
	}
	foreach(sort keys %COUNT){ print_debbug("$_\t$COUNT{$_}\n"); }
}

## initialize process using initfile #######################
sub init{
	print_debbug("initializing...\n");
	analyzetoken("set ModuleVersion = $ModuleVersion\n set ProtocolVersion = $ProtocolVersion\n");	# set ModuleVersion and ProtocolVersion
	$initfile = $ARGV[0] if $ARGV[0];
	analyzetoken("do < $initfile\n");	# initialize by 'do < $initfile'
	foreach(sort keys %SLOT){
		print_debbug("$_ = $SLOT{$_}\n");	# list initialized slot & value for debuging
	}
	print_debbug("initialize completed.\n");
}

## analize command #########################################
sub analyzetoken{
	my($input) = @_;
	my( $command, $slot, $method, $alias, $tail);	# 'set/inq/def/do/...', targetslot, '=/</<<', 'save/rest'
		
	foreach(split("\n", $input)){
		s;#.*$;; ;	# delete comment
		next if m;^\s*$; ;	# ignore empty line

		if( m;\b(set|def|prop)\s+(\S+)\s*(=|<<|<)\s*(.*)\s*$;	){	# for type 'command slot method ...' instanse: set/def/prop
			$command = $1;
			$slot = $2;
			$method = $3;
			cmd_method($command, $slot, $method, $4);
		}
		elsif( m;\b(save|rest)\s+(\S+)\s+(\S+); ){	# for type 'command slot alias' instance: save/rest
			$command = $1;
			$slot = $2;
			$alias = $3;
			cmd_alias($command, $slot, $alias);
		}
		elsif( m;\b(inq|del)\s+(\S+); ){	# for type 'command slot' instanse: inq/do/del
			$command = $1;
			$slot = $2;
			cmd_slot($command, $slot);
		}
		elsif( m;\b(do)\s+(.*)$; ){	# for valiable args ex 'do slot ...'
			$command = $1;
			$tail = $2;
			cmd_valiableargs($command, $tail);
		}
		else{ print_tell("'$_' no match\n"); }	# parse error
	}
}

## customized output #######################################

sub print_rep{ print("rep @_"); STDOUT->flush(); $COUNT{"rep"}++;}	# rep output
sub print_tell{ print("tell @_"); STDOUT->flush(); $COUNT{"tell"}++;}	# tell output

sub print_debbug{
	$COUNT{'debugout'}++;
	print( STDERR "From \@SIM tell debug$COUNT{'debugout'}:@_") if $debug ;	# debug out
}

## check slot existance ####################################

sub check_slot{
	my($slotname, $type) = @_;
	if( exists $$type{$slotname} ){ return 1;}	# check $slotname existance
	else{ print_tell("invalid slot $slotname\n"); return 0; }	# if nomatch
	$COUNT{"check_slot"}++;
}

## command set/def/prop 'set Run=INIT' #####################
sub cmd_method{
	my($command, $slot, $method, $tail) = @_;
	my($value);	# values to set
	my($target);	# target slot
	
	if($method eq "="){	# single line input
		$value = $tail;
	}
	elsif($method eq "<"){	# file input 'set Run < conf.file'
		my($infile);

		$_ = $tail;
		foreach $infile (split()){
			open(INFILE, $infile) || (print_tell("can not open $infile\n") && next );
			$value .= join('',<INFILE>);	# read content of $infile
			close(INFILE);
		}
	}
	elsif($method eq "<<"){	# multiline input 'set Run << END ...'
		my($endmarker);	# endmarker

		$endmarker = $tail;
		while(<STDIN>){
			last if m;$endmarker; ;	# read until endmarker
			$value .= $_;	# set value
		}
	}
	else{ die; }	# illigal case

	custom_command(\$command, \$slot, \$value);
	if(0){}
	elsif($command eq "set"){ $target = \%SLOT ; $COUNT{$command}++; }
	elsif($command eq "def"){ $target = \%MACRO ; $COUNT{$command}++;}
	elsif($command eq "prop"){
		$target = \%PROPERTY ;
	 	$value .= " $$target{$slot}";	
		while($value =~ s;\bNo(\S+)\b;;g ){
			print_debbug("removedprop: $1\n");
			$value =~ s;\b$1\b;;g;
		}
		$_ = $value;
		$value = join(' ', split());
		$COUNT{$command}++;
	}
	else{ die ; }	# illigal case

	setvalue($target, $slot, $value);
}

sub setvalue{
	my( $target, $slot, $value ) = @_;
	if($target == \%SLOT and $PROPERTY{$slot} =~ m;\bAutoOutput\b;){
		print_rep("$slot = $value\n");
	}

	$COUNT{"set"}++;
	print_debbug("target: $target, slot: $slot, value: $value\n");
	$$target{$slot} = $value;	# set value
}

## command save/rest 'save slot alias' #####################
sub cmd_alias{
	my($command, $slot, $alias) = @_;
	return unless check_slot($slot, \%SLOT);
	if($command eq "save"){ $SLOT{$alias} = $SLOT{$slot} }	# copy value
	elsif($command eq "rest"){ $SLOT{$slot} = $SLOT{$alias} }	# copy value
	else{ die; }	# illigal case
	$COUNT{$command}++;
}

## command inq/del 'inq slot' ##############################
sub cmd_slot{
	my($command, $slot) = @_;
	
	custom_command(\$command, \$slot, undef);
	if($command eq "inq"){
		return unless check_slot($slot, \%SLOT); # check slot existance
		$COUNT{$command}++;
		print_rep("$slot = $SLOT{$slot}\n"); }
	elsif($command eq "del" ){
		return unless check_slot($slot, \%SLOT); # check slot existance
		$COUNT{$command}++;
		delete($SLOT{$slot}) or print_tell("$slot isn't  deleted!\n");
	}
	else{ die; }	# illigal case
}

## command do 'do slot', 'do < file arg ...' ###############
sub cmd_valiableargs{
	cmd_do(@_);
}

sub cmd_do{
	my( $command, $tail) = @_;
	my( @inputargs );
	my( $slot, $value );
	my( @value );

	print_debbug("$tail\n");
	die unless ($command eq 'do');	# invalid case

	if( $tail =~ s;<\s+(\S+)\s*;; ){
		my( $infile ) = $1;
		open(INFILE, $infile) || (print_tell("can not open $infile\n") && next );
		@value = <INFILE>;
		close(INFILE);
	}
	elsif( $tail =~ s;(\S+)\s*;; ){
		$slot = $1;
		return unless check_slot($slot, \%MACRO); # check slot existance
		@value = split("\n", $MACRO{$slot});
	}
	else{ return; }

	$_ = $tail;
	@inputargs = (undef, split());
	foreach(@value){
		s;\[(\d+)\];$inputargs[$1];g ;	# replace [1] [2] ... / args
		s;\[(\D\S*)\];$SLOT{$1};g ;	# replace ["slotname"] / value of slot
	}
	analyzetoken( join( "\n", @value ) );
}

## customized behavior #####################################
sub custom_command{
	my( $command, $slot, $value) = @_ ;

	## exeption in 'set'
	if($$command eq "set"){
		if($$slot eq "Run"){	# Run
			if($$value eq "INIT"){ $$value = "LIVE"; }
			if($$value eq "EXIT"){ $$value = "DEAD"; }
		}
		elsif($$slot eq "RecogOut"){
		    recog_out($$value);
		}
		elsif($$slot eq "RecogStatus"){
		    recog_status($$value);
		}
		elsif($$slot eq "SRM_Recog"){
		    srm_recog_start($$value);
		}
		elsif($$slot eq "SRM_Julian"){
		    srm_julian($$value);
		}
		elsif($$slot eq "SRM_XML_File"){
		    srm_xml_file($$value);
		}
		elsif($$slot eq "SRM_XML_String"){
		    srm_xml_string($$value);
		}
		elsif($$slot eq "ButtonPressed"){
		    button_pressed($$value);
		}
	}
	elsif( $$command =~ m;\b(inq|prop)\b; ){	# resolve name
		unless( $$slot =~ m;(Run|\.);){	# except Run/*.*
			my( $list );
			foreach(grep( m;$$slot\.\S+;, sort keys(%SLOT))){
				if( $$command eq "inq"){ $list .= "$$command $_\n"; }
				elsif( $$command eq "prop" ){$list .= "$$command $_ = $$value\n";}
				else{die;}	#	illigal case
			}
			print_debbug("resolver: $list\n");
			analyzetoken($list);
		}
	}
	$COUNT{"customized"}++;
}

## recog_out ###########################################

# by nishi 
#
# set RecogOut = <RECOGOUT>
# set RecogOut = <SHYPO RANK="1" SCORE="-3556.441895" GRAM="5">
# set RecogOut = <WHYPO WORD="silB" CLASSID="15" PHONE="silB"/>
# set RecogOut = <WHYPO WORD="ありがとう" CLASSID="13" PHONE="a r i g a t o:"/>
# set RecogOut = <WHYPO WORD="silE" CLASSID="16" PHONE="silE"/>
# set RecogOut = </SHYPO>
# set RecogOut = </RECOGOUT>
# 
# nbest および 2pass を受け取らないことを前提としている
#

my $act = '';

sub recog_out {
    my($value) = @_ ;
    my($word);

    if ( $value =~ m/<RECOGOUT>/ ) {
	$act = '';
    } elsif ( $value =~ m/<\/RECOGOUT>/ ) {
	print_debbug("result $act\n");
	print_tell("result $act\n");
    } elsif ( $value =~ m/^<WHYPO\s+([^\/]*)\/>/ ) {
	print_debbug("$1\n");

	if ($1 =~ m/WORD="([^\"]*)"/ ) {
	    $word = $1;
	    if ( $word ne "silB" && $word ne "silE" && $word ne "sp" ) {
		# 東京        -> append 東京
		# 東京都:東京 -> append 東京
		# えっと:     -> append nothing
		if ( $word =~ m/([^:]*):([^:]*)/ ) {
		    $act .= $2;
		} else {
		    $act .= $word;
		}
	    }
	}

    } elsif ( $value =~ m/^<SHYPO>/ ) {
	# do nothing
    } elsif ( $value =~ m/^<\/SHYPO>/ ) {
	# do nothing
    } else {
	# ignore 
    }

}
    
## recog_status ###########################################
# set RecogStatus = STATUS="LISTEN" TIME="1052192405"
# set RecogStatus = STATUS="STARTREC" TIME="1052192404"
# set RecogStatus = STATUS="ENDREC" TIME="1052192405"
# set RecogStatus = RECOGFAIL

sub recog_status {
    my($value) = @_ ;

    #print_tell("status $value\n");
    if ( $value =~ m/STATUS="STARTREC"/ ) {
	print_tell("status INPUT_START from SRM\n");
    } elsif ( $value =~ m/STATUS="LISTEN"/ ) {
	print_tell("status LISTEN\n");
    } elsif ( $value =~ m/RECOGFAIL/ ) {
	print_tell("status RECOGFAIL\n");
    } elsif ( $value =~ m/GRAMMAR_ERROR/ ) {
	print_tell("status GRAMMAR_ERROR\n");
    } elsif ( $value =~ m/GRAMMAR_SEND_COMPLETE/ ) {
	print_tell("status GRAMMAR_SEND_COMPLETE\n");
    } elsif ( $value =~ m/GRAMMAR_CONVERSION_COMPLETE/ ) {
	print_tell("status GRAMMAR_CONVERSION_COMPLETE\n");
	# print STDOUT "to \@SRM set Run = START\n";
	# STDOUT->flush();
    } else {
	 # ignore 
    }
}
    
#############################################
# srm_julian / srm_xml 
#

sub srm_recog_start {
    print STDOUT "to \@SRM set Run = INIT\n";
    print STDOUT "to \@SRM set Param.beam1 = 100\n";
    print STDOUT "to \@SRM set Input.level = 10\n";
    print STDOUT "to \@SRM set Output.nbest = 1\n";
    print STDOUT "to \@SRM set Output.pass1word = OFF\n";
    print STDOUT "to \@SRM set Output.pass1LMword = OFF\n";
    print STDOUT "to \@SRM set Output.pass1phone = OFF\n";
    print STDOUT "to \@SRM set Output.pass1score = OFF\n";
    print STDOUT "to \@SRM set Output.word = ON\n";
    print STDOUT "to \@SRM set Output.LMword = OFF\n";
    print STDOUT "to \@SRM set Output.phone = OFF\n";
    print STDOUT "to \@SRM set Output.score = OFF\n";
    STDOUT->flush();
    sleep(1);
    print STDOUT "to \@SRM set Run = START\n";
    STDOUT->flush();
    sleep(5);
}
    
sub srm_julian {
    my($value) = @_ ;
    print STDOUT "to \@SRM set Run = PAUSE\n";
    print STDOUT "to \@SRM set Grammar = $value.dfa\n";
    print STDOUT "to \@SRM set Dic = $value.dict\n";
    STDOUT->flush();
    sleep(1);
    print STDOUT "to \@SRM set Run = RESUME\n";
    STDOUT->flush();
}
    
sub srm_xml_file {
    my($value) = @_ ;
    print STDOUT "to \@SRM set Run = RESUME\n";
    STDOUT->flush();
    sleep(1);
    print STDOUT "to \@SRM set Grammar = $value\n";
    STDOUT->flush();
}

sub srm_xml_string {
    my($value) = @_ ;
    print STDOUT "to \@SRM set Run = RESUME\n";
    STDOUT->flush();
    sleep(1);
    print STDOUT "to \@SRM set Grammar << EOF\n";
    print STDOUT "to \@SRM <?xml version=\"1.0\" encoding=\"EUC-JP\"?>\n";
    print STDOUT "to \@SRM $value\n\n";
    print STDOUT "to \@SRM EOF\n";
    STDOUT->flush();
}
    
## button_pressed ###########################################

# by nishi 
#
# from @GUI via @DM-MCL
# set ButtonPressed = はい
#

sub button_pressed {
    my($value) = @_ ;
    print_debbug("status INPUT_START from GUI\n");
    print_tell("status INPUT_START from GUI\n");

    print_debbug("result $value\n");
    print_tell("result $value\n");
}
    
## end of script ###########################################

