#! /usr/bin/perl
#
# Special purpose program for Unix/Linux:
# Read a list of files and the corresponding praat label files.
# Constructs a Play List for playing all sounds containing the
# filename (path), the start and end times and the ID of the sound item.
# Three play-lists are generated: PLAYLIST.txt (Unix),
# MACPLAYLIST.txt (MacOs), and WINPLAYLIST.txt (MSwindows).
# The output is CONCATENATED to the Play List files.
#
# This program expects the target directory as produced by ConstructShadowCDrom.pl.
# I.e., if FILELIST.txt is in 'home' (as created by ConstructShadowCDrom.pl),
# then the labels are in 'home/Labels/*/*.phoneme'
#
# Arguments:
# - The filename of the list of filenames (obligatory). The playlists are put in
#   the same directory.
#
# - A list of ('-quoted) RegExp patterns (e.g., 'F28G.*HVD' 'F28G.*FY') or
#   files with lists of RegExp patters (e.g., 'List.txt'). The sounds
#   are grouped in the order of the ARGUMENTS they match (e.g., if the argument
#   is a filename, all sounds matching any of it's RegExp patterns are grouped).
#   A sound is added to the list each time it matches an argument.
#
#
# Use:
# ./ConstructPlayList.p FILELIST 'MatchingPatterns' ...
#
# Call:
# ./ConstructPlayList.pl /data1/rob/ExpCDrom/FILELIST.TXT 'F28G*Y' 'foo/bar/MyList.txt'
#
#
###############################################################################
#
# Copyright Nederlandse Taalunie © 2000, 2001
#
# Author Rob van Son
# Institute of Phonetic Sciences & ACLC
# University of Amsterdam
# Herengracht 338
# NL-1016CG Amsterdam, The Netherlands
# Email: Rob.van.Son@hum.uva.nl
#        rob.van.son@workmail.com
# WWW  : http://www.fon.hum.uva.nl/rob/
# mail:  Institute of Phonetic Sciences
#        University of Amsterdam
#        Herengracht 338
#        NL-1016CG Amsterdam
#        The Netherlands
#        tel +31 205252183
#        fax +31 205252197
#
# License for use and disclaimers
#
# 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 and initialize
	  my $InputFile = shift(@ARGV);
	  $InputFile =~ m@/[^/]+$@;
	  my $HomeDirectory = $`;
    my @PatternList = @ARGV;
    my $SelectionCriterium;
    my $FilePattern;

    # Create PlayList directories
    $CreateDir = "$HomeDirectory/PlayLists";
    $DirExists = -d "$CreateDir";
    ($return_value = mkdir("$CreateDir", 0744) || die "Dir $CreateDir: $!\n") unless $DirExists;

    # Get the list of inputfiles
    open(INPUTLIST, "<$InputFile") || die "Input $InputFile: $!\n";
    my @InputFileList = <INPUTLIST>;

    # First get the Master pattern (if any)
    my $MasterPattern = "";
    my $FilePrefix = "";
    if($PatternList[0] eq '-m' || $PatternList[0] eq '--master')
    {
       shift(@PatternList);
       $MasterPattern = shift(@PatternList);
       $FilePrefix = $MasterPattern;
       $FilePrefix =~ s/[^\w]+/_/ig;
       
       # Store File prefix!
       open(SUBJECTPREFIX, ">>$HomeDirectory/SUBJECTPLAYLIST.txt") 
       || die ">>$HomeDirectory/SUBJECTPLAYLIST.txt: $!\n";
       print SUBJECTPREFIX "$FilePrefix\n";
       close(SUBJECTPREFIX);
    };

    # Open the output files that will get the list
    open(UNIXLIST, ">>$HomeDirectory/PlayLists/${FilePrefix}PLAYLIST.txt")
               || die ">>$HomeDirectory/PlayLists/${FilePrefix}PLAYLIST.txt: $!\n";
    open(MACOSLIST, ">>$HomeDirectory/PlayLists/${FilePrefix}MACPLAYLIST.txt")
               || die ">>$HomeDirectory/PlayLists/${FilePrefix}MACPLAYLIST.txt: $!\n";
    open(MSWINLIST, ">>$HomeDirectory/PlayLists/${FilePrefix}WINPLAYLIST.txt")
               || die ">>$HomeDirectory/PlayLists/${FilePrefix}WINPLAYLIST.txt: $!\n";

    # Now print out the matching sound items in the order of the Patternlist
    while($SelectionCriterium = shift(@PatternList))
    {
        my @SelectionList = ();
        # Get the $SelectionCriterium from a file and make a long OR list
        if(-T $SelectionCriterium)   # The criterium is an existing textfile
        {
             open(SELECTION, "<$SelectionCriterium") || die "<$SelectionCriterium: $!\n";
             @SelectionList = map {chomp; s/\s*$//g; $_;} <SELECTION>;
             close(SELECTION);
        };

        my $FilePattern;
        foreach $FilePattern (@InputFileList)
        {
        	# Skip comments and empty lines
        	next if $FilePattern =~ /^\s*\#/;
		next unless $FilePattern =~ /\S/;
        	chomp($FilePattern);
        	$FilePattern =~ s/\s*$//g;  # Remove white-space upto end-of-line
        	next unless $FilePattern;
        	
        	# Get the full file name
        	my @FileList = glob("$HomeDirectory/Speech/$FilePattern");
        	my $FileName;

        	# Handle All files
        	foreach $FileName (@FileList)
                {
		        next unless $FileName =~ /\S/;
         		# Take apart the file path to get the relevant directories and ID numbers
        		# e.g., "./Speech/F28G/F28G1FPA1VCVA.aifc"
        		# -> $`=".", $1="F28G", $2="F28G1FPA1VCVA"
        		$FileName =~ m@/([\w]+)/([^/\.\_]+)_[fh]m\.[^\.]+$@i;
        		my $SpeakerID = $1;
        		my $ItemID = $2;

        		my @LabelFileNameList = glob("$HomeDirectory/Labels/$SpeakerID/$ItemID*.*");
        		
        		# Use one of the label-files
        		my $LabelFileName = shift(@LabelFileNameList);
			next unless $LabelFileName =~ /\S/;
        		
        		# Read the labelfile
        		my $LabelFile = new SentenceLabel;
        		$LabelFile->FoldedIDcodes('PHONEMES', 'SYLLABLES', 'WORDS', 'TRANSLIT');
        		$LabelFile->ReadLabelFile("$LabelFileName");
        	
        		# Start output
          	$LabelFile->presetItem('TRANSLIT');
          	while($LabelFile->nextItem('TRANSLIT') > -1)
          	{
              	next unless $LabelFile->currentValue('TRANSLIT') =~ /[\w\@\~\:]+/;   # There should be something
              	# Use a global match to "preselect" IDcodes
              	next if ($MasterPattern ne "" && ($LabelFile->currentIDcode('TRANSLIT') !~ /($MasterPattern)/));

              	unless(@SelectionList)
              	{
              		next unless $LabelFile->currentIDcode('TRANSLIT') =~ /($SelectionCriterium)/; # Is this the item?
                }
                else
                {
              		next unless scalar(grep(($LabelFile->currentIDcode('TRANSLIT') =~ /($_)/), @SelectionList)); # Is this the item?
                };

              	$FileName =~ m@$HomeDirectory/@;
              	my $UnixPath = $';
              	my $MacOsPath = $';
              	my $MSwinPath = $';
              	$MacOsPath =~ s@/@:@g;
              	$MSwinPath =~ s@/@\\@g;

                # Unix PlayList
              	print UNIXLIST $UnixPath, "\t";
              	print UNIXLIST $LabelFile->currentStart('TRANSLIT'), "\t";
              	print UNIXLIST $LabelFile->currentEnd('TRANSLIT'), "\t";
              	print UNIXLIST $LabelFile->currentIDcode('TRANSLIT'), "\n";

                # MacOs PlayList
              	print MACOSLIST $MacOsPath, "\t";
              	print MACOSLIST $LabelFile->currentStart('TRANSLIT'), "\t";
              	print MACOSLIST $LabelFile->currentEnd('TRANSLIT'), "\t";
              	print MACOSLIST $LabelFile->currentIDcode('TRANSLIT'), "\n";

                # MSwin PlayList
              	print MSWINLIST $MSwinPath, "\t";
              	print MSWINLIST $LabelFile->currentStart('TRANSLIT'), "\t";
              	print MSWINLIST $LabelFile->currentEnd('TRANSLIT'), "\t";
              	print MSWINLIST $LabelFile->currentIDcode('TRANSLIT'), "\n";
         	};
        	};
       };
    };
    close(INPUTLIST);
    close(UNIXLIST);
    close(MACOSLIST);
    close(MSWINLIST);
};	
