#! /usr/bin/perl
#
# Read the chunk files from ../Labels/chunks and store them in a database
# file in ../DatabaseFiles/Chunks.
#
# Use:
# ./ConstructChunkTables.pl <SpeakerGlob>
#
# This will read in all files from <SpeakerGlob> (e.g., F*)
# and constructs Table files with the names <Speaker>chunks.txt
#
#
###############################################################################
#
# Copyright R.J.J.H. van Son © 2000, 2001, 2002
#
# 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.
#
#
#######################################################
#

$HomeDir = '../../..';
require "$HomeDir/Links.pl";
require "$Scripts/SentenceLabel.pl";

my $TableDirectory = "$DatabaseTables/phoneme/";
my $TypeExtension = 'translit';
my $CHUNKtier = 'CHUNK';
my $TranslitTier = 'TRANSLIT';

my $TableName = "chunks";

# Get an order code for chunks
my %StyleOrder = (
'VI' => 0,
'FPA1' => 30,
'FPA2' => 31,
'FT' => 32,
'FS' => 46,
'FW' => 47,
'FY' => 48,
'FR' => 49,
'FPB1' => 52,
'FPB2' => 53,
'VT' => 55,
'VS' => 90,
'PS' => 92,
'VW' => 94,
'VY' => 96,
'VR' => 98
);

# Give each chunk a unique number
sub chunkNumberCode # ($ChunkID) -> $Number
{
   my $ChunkID = shift || return -1;

   my  $ChunkStyle = "";
   my  $ChunkNumber = -1;

   my $ChunkList = join("|", keys(%StyleOrder));
   if($ChunkID =~ /($ChunkList)/)
   {
       $ChunkStyle = $1;
       $ChunkNumber = $';
       $ChunkNumber = $ChunkNumber =~ /^([\d]+)/ ? $1 : 0;
   }
   else
   {
       return -1;
   };

   my $ChunkCodeNumber = $StyleOrder{$ChunkStyle};

   if(grep(/$ChunkStyle/, ('VI', 'FT', 'VT')))
   {
       $ChunkCodeNumber += $ChunkNumber;
   };

   return $ChunkCodeNumber * 1000;   # Allow ampel room for sentences
}

#
# A list of readable names
my %RealNames =
(
'F' => 'Fixed',
'V' => 'Variable',
'PS' => 'PseudoSent',
'I' => 'Informal',
'R' => 'Retold',
'T' => 'Read',
'S' => 'Sentence',
'W' => 'Word',
'Y' => 'Syllable',
'PA' => 'Pronunciation',
'PB' => 'Pronunciation',
'PR' => 'Pronunciation'
);

my @CHUNKcolumnHeaders = (
'ChunkNbr [INT4] Order number (id) of chunk in the recording', 
'NumSent [INT4] Number of sentences',
'NumWords [INT4] Number of words',
'NumChars [INT4] Number of characters (excluding whitespace)'
);
sub CHUNKedit        # ($Label, \@Records) 
{
    my $Label = shift || return 0;
    my $Record = shift || return 0;
    
    # The Translit Tier tier
    my $TranslitTier = 'TRANSLIT';
    
    # Remove unwanted items (last four). We don't know
    # the previous and next chunks, at least not from
    # the current file.
    splice(@$Record, 12, 4);
    # Durations are unchecked, i.e., always "valid"
    splice(@$Record, 11, 1);
    splice(@$Record, 9, 1);
    splice(@$Record, 7, 1);
        
    # Initialize
    my $ChunkNbr = chunkNumberCode($Label->currentIDcode($CHUNKtier));
    my ($NumSent, $NumWords, $NumChars) = (0, 0, 0);
    
    # Get the mean words, syllables and phonemes per second from CGN
    # First, count the non-pause words etc. and sum their durations
    my $CurrentText = "";
    $Label->presetItem($TranslitTier);
    while($Label->nextStartininterval($TranslitTier, $CHUNKtier) > -1)
    {
        ++$NumSent;
	my $Sentence = $Label->currentValue($TranslitTier);
	next if $Sentence !~ /\w/;
	$NumWords += scalar(grep(!/[\.\,\?\!\;\:]/, split(' ', $Sentence)));
	$NumChars += scalar(grep(!/[\.\,\?\!\;\:\s]/, split('', $Sentence)));
    };
    
    # Add new items
    push(@$Record, $ChunkNbr, $NumSent, $NumWords, $NumChars);

    return 1;
}

my %PostEditors = (
$CHUNKtier => \&CHUNKedit
);

my %PostHeader = (
$CHUNKtier => \@CHUNKcolumnHeaders
);

# Make sure ARGV contains non-empty items
@ARGV = grep(/\S/, @ARGV);

# If @ARGV is empty, do all
@ARGV = ('*') unless @ARGV;

my $SpeakerID = "";

