#! /usr/bin/perl
#
# Special purpose program for Unix/Linux:
# Read all arguments as praat label files
# and check the phoneme tier for stray symbols
#
# Prints out a list of all erroneous labels
#
# Use:
# The label files are in ./Labels/<SpeakerID>/phoneme
#
# Call:
# ./CheckPhonemeLabels.pl ./Labels/F28G/phoneme/F28G1FPA*
#
# This will check all files in F28G whose names start with 'F28G1FPA'
#
#    Copyright (C) 2000, 2001  R.J.J.H. van Son
# 
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    (at your option) any later version.
# 
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
# 
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, write to the Free Software
#    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
require 'AlignAutomaticLabeling.pl' || die "AlignAutomaticLabeling.pl: $!\n";


#
#
# Do not execute inside a require
unless(caller())
{
    # Define the sonority of phonemes
    my %Sonority = (
'*' => '-1',
'=' => '-1',
'p' => '1',
'b' => '2',
't' => '1',
'd' => '2',
'k' => '1',
'g' => '2',
'f' => '3',
'v' => '4',
's' => '0',
'z' => '4',
'S' => '3',
'Z' => '4',
'x' => '3',
'G' => '4',
'h' => '1',
'N' => '5',
'm' => '5',
'n' => '5',
'J' => '6',
'l' => '6',
'r' => '6',
'w' => '7',
'j' => '7',
'I' => '8',
'E' => '8',
'A' => '8',
'O' => '8',
'Y' => '7',
'i' => '7',
'y' => '7',
'9' => '7',
'e' => '8',
'2' => '8',
'a' => '9',
'o' => '8',
'u' => '7',
'@' => '6',
'E+' => '8',
'9+' => '8',
'O+' => '8',
'E:' => '8',
'9:' => '7',
'O:' => '8',
'E~' => '8',
'A~' => '8',
'O~' => '8',
'Y~' => '7'
);
	  # Define and initialize
    my @GlobFileList = @ARGV;
    my $FilePattern;

    foreach $FilePattern (@GlobFileList)
    {
        # Get the real filenames (expand * and ?)
        my @FileList = glob("$FilePattern");
        my $FileName;

        # Handle All files
        foreach $FileName (@FileList)
        {
        	my @PhonemeErrors = ();
        	
        	# Take apart the file path to get the relevant directories and ID numbers
        	# e.g., "./Labels/F28G/ASPEX/F28G1FPA1VCVA_rvs.aspex"
        	# -> $`=".", $1="Labels", $2="F28G", $3="ASPEX", $4="F28G1FPA1VCVA" , $5="aspex"
        	$FileName =~ m@/([\w]+)/([\w]+)/([^/\.\_]+)_([\w]+)\.([\w]+)$@i;
        	my $HomeDirectory = $`;
        	my $SpeakerID = $1;
        	my $PhonemeDirectory = $2;
        	my $ItemID = $3;
        	my $Labeler = $4;
         	my $LabelFileType = $5;
        	
        	# Read the labelfile
        	my $PhonemeLabelFile = new SentenceLabel;
        	$PhonemeLabelFile->FoldedIDcodes('PHONEMES');
        	$PhonemeLabelFile->ReadLabelFile("$FileName");
		
		# Check last item (should be a '*' and not too long or short)
        	$PhonemeLabelFile->lastItem('PHONEMES');
		my $error = 0;
		$error = 1 unless $PhonemeLabelFile->currentValue('PHONEMES') =~ /\*/;
		$error = 1 unless $PhonemeLabelFile->currentEnd('PHONEMES') - 
		                  $PhonemeLabelFile->currentStart('PHONEMES') < 1.0;
		$error = 1 unless $PhonemeLabelFile->currentEnd('PHONEMES') - 
		                  $PhonemeLabelFile->currentStart('PHONEMES') > 0.01;
				  
		if($error)
		{
			print "$FileName contains an irregular last item: '",
			$PhonemeLabelFile->currentValue('PHONEMES'), "' ",
			"with duration: ", $PhonemeLabelFile->currentEnd('PHONEMES') - 
		                  $PhonemeLabelFile->currentStart('PHONEMES'), "\n";
		};
		
		
        	$PhonemeLabelFile->map('PHONEMES', '$_ =~ s/([A-Z0-9\@][\+\:\~]?)(?=[A-Z0-9\@])/\1 /ig');
		# Remove '=' signs
        	$PhonemeLabelFile->map('PHONEMES', '$_ =~ s/\=/ /ig');
        	
        	# Start check
        	$PhonemeLabelFile->presetItem('PHONEMES');
        	# Iterate over all phonemes
        	while($PhonemeLabelFile->nextItem('PHONEMES') > -1)
        	{
        	     # Get phoneme label
        	     my $Label = $PhonemeLabelFile->currentValue('PHONEMES');
        	     my @Phoneme = split(/[\-\_\s]/, $Label);   # Split fused phonemes
        	     while(@Phoneme)
        	     {
        	     		if(!exists($Sonority{shift(@Phoneme)}))   # Has the phoneme a sonority?
        	     		{
        	         		# Get the index number of the phoneme
        	         		my $PhonemeIndex = $PhonemeLabelFile->currentItem('PHONEMES');
        	         		# Get the associated word
        	         		$PhonemeLabelFile->parentItemStart('PHONEMES', 'WORDS');
        	         		my $WordIndex = $PhonemeLabelFile->currentItem('WORDS');
        	         		my $Word = $PhonemeLabelFile->currentValue('WORDS');
					my $Start = $PhonemeLabelFile->currentStart('WORDS');
					my $End = $PhonemeLabelFile->currentEnd('WORDS');
        	         		# Store the error information
        	         		push(@PhonemeErrors, "$Label <- $Word\t$Start\t$End\n");
        	         		@Phoneme = ();   # Report error only once
        	        };
        	     };
        	};
        	# Print out error if necessary
        	print STDOUT "$FileName : ", @PhonemeErrors if @PhonemeErrors;
        };
    };
};	
