#! /usr/bin/perl
#
# Read the text files from ../Transcriptions and store them in a database
# file in ../DatabaseFiles/Texts.
#
# Use: 
# TranscriptionsToDatabases.pl <SpeakerCode1> <SpeakerCode2> ...
#
###############################################################################
#
# Copyright R.J.J.H. van Son © 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.
#
#
#######################################################
#

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

my $Separator = '/';
my $DatabaseFiles = "$DatabaseTables${Separator}Texts${Separator}";

my $TableName = "texts";

# 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'
);

#
# The column headers and types
my @ColumnHeaders = (
'ID [TEXT] ID code of text',
'Speaker [CHAR(4)] Speaker ID',
'Sex  [CHAR(1)] Speaker sex',
'Age [INT2] Speaker Age',
'TextType [CHAR(2)] Text type',
'Style [CHAR(4)] Text style',
'TextDescr [TEXT] Colloquial names for text type and style',
'RecNr [INT2] Recording number',
'Item [TEXT] Item ID',
'ItemNo [INT4] Item number (order)',
'Author [TEXT] Text "Author"',
'NumSent [INT4] Number of sentences',
'NumLine [INT4] Number of Lines',
'NumWord [INT4] Number of Words',
'NumChar [INT4] Number of characters (excluding white-space)'
);

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

# If @ARGV is empty, do all
@ARGV = map {m![^/]+$!; $&;} glob("$TranscriptionsDir/[FM]*") unless @ARGV;

my $SpeakerID = "";

# Handle all speakers in the arguments
foreach $SpeakerID (@ARGV)
{
    # Get all files
    my @FileList = glob("$TranscriptionsDir/$SpeakerID${Separator}*.txt");
print STDERR "$SpeakerID: (", scalar(@FileList), ")\n";

    # Get information
    my $FilePath;
    foreach $FilePath (@FileList)
    {
		$FilePath =~ m@([^$Separator]+)\.txt$@;
		my $FileName = $1;
		if($FileName =~ /^([FM]\d+[A-Za-z]+)(\d+)(([FVP])([A-Za-z]+)\d*)(\_(.+))?$/)
		{
	    	# Split the Item ID into its components
	    	my $CurrentSpeakerID = $1;
	    	my $CurrentRecording = $2;
	    	my $CurrentChunk = $3;
	    	my $CurrentType = $4;
	    	my $CurrentStyle = $5;
	    	my $Author = $6 ? $6 : 'NULL';
	    	my $CurrentChunkNumber = chunkNumberCode($CurrentChunk);
            	# Handle exceptions
            	# 'PS' is actually 'F' + 'PS'
	    	if($CurrentType eq 'P' || $CurrentStyle =~ /P[AB]/)
	    	{
            		$CurrentStyle = $CurrentType.$CurrentStyle;
            		$CurrentType = 'F';
	    		$CurrentStyle = 'PR' if $CurrentStyle =~ /P[AB]/;
	    	};

	    	# Make Other Values readable
	    	my $CurrentSex = $1 if $CurrentSpeakerID =~ /^([A-Z])/i;
	    	my $CurrentAge = $1 if $CurrentSpeakerID =~ /(\d+)/;
	    	my $CurrentTextDescr = $RealNames{$CurrentType} ? $RealNames{$CurrentType} : $CurrentType;
	    	$CurrentTextDescr .= $RealNames{$CurrentStyle} ? $RealNames{$CurrentStyle} : $CurrentStyle;

	    	# Get information on file contents
	    	my $CharacterCount = 0;
	    	my $WordCount = 0;
	    	my $LineCount = 0;
	    	my $SentenceCount = 0;

	    	open(TEXTFILE, $FilePath) || die "$FilePath: $!\n";
	    	while(<TEXTFILE>)
	    	{
				# Skip empty lines
				next unless /\S/;
				next if /^\#/;

				chomp; # Remove EOL
				++$LineCount;  # Count non-empty lines
				++$SentenceCount while /[\.\:\;\?\!]+/g;  # Count non-empty lines
				$CharacterCount += length($_); # Count characters
				s/[\.\,\?\!\:\;\'\"\`]/ /g; # Remove punctuation
				$WordCount += scalar(split(' ', $_)); # Count words

	    	};

	    	# Store Database information
	    	my $CurrentDatabaseFile = "${CurrentSpeakerID}$TableName.txt";
	    	# Create a database file if it doesn't exist
	    	unless(-e "$DatabaseFiles$CurrentDatabaseFile")
	    	{
			open(DATABASE, ">$DatabaseFiles$CurrentDatabaseFile") 
			|| die "$DatabaseFiles$CurrentDatabaseFile: $!\n";
			print DATABASE "\#> ", join("\n\#> ", @ColumnHeaders), "\n# \n# $TableName\n# \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 DATABASE $_;
				};
				close(LICENSE)
			};

			close(DATABASE);
	    	};

	    	my $CurrentRecord = ""
	    	."$FileName\t"
	    	."$CurrentSpeakerID\t"
	    	."$CurrentSex\t"
	    	."$CurrentAge\t"
	    	."$CurrentType\t"
	    	."$CurrentStyle\t"
	    	."$CurrentTextDescr\t"
	    	."$CurrentRecording\t"
	    	."$CurrentChunk\t"
	    	."$CurrentChunkNumber\t"
	    	."$Author\t"
	    	."$SentenceCount\t$LineCount\t$WordCount\t$CharacterCount\t"
	    	."\n";


	    	# Open the correct DatabaseFile and add the current record
	    	open(DATABASE, ">>$DatabaseFiles$CurrentDatabaseFile") 
	    	|| die "$DatabaseFiles$CurrentDatabaseFile: $!\n";
	    	print DATABASE $CurrentRecord;
	    	close(DATABASE);
		};

    };
    
    
};