# Handle all speakers in the arguments
foreach $SpeakerID (@ARGV)
{
    # Get all files
    my @FileList = glob("$ChunkLabels/$SpeakerID/*.translit");

    # Get information
    my $FilePath;
    foreach $FilePath (@FileList)
    {
        # Get the ID of the current speaker
        my $CurrentSpeaker = "";
        if($FilePath =~ m@$ChunkLabels/([^/]+)/[^/]+$@)
        {
            $CurrentSpeaker = $1;
        }
        else
        {
            die "No speaker found: $File\n";
        };
        
    	# Get the sentence label file
        my $Label = '';
	$Label = new SentenceLabel;
        $Label->ReadLabelFile($FilePath) || die "$FilePath\n";
        
	# We do not have any actual CHUNK tiers, so we create one
	# (if it doesn't exist already)
	# The CHUNK tier will collect all sentences that have the same
	# CHUNK id (obvious, isn't it)
	if($Label->createTier($CHUNKtier) > -1)
	{
	    # First, remove the fake ID-codes surrounding the chunk
	    $Label->firstItem($TranslitTier);
	    $Label->currentIDcode($TranslitTier, 'PREFIX');
	    $Label->lastItem($TranslitTier);
	    $Label->currentIDcode($TranslitTier, 'POSTFIX');
	    
	    # Iterate over the sentences
	    # This code is much too general, each file contains
	    # only a single chunk. But if it would be used to
	    # convert multi-chunk files, this would be needed.
	    $Label->presetItem($TranslitTier);
	    my $CurrentChunkID = '';
	    while($Label->nextItem($TranslitTier) > -1)
	    {
		    my $newChunkID = $Label->currentIDcode($TranslitTier);
		    $newChunkID =~ s/([\d\-])[A-Z][A-Z\-]*$/\1/g;	# Remove sentence count
		    # Watch out, sentence [FV]S, word [FV]W, and syllable [FV]Y
		    # lists have fake chunk counts, e.g. F20N1FT3A is part of 
		    # chunk F20N1FT3 (the first line of the third chunk),
		    # but F20N1FS3A is part of chunk F20N1FS (the third sentence
		    # in the list).
		    $newChunkID =~ s/[\d\-]+$//g if $newChunkID =~ /[SWY][\d\-]+$/;	# Remove chunk count
		    
		    # A new Chunk, create the corresponding item
		    if($newChunkID ne $CurrentChunkID)
		    {
		    	    # Get the Start time of the current item (the end time of the 
			    # previous item should have been set already)
		            my $CurrentStart = $Label->currentStart($TranslitTier);
			    
			    # The new item (with 'NULL' value and a default end-point)
			    $CurrentChunkID = $newChunkID;
			    my $item = $Label->pushItem($CHUNKtier, 'NULL', $CurrentChunkID , $CurrentStart, $CurrentStart);
			    $Label->currentItem($CHUNKtier, $item);  # Position the tier on the new item
		    };
		    # A running end-time update. There should ALWAYS be a CHUNK item at this point
		    # in the code.
		    $Label->currentEnd($CHUNKtier, $Label->currentEnd($TranslitTier));
		    
		    # Construct the value as the comined sentence transcriptions
		    # Currently not implemented (use texts database)
		    # my $CurrentChunkValue = $Label->currentValue($CHUNKtier);
		    # $CurrentChunkValue .= "<".$Label->currentIDcode($TranslitTier)
		    # 	."> [".
	            #    $Label->currentValue($TranslitTier)
		    # ."] ";
		    # $Label->currentValue($CHUNKtier, $CurrentChunkValue);
	    };
	};
	
	# This should be a while loop if there is more than a single chunk in the file
        if($Label->currentItem($CHUNKtier, 1) > -1)
        {
        	# Skip empty chunks (currently unnecessary)
        	# next unless $Label->currentValue($CHUNKtier) =~ /\[[\#\*\s]*[^\#\*\s\]]+/;
            
		# Create the table row entry
                my @Table = $Label->TierToTable($CHUNKtier, $CHUNKtier, $PostEditors{$CHUNKtier});
                print STDERR "Error with '$Tier' from $File\n" unless @Table;
    
                # Print result to file
                my $PrintHeader = (-e "$TableDirectory/$CurrentSpeaker$CHUNKtier$TypeExtension.txt") ? 0 : 1;
                open(OUTPUT, ">>$TableDirectory/$CurrentSpeaker$CHUNKtier$TypeExtension.txt") 
                || die ">>$TableDirectory/$CurrentSpeaker$CHUNKtier$TypeExtension.txt: $!\n";
                
                # Print the column headers
                if($PrintHeader)
                {
                    # Make sure the tier is somewhere
                    $Label->currentItem($CHUNKtier, 1);
                    
                    # Construct the list with column headers
                    my @CurrentHeaders = $Label->TierToTableColumnheaders($CHUNKtier, @{$PostHeader{$CHUNKtier}});
                    
                    # Post editing of the column headers
                    @CurrentHeaders = map {eval join(";", @ColumnHeaderPostEditing); $_;} @CurrentHeaders;
                    
                    # Remove some items, the next and previous chunk id's and values
                    splice(@CurrentHeaders, 13, 1);
                    splice(@CurrentHeaders, 12, 4);
                    splice(@CurrentHeaders, 11, 1);
                    splice(@CurrentHeaders, 9, 1);
                    splice(@CurrentHeaders, 7, 1);
                    
                    # Print the column headers
                    print OUTPUT "\#> ", join("\n\#> ", @CurrentHeaders), "\n";
                    
                    # Print some extra information
                    print OUTPUT "\# ";
                    print OUTPUT "Tier: $CHUNKtier\n\# Speaker: $CurrentSpeaker\n\# Source: $TypeExtension\n";
                    print OUTPUT "\#\n";
                    

		    # Print the copyright license
		    if(open(LICENSE, "<./licenseterms.txt"))
		    {
			    my $Date = localtime();
			    $Date =~ /\s([\d]+)\s*$/;
			    my $Year = $1;
			    while(<LICENSE>)
			    {
				    if(/\©/ && ! /$Year/)
				    {
					    s/(\d)\s{6}(\s+\#)/\1, $Year\2/ig;
				    };
				    print OUTPUT $_;
			    };
			    close(LICENSE)
		    };

                    # Header is printed ONLY once
                    $PrintHeader = 0;
                };
                
                my $Record;
                foreach $Record (@Table)
                {
                    print OUTPUT join("\t", @$Record), "\n";
                };
                close(OUTPUT);
            };
    
    };
};

