#! /usr/bin/perl
#
if(grep(/^(\-h|\-\-help)$/, @ARGV))
{
print << "ENDOFHELPTEXT";

Extracts DBMS tables for individual annotations from the
combined text-grids created by CombineCGNLabelFiles.pl

use:
perl ExtractDBtablesFromLabelFiles.pl 
./ExtractDBtablesFromLabelFiles.pl <type> '<TextGrids>' > <table-output>

Example:
./ExtractDBtablesFromLabelFiles.pl ort '../dbl/*.ort.awd.dbl' >ort.txt

Will write a table with the orthographic transliterations to the file 'ort.txt'.
Using 'ackawd' instead, will result in extracting a table of all word alinged chunks
(ack) based on the automatic word alignments (awd).

Options:
<type>
  One of the tier (annotation) types in the text-grids

'<TextGrids>'
  File glob of the text-grids
  
<table-output>
  Name of table output file. That is, this program writes exclusively to 
  standard output.

-l
--license
  License text
  
-h
--help
  This help text


ENDOFHELPTEXT
exit;
};
if(grep(/\-?\-l(icense)?/, @ARGV))
{
print << "ENDOFLICENSETEXT";
###############################################################################
#
# Copyright R.J.J.H. van Son © 2006, 2008
#
# Author Rob van Son
# Institute of Phonetic Sciences & ACLC
# University of Amsterdam
# Herengracht 338
# NL-1016CG Amsterdam, The Netherlands
# Email: R.J.J.H.vanSon\@uva.nl
# 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.
#
#
#######################################################
ENDOFLICENSETEXT
exit;
};
#
require "SentenceLabel.pl";
require "CGN_phonemes.pl";

my $GPLlicense =<<"ENDOFGPLLICENSETEXT";
    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., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
ENDOFGPLLICENSETEXT
 
# Header Information
my $Creator = "R.J.J.H. van Son and Wieneke Wesseling (IFA, ACLC, UvA); SPEX (Radboud University Nijmegen)";
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
                                            = gmtime(time);
$year += 1900;
++$month;
$hour  = sprintf("%0.2d", $hour);
$min = sprintf("%0.2d", $min);
my $Date = "$year-$mon-${mday}T$hour:$min:$sec";

my %LanguageCode = (
'NL' => 'dut',
'FLA' => 'vla'
);

#
# Extract a RDBSM record from the current item
# Redefine the functions in SentenceLabel.pl
#
# The Column headers with [TYPE] information
my @BasicColumnHeader = (
'Num	[INT4] Record number in this table',
'Speaker	[TEXT] Speaker ID', 
'Lang	[TEXT] Language Code',
'ID	[TEXT] Identification code of current item', 
'Pos	[INT4] Position of item in tier', 
'Start	[FLOAT8] Start time of item in file', 
'End	[FLOAT8] End time of item in file', 
'prevID	[TEXT] ID code of previous item', 
'nextID	[TEXT] ID code of next item', 
'prevNE	[TEXT] ID code of previous Non-Empty item', 
'nextNE	[TEXT] ID code of next Non-Empty item', 
'File	[TEXT] ID code of parent file',
'TierName	[TEXT] Name of the tier in the file', 
'TierType	[TEXT] Type of the tier', 
'Tier [TEXT] ID code of parent tier', 
'Chunk [TEXT] ID code of parent chunk', 
'Word [TEXT] ID code of parent word', 
'Syllable [TEXT] ID code of parent syllable', 
'Syllpart [TEXT] ID code of parent syllpart', 
'Phoneme [TEXT] ID code of parent phoneme',
'Value	[TEXT] Value of item', 
);

my @Genalogy = ('File', 'Tier', 'Chunk', 'Word', 'Syllable', 'Phoneme');

my @DVlist = ('Num', 'Speaker', 'Lang', 'ID', 'Pos', 'Start', 'End', 'prevID
', 'nextID', 'prevNE', 'nextNE', 'File', 'TierName', 'TierType', 'Tier', 
'Chunk', 'Word', 'Syllable', 'Syllpart', 'Phoneme', 'Value');

