#!/usr/bin/perl
#
## descriptioin ############################################
#
# $Id: SND.pl,v 1.1 2006/08/24 03:45:43 nishi Exp $
#
# 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
#
##$id$######################################################

use strict;
use FileHandle;

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

## grobal valiables ########################################
my( $initfile ) = "snd.init";	#default initialize file
my( $debug ) = 0 ;	# set verbose mode if 1
my( $ModuleVersion ) = "\"SND 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 "Play"){
		    set_play($$value);
		}
	}
	$COUNT{"customized"}++;
}

## set_play ###########################################
#
# play /usr/share/sndconfig/sample.au
# set Play = /usr/share/sndconfig/sample.au
#

sub set_play {
    my($value) = @_ ;
    print_tell("start $value\n");
    system("/usr/bin/play -v 0.2 $value");
    print_tell("end $value\n");
}
    
## end of script ###########################################

