#!/usr/bin/perl
###
# this script reuses code from the align_phrase_general.pl script
# written by Petr Pollak <pollak@fel.cvut.cz>
# adapted and extended by Pavel Vondřička <Pavel.Vondricka@ff.cuni.cz> 
# for Sound2Sense project
###

$maindir = "${ENV{'HOME'}}/labtool" ;

# transc-tool - converts orthographical form into the default phonetic
$transc = "$maindir/bin/linux/transc" ;
# general dictionary collected from previous projects
$dictfile = "$maindir/dict/general.dict" ;
# my dictionary made from impressions while transcribing
$ldictfile = "$maindir/dict/pavel.utf8.dict" ;
# rules with substitutions (segment deletions, insertions and transformations)
# applied to the default dictionary pronunciation forms
$substfile = "$maindir/dict/sampa_substitutions" ;

# The original script worked with iso-latin-2 only, here we work with UTF-8
# with the exception of the general dictionary provided in ISO-Latin-2
use utf8;
use open ':encoding(utf8)';
binmode(STDIN, ":utf8");
binmode(STDOUT, ":utf8");
# Actually we do not need the conversions since transc tool does everything itself...
#require "$maindir/phones_conv.pm" ; # Bloody encoding troubles...! Copy-paste the functions here if you need them!

	# Read wordlist from STDIN
	while (<>) { $/ = "\n"; chomp; push @mywords,lc($_); }

	# Read general external dictionary (impoert from ISO-8859-2 encoding)
	open EXDICT, '<:encoding(iso-8859-2)', $dictfile or die "Cannot open $dictfile file!\n" ;
	@exdict = <EXDICT> ;
	close EXDICT ;

	# Read local external dictionary (this one is already UTF-8)
	open EXDICT, '<:encoding(utf-8)', $ldictfile or die "Cannot open $ldictfile file!\n" ;
	#@exldict = <EXDICT> ;
	close EXDICT ;
	# cut possible comments, if any, and merge the dictionaries
	foreach $line (@exldict) { $line =~ s/\s*#.*?$//; push @exdict, $line;}

	# Read substitutions (rules)
	# this is just Sampa, encoding not important except of comments  which are UTF-8 but we ignore them anyway
	@substitutions = () ;
	$/ = "\n";
	open SUBST, $substfile or die "Cannot open $substfile !\n" ;
	while ( $sline = <SUBST> ) {
		$/ = "\r\n" ; chomp $sline ;
		$/ = "\n" ; chomp $sline ;
		# cut comments
		$sline =~ s/\s*(#.*)?$//;
		next if $sline =~ /^\s*$/; 
		push @substitutions, $sline ;
	}
	close SUBST ;

	## Find pronunciation for the words
	foreach $word ( @mywords ) {
		# Default will be automatic conversion, unless the word is found in the dictionary
		$ruleconv = 1 ; 
		( @expronuns ) = grep /$word/, @exdict ; #print grep /$word/, @exdict;
		if ( 0 < int(@expronuns) ) {
			# Processing when word appears in pronunciation dictionary 
			foreach $dictline ( @expronuns ) {
				$/ = "\r\n" ; chomp $dictline ;
				$/ = "\n" ; chomp $dictline ;
				@arr = split / /, $dictline ;
				$ortoword = shift @arr ;   # Extraction of ortographic form
				$sampapron = join ' ', @arr ;   # Extraction of pronunciation in SAMPA (with spaces)
				if ( $ortoword eq $word ) {
					# Word found in dictionary, no automatic conversion necessary
					$ruleconv = 0 ;
					# OK, go and apply rules
					&print_mod_pronuns($word,$sampapron,'Dic');
				}
			}
		}

		if ( $ruleconv == 1 ) {
			# The following part was not adapted for our convention, i.e. [pron=...]
			# and we do not need it anyway, now.
			####################################
			#if ( $word =~ /^\(/ ) {  
			#	# Extraction of ortographic form 
			#	# if irregular pronunciation is specified by parentheses convention
			#	@pom = split /\//, $word ;
			#	$word = $pom[0] ;
			#	$word =~ s/\(//g ;
			#	$wordtoepi = $pom[1] ;
			#	$wordtoepi =~ s/\)//g ;
			#} else { 
			#	# Standard orthographic form
				$wordtoepi = $word ;
			#}

			# print "$wordtoepi\n" ;
            
			# Automatic conversion by the tool "transc"
			open EPI, "echo $wordtoepi | iconv -f utf-8 -t iso-8859-2 | $transc -s -x |" or die "Cannot convert $wordtoepi by conversion tool\nFollowing command was used: echo $wordtoepi | iconv -f utf-8 -t iso-8859-2 | $transc -s -x\n" ;
			$epi = <EPI> ; $/="\r\n"; chomp $epi ; $/="\n"; chomp $epi ;
			#print "$epi\n" ; 
			close EPI ;
			$epi =~ s/^\s*//;
			$pronun = $epi;
			#$pronun = &sampify (  &insert_spaces ( $epi ) ) ;
			# OK, go and apply rules
			&print_mod_pronuns($word,$pronun,'Gen');
		}
	}

# Apply rules for segment deletions (or insertions or transformations)
# provided in the external file
sub print_mod_pronuns {

	local $word = $_[0];
	local $pron = $_[1];
	local $tag 	= $_[2]; # Dic (dictionary), Gen (generated)

	# print out the current pronunciation
	print "$word $pron\t\t# $tag\n";
	$rules = '';
	# the current pronunciation is the only member of the field of variants at the moment
	@prons = ($pron."\t");

	# parse each rule
	foreach $rule (@substitutions) {
		($name,$oldstr,$newstr) = split /\t/, $rule ;
		$name =~ s/:$//;
		$oldstr =~ s/\\/\\\\/;
		$newstr =~ s/\\/\\\\/;
		# apply each rule to all forms already generated by previous rules
		foreach $item (@prons) {
			($pron,$rules) = split /\t/, $item ;
			$newpron = $pron;
			# eval - the only way I found to get backreferences ($1 etc.) from outside to work...
			eval("\$newpron =~ s/$oldstr/$newstr/g"); #print "#$newpron =~ s/$oldstr/$newstr/g\n";
			# any change?
			if ( $pron ne $newpron ) {
				# add the name of the rule applied to the description
				$rules .= " $name";
				# print out the new form and the description of rules applied
				print "$word $newpron\t\t# $tag $rules\n";
				# put the new form and description into the field for further processing by following rules
				push @prons, "$newpron\t$rules";
			}
		}
	}

}