my @GDlist = ('Num', 'Speaker', 'Lang', 'ID', 'Pos', 'Start', 'End', 'prevID
', 'nextID', 'prevNE', 'nextNE', 'File', 'TierName', 'TierType', 'Tier', 
'Chunk', 'Value');

# The function
# Split an ID code into its components
sub SplitIDcode	# ($IDcode) -> (Components)
{
	my $IDcode = shift;
	my @Components = ();
	
	while($IDcode)
	{
		if($IDcode =~ /^\s*([A-Z\-\+]+)/ig)
		{
			push(@Components, $1);
			$IDcode = $'; # Remove part
		}
		elsif($IDcode =~ /^\s*([0-9\-\+]+)/ig)
		{
			push(@Components, $1);
			$IDcode = $'; # Remove part
		}
		else	# The all important exception stop condition
		{
			$IDcode = '';
		};
	};
	# Ready
	return @Components;
};

sub ItemToRecord  # ($Label, $Tier) -> @RecordList (as far as it can be determined from the item)
{
    my $Label = shift;
    my $Tier = shift || $Label->{CURRENTTIER} || return 0;
    
    $Label->storeItem($Tier);   # Make sure you end where you start
    my %RecordValues = ();
    
    # The resulting record
    my @Record = ();
    
    # Get the current Item
    my $CurrentPosition = $Label->currentItem($Tier);
    $RecordValues{'ID'} = $Label->currentIDcode($Tier);
    $RecordValues{'Value'} = $Label->currentValue($Tier);
    $RecordValues{'Start'} = $Label->currentStart($Tier);
    $RecordValues{'End'} = $Label->currentEnd($Tier);
    $RecordValues{'Pos'} = $Label->currentItem($Tier);
    @CurrentComponents = SplitIDcode($Label->currentIDcode($Tier));
    my $FileFormat = 'DV';
    $FileFormat = 'DV' if $CurrentComponents[0] =~ /^DV[AB]/;
    $FileFormat = 'GD' if $CurrentComponents[0] =~ /^GD[AB]/;
    
    # Get the component (parent) IDs
    # Tier name
    $RecordValues{'TierName'} = $Tier;

    # Type of tier (actually, this becomes the table name
    $RecordValues{'TierType'} = $1 if $Tier =~ /([a-z]+)$/;	# Default if Raw
    $RecordValues{'TierType'} = $2 if $Tier =~ /(UNKNOWN|[NV][\d]+)([\w]+)/;

    # Speakers Language
    $RecordValues{'Lang'} = 'Dut';	# Default if Raw
    # $RecordValues{'Lang'} = $LanguageCode{$1} if $Tier =~ /([NV])/i && $FileFormat eq 'DV';

    # Where is the root DV file ID
    if($FileFormat =~ /^(DV|GD)$/)
    {
    	$RecordValues{'File'} = "$CurrentComponents[0]$CurrentComponents[1]$CurrentComponents[4]";
	$RecordValues{'File'} =~ s/^GD/DV/g;
    }
    else
    {
    	$RecordValues{'File'} = join('', @CurrentComponents[0..4]);
    };

    # The Tier ID is just the ID minus the position inside the Tier
    if($FileFormat =~ /^(DV|GD)$/)
    {
	    $RecordValues{'Tier'} = join('', @CurrentComponents[0..5]);
    }
    else
    {
	$RecordValues{'Tier'} = join('', @CurrentComponents[0..(scalar(@CurrentComponents) - 1)]);
    };

    # Get the ID codes of the "higher" segments. Should be NULL if unknown
    if($FileFormat =~ /^(DV|GD)$/)
    {
	$RecordValues{'Chunk'} = $RecordValues{'Tier'}.$CurrentComponents[6] if $CurrentComponents[6];
	$RecordValues{'Word'} = $RecordValues{'Chunk'}.$CurrentComponents[7] if $CurrentComponents[7];
	$RecordValues{'Syllable'} = $RecordValues{'Word'}.$CurrentComponents[8] if $CurrentComponents[8];
	$RecordValues{'Syllable'} =~ s/[KOC]$//g;	# Remove the SYLLPART code
	$RecordValues{'Syllpart'} = $RecordValues{'Word'}.$CurrentComponents[8] if $CurrentComponents[8];
	# Note, the Phoneme ID contains the SYLLPART code
	$RecordValues{'Phoneme'} = $RecordValues{'Syllpart'}.$CurrentComponents[9] 
    					    if $CurrentComponents[9];
    };

    # Determine the speaker from the Tiername
    if($FileFormat eq 'DV')
    {
	    $RecordValues{'TierName'} =~ /^DV[AB][\d\-\+]+([FM]\d+[A-Z]+)/;
	    $RecordValues{'Speaker'} = $1;
    }
    elsif($FileFormat eq 'GD')
    {
	    $RecordValues{'TierName'} =~ /^GD[AB][\d\-\+]+([FM]\d+[A-Z]+)/;
	    $RecordValues{'Speaker'} = $1;
    }
    else
    {
        # RT4TL2-2FN008018HUMS1R1
	    $RecordValues{'Speaker'} = $CurrentComponents[2];
    };
    
    # Surrounding items
    $Label->currentItem($Tier, $CurrentPosition);
    $RecordValues{'prevPos'} = $Label->previousItem($Tier);
    $RecordValues{'prevID'} = $Label->currentIDcode($Tier);
    $Label->currentItem($Tier, $CurrentPosition);
    $RecordValues{'nextPos'} = $Label->nextItem($Tier);
    $RecordValues{'nextID'} = $Label->currentIDcode($Tier);
    $Label->currentItem($Tier, $CurrentPosition);
    
    #Surrounding non-empty items
    if($FileFormat eq 'DV')
    {
    	while($Label->previousItem($Tier) > -1 && $Label->currentValue($Tier) =~ /^(sil|\s*)$/i){};
    }
    elsif($FileFormat eq 'GD')
    {
    	while($Label->previousItem($Tier) > -1 && $Label->currentValue($Tier) =~ /^(x|NULL)?$/i){};
    };
    $RecordValues{'prevNE'} = $Label->currentIDcode($Tier);
    $Label->currentItem($Tier, $CurrentPosition);
    
    if($FileFormat eq 'DV')
    {
    	while($Label->nextItem($Tier) > -1 && $Label->currentValue($Tier) =~ /^(sil|\s*)$/i){};
    }
    elsif($FileFormat eq 'GD')
    {
    	while($Label->nextItem($Tier) > -1 && $Label->currentValue($Tier) =~ /^(x|NULL)?$/i){};
    };
    $RecordValues{'nextNE'} = $Label->currentIDcode($Tier);
    $Label->currentItem($Tier, $CurrentPosition);
    
    # add the current row number
    ++$RowNumber;
    $RecordValues{'Num'} = $RowNumber;
    
    # Construct Record
    foreach my $ColumnHeader (@BasicColumnHeader)
    {
    	my ($Key, $Rest) = split(" ", $ColumnHeader);
	my $CurrentRecordValue = 'NULL';
	
	next if $FileFormat eq 'DV' and ! grep (/^$Key$/, @DVlist);
	next if $FileFormat eq 'GD' and ! grep (/^$Key$/, @GDlist);
		
	$CurrentRecordValue = $RecordValues{$Key} if $RecordValues{$Key} =~ /\S/;
	# Handle rounding in floats
	if($Rest =~ /\[FLOAT\d*\]/)
	{
	    $CurrentRecordValue = sprintf("%6.4F", $CurrentRecordValue);
	};
    	push(@Record, $CurrentRecordValue);
    };    
    $Label->restoreItem($Tier);   # Make sure you end where you start
    
    # Return the record
    return @Record;
}

# Construct a list of records from a tier within the current item of the parent tier
# Fixed items are WRITTEN into the leading places of the record.
# That is, the @FixedItems list replaces the corresponding fields in the record.
sub TierToTable   # ($Label, $Tier, @FixedItems)->@Table->@Records
{
    my $Label = shift;
    my $Tier = shift || $Label->{CURRENTTIER} || return 0;
    my @FixedItems = @_;

    $Label->storeItem($Tier);   # Make sure you end where you start
    #
    my @Table = ();
    
    # Fill the table with pointers to records
    $Label->presetItem($Tier);
    while($Label->nextItem($Tier) > -1)
    {
    	my @Record = ();
	push(@Record, ItemToRecord($Label, $Tier));
	for($i=0; $i < scalar(@FixedItems); ++$i)
	{
		$Record[$i] = $FixedItems[$i];
	};
    	push(@Table, \@Record);
    };
    
    $Label->restoreItem($Tier);   # Make sure you end where you start
    
    return @Table;
}    

# Get going
# Get the Tiertype to be read
my $TierTypeArgument = shift(@ARGV);
$TierTypeArgument =~ s/[\(\)\s]//g;
my @TierTypeList = split(/,/, $TierTypeArgument);

# Run each type separately in sequence (not very efficient)
foreach my $TierType (@TierTypeList)
{
    my $RowNumber = 0;
    my @ColumnNames = ();
    # Print header
    print << "ENDOFXMLHEADER";
<?xml version='1.0'?>
<xml>
<table>
<table-name>$TierType</table-name>
<table-type>table</table-type>
<table-record index="ID">
ENDOFXMLHEADER
    foreach my $Column (@BasicColumnHeader)
    {
    	$Column =~ /^(\S+)\s+\[([^\]]+)\]\s+/g;
	my $Name = $1;
	my $Type = $2;
	my $Description = $';
		
	next if $TierType ne 'gaze' and ! grep (/^$Name$/, @DVlist);
	next if $TierType eq 'gaze' and ! grep (/^$Name$/, @GDlist);
		
	push (@ColumnNames, $Name);
	print "<record-column>";
	print "<column-name>$Name</column-name>";
	print "<column-type>$Type</column-type>";
	print "<description LanguageId=\"RFC1766:en-US\">$Description</description>";
	print "</record-column>\n";
    };
print <<"ENDOFXMLTAIL";
</table-record>
<rdf:Description xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#" xmlns:dc="http://purl.org/dc/elements/1.1/">
<dc:source>IFADVcorpus 1.0</dc:source>
<dc:title>IFA Dialog Video corpus $TierType</dc:title>
<dc:creator>$Creator</dc:creator>
<dc:date>$Date</dc:date>
<dc:type>Dataset</dc:type>
<dc:format>text/tab-separated-values</dc:format>
<dc:rights LanguageId=\"RFC1766:en-US\">
Copyright: $year, Dutch Language Union (NTU),
$Creator
$GPLlicense
</dc:rights>
</rdf:Description>
</table>
</xml>
ENDOFXMLTAIL
    # Non-xml text, eg, column names as a tab separated list
    print "# Start tab separated data: Content-type=\"text/tab-separated-values\"\n";
    print "#> ", join("\t", @ColumnNames), "\n";

    # Get the files that have to be combined
    foreach my $FileGlob (@ARGV)
    {
	    my @FileList = glob($FileGlob);
	    foreach my $InputFile (@FileList)
	    {
	    	my @FixedList = ();
	    	if($InputFile =~ m!/(comp-[a-z])/!)
		    {
			    push(@FixedList, $1);
		    }
		    elsif($InputFile =~ m!([a-zA-Z]*Stim)\.[\w\-]+$!i)
		    {
			    push(@FixedList, $1);
		    };
		
		    my $Label =  new SentenceLabel;
		    $Label->ReadLabelFile($InputFile);

		    @TierList = @{$Label->{TIERORDER}};

		    # Run through all tiers
		    foreach my $Tier (@TierList)
		    {
			    next unless $Tier =~ /(UNKNOWN|[NV][\d]+)$TierType\s*$/ || $Tier =~ /[A-Z0-9]$TierType$/;
			    my @Table = TierToTable($Label, $Tier, @FixedList);
			    foreach my $CurrentRecord (@Table)
			    {
				    print STDOUT join("\t", @$CurrentRecord), "\n";
			    };
		    };
	    };
    };
};
