#! /usr/bin/perl
#
#
if(grep(/^(\-h|\-\-help)$/, @ARGV))
{
print << "ENDOFHELPTEXT";
Create a table and fill it from a generic list.
#
Use:
./LoadCGNtable [--option=value] <TableFile1> <TableFile2>

TableFile1, 2, ...: a list of filenames with the complete, tab delimited tables
                    Each file starts a NEW table with dropping any existing table
		    with the same name!
Options:
--index=<IndexAttribute>: 
  The name of the column which should be indexed (defaults to 'id')
--host=<URL>: 
  URL of database host
--database=<Name>: 
  Name of the database
--password=<Cleartext>: 
  Password, included at your own risk
--user=<CurrentUser>: 
  DBMS username
--header=<header file>
  Use an external XML header from <header file> (skip first line)
  You can only use a single header
--insert-description=<table>
  Insert the description of the table columns into a special description table
--noloadrecords or -nl
--loadrecords
  Do not (or do indeed) really load the records into the database. But do load
  the descriptions if asked
  
'connectDB.pl' will connect default to 'localhost' with current user and no
password

The table-file format:
The table file should start with an XML header describing the table
followed by a content type and a tab delimited list of column headers
as comments (latter two are optional)
Note, it is adviced to enclose any table header in <xml></xml>
tags. If the header is not enclosed in <xml</xml> tags, the
line with the Content-type="..." MIME type label is used to end
the header and start the actual table entries.

The header tags and lay out are as follows:
----------------------
<?xml version='1.0'?>
<xml>
<table>
<table-name>ort</table-name>
<table-type>table</table-type>
<table-record index="ID">
<record-column><column-name>Style</column-name><column-type>TEXT</column-type><description LanguageId="RFC1766:en-US">Speaking style (corpus component CGN-1.0)</description></record-column>
...
<record-column><column-name>Value</column-name><column-type>TEXT</column-type><description LanguageId="RFC1766:en-US">Value of item</description></record-column>
</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/">
....
</rdf:Description>
</table>
</xml>
# Start tab separated data: Content-type="text/tab-separated-values"
#> Style	Num	Speaker	Lang	ID	Pos	Start	End	prevID	nextID	prevNE	nextNE	File	TierName	TierType	Tier	Chunk	Word	Syllable	Syllpart	Phoneme	Value
--------------

'column-type' should be one of the official PostgreSQL types (e.g., INT4, CHAR(2), TEXT)
The description can be any kind of text, as long as it doesn't contain tabs.

You can add comments. Every line that starts with a plain '#' will be ignored.

In the actual table, empty lines are ignored too.

Data lines are tab delimited relational table-records of the following form:
"ValueColumn1\\tValueColumn2\\tValueColumn3\\tValueColumn4\\tValueColumn5\\t.....\\n";

All values of a single record should fit on the same line.

It is advisable to have a (unique) indexing column which can be used to
identify individual records.

There can be multiple tables in a single file, each preceeded by it's 
own XML Header. This program will accept compressed files (GZIP, BZIP2) 
and archives (ZIP, TAR, TAR.GZ, TAR.BZ2, TAR.ZIP, TGZ). Each table will
remove any tables with the same name from the database!

ENDOFHELPTEXT
exit;
};
if(grep(/\-?\-l(icense)?/, @ARGV))
{
print << "ENDOFLICENSETEXT";
###############################################################################
#
# Copyright R.J.J.H. van Son © 2000, 2001, 2002, 2006
#
# 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;
};
#
# 
my $GlobalIndexAttribute = 'ID';
if(grep(/\-?\-i(ndex)?\=/, @ARGV))
{
    my ($Option) = grep(/\-?\-i(ndex)?\=/i, @ARGV);
    $Option =~ s/\-?\-i(ndex)?\=//isg;
    $GlobalIndexAttribute = $Option;
    @ARGV = grep(!/\-?\-i(ndex)?\=/i, @ARGV);
};
# 
# use module
use XML::Simple;
use Data::Dumper;

# Insert default values for database acces
$DBMSaddress = "uvafon.hum.uva.nl";	# "localhost";
$DBMSname = "ifadv";
# Default to current user and no password
$DBMSuser = '';
$DBMSpassword = '';

my $ExternalHeader = "";
my $DescriptionTable = "";
my $LoadRecords = 1;

# Extract user given options
if(grep(/^\-\-host\=/, @ARGV))
{
    my ($Option) = grep(/\-\-host\=/i, @ARGV);
    $Option =~ s/\-\-host\=//isg;
    $DBMSaddress = $Option;
    @ARGV = grep(!/\-\-host\=/i, @ARGV);
};
if(grep(/^\-\-database\=/, @ARGV))
{
    my ($Option) = grep(/\-\-database\=/i, @ARGV);
    $Option =~ s/\-\-database\=//isg;
    $DBMSname = $Option;
    @ARGV = grep(!/\-\-database\=/i, @ARGV);
};
if(grep(/^\-\-user\=/, @ARGV))
{
    my ($Option) = grep(/\-\-user\=/i, @ARGV);
    $Option =~ s/\-\-user\=//isg;
    $DBMSuser = $Option;
    @ARGV = grep(!/\-\-user\=/i, @ARGV);
};
if(grep(/^\-\-password\=/, @ARGV))
{
    my ($Option) = grep(/\-\-password\=/i, @ARGV);
    $Option =~ s/\-\-password\=//isg;
    $DBMSpassword = $Option;
    @ARGV = grep(!/\-\-password\=/i, @ARGV);
};

if(grep(/^\-\-header\=/, @ARGV))
{
    my ($Option) = grep(/\-\-header\=/i, @ARGV);
    $Option =~ s/\-\-header\=//isg;
    $ExternalHeader = $Option;
    @ARGV = grep(!/\-\-header\=/i, @ARGV);
};

if(grep(/^\-\-insert-description(s?)\=/, @ARGV))
{
    my ($Option) = grep(/\-\-insert-description(s?)\=/i, @ARGV);
    $Option =~ s/\-\-insert-description(s?)\=//isg;
    $DescriptionTable = $Option;
    @ARGV = grep(!/\-\-insert-description(s?)\=/i, @ARGV);
};

if(grep(/^(\-\-noload(records)?|\-nl)$/, @ARGV))
{
    $LoadRecords = 0;
    @ARGV = grep(!/\-\-insert-description(s?)\=/i, @ARGV);
};
if(grep(/^(\-\-load(records)?)$/, @ARGV))
{
    $LoadRecords = 1;
    @ARGV = grep(!/\-\-insert-description(s?)\=/i, @ARGV);
};

# Connect to Database!
require "connectDBD.pl";

# read XML file
foreach my $file (@ARGV)
{    
    next unless -s $file;
    
    print "File $file\n";
    
    # Use an external header
    my $XMLtext = "";
    my $Mime = "text/tab-separated-values";
    if($ExternalHeader)
    {
    	open(XMLFILE, "<$ExternalHeader") || die "$ExternalHeader: $!\n";
	while(<XMLFILE>)
	{
    	    # Stop if start of data section is encountered (store MIME)
    	    if(m!Content-type\=[\"\']([^\"\']+)[\"\']!)
	    {
		    $Mime = $1;
		    last;
	    };
	    next if /^\#/;

	    $XMLtext .= $_;

    	    # Stop if the end of the XML section is encountered
    	    last if m!\<\s*/\s*xml\b!isg;
	};
	close(XMLFILE);
    };
    
     # TAR
    if($file =~ /\.tar[\.]?(gz|bz2|zip)?\s*$/i || $file =~ /\.t(gz)\s*$/i)
    {
    	my $Extension = lc($1);
    	my $CompressOption = "";
	$CompressOption = "--gunzip" if($Extension eq 'gz');
	$CompressOption = "--bzip2" if($Extension eq 'bz2');
	$CompressOption = "--uncompress" if($Extension eq 'zip');
	
    	open(XMLFILE, "tar --to-stdout $CompressOption -xf '$file' |") || die "$file: $!\n";
    }
    # GZIP
    elsif($file =~ /\.gz\s*$/)
    {
    	open(XMLFILE, "gunzip -c '$file' |") || die "$file: $!\n";
    }
    # BZIP2
    elsif($file =~ /\.bz2\s*$/)
    {
    	open(XMLFILE, "bunzip2 -c '$file' |") || die "$file: $!\n";
    }
    # ZIP
    elsif($file =~ /\.zip\s*$/)
    {
    	open(XMLFILE, "unzip -p '$file' |") || die "$file: $!\n";
    }
    # PLAIN TEXT
    else
    {
    	open(XMLFILE, "<$file") || die "$file: $!\n";
    };
    
    # create object
    my $xml = new XML::Simple;

    # A single archive file can contain multiple tables
    # Start each table with reading the XML header.
    MULTIFILEARCHIVE:
    my $CurrentBase = 1000;
    my $ContinueNextTable = 0;
    my $DatabaseCreated = 0;
    unless($ExternalHeader)
    {
    	$XMLtext = "";
    	$Mime = "text/tab-separated-values";
	    HEADER: while(<XMLFILE>)
	    {
    	    # Stop if start of data section is encountered (store MIME)
    	    if(m!Content-type\=[\"\']([^\"\']+)[\"\']!)
	        {
		        $Mime = $1;
		        last HEADER;
	        };
	        next if /^\#/;

	        $XMLtext .= $_;

    	    # Stop if the end of the XML section is encountered
    	    last if m!\<\s*/\s*xml\b!isg;
	    };
    }
    # If an external header was used, skip first line
    else
    {
    	while(<XMLFILE>)
	    {
		    last if /\S/;
	    };
    };

    my $data = $xml->XMLin($XMLtext);

    # Some people might drop the enclosing <xml></xml> tags
    # and start immediately with the <table></table> tags.
    # Help them!
    $data = {table => $data} unless exists($data->{table});

    # Debugging code
    # print Dumper($data);
    
    my $TableName = $data->{table}->{'table-name'};
    print "Loading table: $TableName\n";
    my $TableDescription = $data->{table}->{'table-name'};
    
    my $IndexAttribute = $data->{table}->{'table-record'}->{index}; 
    $IndexAttribute = $GlobalIndexAttribute unless $IndexAttribute =~ /\S/;
    $IndexAttribute =~ s/[^\w\-]//isg;
    unless($IndexAttribute)
    {
    	die "No valid Index Attribute: '",
         $data->{table}->{'table-record'}->{index}, "' or '$GlobalIndexAttribute'\n";
    };

    # print output
    my @Columns = ("");
    @Columns = ();
    my @ValueTypes = ();
    my @Descriptions = ();
    die "DIE: @Columns\n" if scalar(@Columns) > 0;
    foreach my $RecordColumn (@{$data->{table}->{'table-record'}->{'record-column'}})
    {	
    	push(@Columns, $RecordColumn->{'column-name'});
    	push(@ValueTypes, $RecordColumn->{'column-type'});
    	push(@Descriptions, $RecordColumn->{'description'}->{'content'});
	
        # Debugging code
    	#print "$RecordColumn->{'column-name'}\t$RecordColumn->{'column-type'}\t$RecordColumn->{'description'}->{'content'}\n";
    };
    
    # Only load this description into the database in table $DescriptionTable
    my %ColumnNames = ();
    %ColumnNames = ();
    if($DescriptionTable =~ /\S/)
    {
    	# Remove existing rows for this table
	$result = $conn->do("DELETE FROM $DescriptionTable WHERE tablename = '$TableName';");
	if($conn->err)
	{
	    print STDERR $conn->errstr,
		    ": DELETE FROM $DescriptionTable WHERE tablename = '$TableName';\n";

	    die "\n";
	}; 
	
	
	my $InsertList = "'$TableName', 'tabledescription', 'TEXT', '$TableDescription'";
	# Insert the record
	$result = $conn->do("INSERT INTO $DescriptionTable VALUES ($InsertList);");

	if($conn->err)
	{
	    print STDERR $conn->errstr,
		    ": INSERT INTO $DescriptionTable VALUES ($InsertList);\n";

	    die "\n";
	}; 
	
	for($i=0; $i < scalar(@Columns); ++$i)
	{
	    $Columns[$i] = "EndTime" if $Columns[$i] eq 'End';
	    # NO hyphens in names
	    $Columns[$i] =~ s/\-/\_/ig if $Columns[$i] =~ /\-/;
	    $ValueTypes[$i] = "TEXT" if $ValueTypes[$i] eq 'CHAR4';

	    # Prevent double column names
	    ++$ColumnNames{$Columns[$i]};
	    if($ColumnNames{$Columns[$i]} > 1)
	    {
		$Columns[$i] .= $ColumnNames{$Columns[$i]};
	    };
		
	    # Construct the insert list
	    $InsertList = join(", ", "'$TableName'", "'$Columns[$i]'", "'$ValueTypes[$i]'", "'$Descriptions[$i]'");

	    # Insert the record
	    $result = $conn->do("INSERT INTO $DescriptionTable VALUES ($InsertList);");

	    if($conn->err)
	    {
		print STDERR $conn->errstr,
			": INSERT INTO $DescriptionTable VALUES ($InsertList);\n";

		die "\n";
	    }; 
	};
    	
    };
    
    # Create database, unless this has already been done before
    %ColumnNames = ();
    unless($DatabaseCreated || $LoadRecords == 0)
    {
	    # Remove old table
	    $result = $conn->do("DROP TABLE $TableName");

	    # Create new table	

	    # Construct table definition for CREATE
	    my $i;
	    my $ColumnDef = "";

	    # Get odd values
	    for($i=0; $i < scalar(@Columns); ++$i)
	    {
	    	$Columns[$i] = "EndTime" if $Columns[$i] eq 'End';
		    # NO hyphens in names
	    	$Columns[$i] =~ s/\-/\_/ig if $Columns[$i] =~ /\-/;
	    	$ValueTypes[$i] = "TEXT" if $ValueTypes[$i] eq 'CHAR4';
		
		# Prevent double column names
		++$ColumnNames{$Columns[$i]};
		if($ColumnNames{$Columns[$i]} > 1)
		{
		    print STDERR "Error: Use of existing column name: $Columns[$i] $ColumnNames{$Columns[$i]}\n";
		    $Columns[$i] .= $ColumnNames{$Columns[$i]};
		};
		
		# Add to definition
		$ColumnDef .= "$Columns[$i] $ValueTypes[$i], \n";
	    };
	    $ColumnDef =~ s/\,\s*$//g;

	    # Create table
	    $result = $conn->do("CREATE TABLE $TableName ($ColumnDef);");

	    print STDERR $conn->errstr, 
			    ": CREATE TABLE $TableName ($ColumnDef);\n" if $conn->err;

	    $DatabaseCreated = scalar(@Columns);
	    %ColumnNames = ();
    };
    
    # Get the delimiter (tab-separated-values of csv)
    if(exists($data->{'rdf:Description'}->{'dc:format'}))
    {
    	$Mime = $data->{'rdf:Description'}->{'dc:format'};
    };
    $Delimiter = "\t";
    $Delimiter = "\t" if($Mime =~ m!text/tab-separated-values!);
    $Delimiter = "\t" if($Mime =~ m!text/tsv!);
    $Delimiter = "," if($Mime =~ m!text/comma-separatated-values!); # Doesn't work reliably
    $Delimiter = "," if($Mime =~ m!text/csv!); # Doesn't work reliably
    
    
    # Fill Table
    my $RecordNr = 1;
    
    my $Record = 0;
    TABLE: while(<XMLFILE>)
    {
    	my $Line = $_;
	
	# Skip comments and empty lines
    # Skip line following Content-type specification
    if($Line =~ m!Content-type=[\"\']text/!)
    {
        <XMLFILE>;
        next TABLE;
    };
	next if $Line =~ /^(\#|\s*$)/;
	
	# Jump if their is a new XML header entered
	if($Line =~ /\<[^\w]*xml/isg)
	{
		$XMLtext = "$Line";
		$ContinueNextTable = 1;
		last TABLE;
	};
	
	next unless $LoadRecords;
	
	# Keep user informed about progress
	++$RecordNr;
	unless(($RecordNr) % ($CurrentBase))
	{
	    print "Currently at record $RecordNr\n";
	    $CurrentBase *= 2;
	};
	
	chomp($Line);
	$Line =~ s/\s+$//g;

	# Split the lines
	my @Values = split(/$Delimiter/, $Line);

	# Add '-quotes to char values
	my $InsertList = "";
	my $i;
	for($i=0; $i < scalar(@Values); ++$i)
	{
	    $Values[$i] =~ s/\e\'/\&eacute;/g;
	    $Values[$i] =~ s/\'/\&quot;/g;
        # Text values should be enclosed in ''-quotes, unless they are NULL
	    $Values[$i] = "E'$Values[$i]'" if($ValueTypes[$i] =~ /char|text|date/i && $Values[$i] ne 'NULL');
	    $Values[$i] = 'NULL' if($Values[$i] =~ /^[\s\+\-]+$/ && $ValueTypes[$i] !~ /char|text/i) ;
	    $Values[$i] = 'NULL' if($Values[$i] =~ /[^\d\+\-]/ && $ValueTypes[$i] =~ /int/i) ;
	    $Values[$i] = 'NULL' if($Values[$i] =~ /[^\d\.\+\-]/ && $ValueTypes[$i] =~ /float/i) ;
	    $Values[$i] = 'NULL' unless $Values[$i] =~ /\S/;	# Ensure that there is some value
    };

	# Construct the insert list
	$InsertList = join(", ", @Values);

	# Insert the record
	$result = $conn->do("INSERT INTO $TableName VALUES ($InsertList);");

	if($conn->err)
	{
	    print STDERR $conn->errstr,
		    ": INSERT INTO $TableName VALUES ($InsertList);\n";

	    while(@Values || @ValueTypes)
	    {
                print STDERR "'", shift(@Values), "'\t->\t'", shift(@ValueTypes), "'\n";
	    };

	    die "$ColumnDef\n";
	}; 
    };

    # Final cleanup, creating the index etc. But ONLY if records should
    # be loaded
    if($LoadRecords)
    {
	# Create indices on ID (Number)
	$result = $conn->do("CREATE INDEX ${TableName}_index ON $TableName ($IndexAttribute);");
	print STDERR $conn->errstr,  
	  ": create index ${TableName}_index on $TableName (Number);\n" if $conn->err;

	# Grant SELECT to the public
	my @ary = ();
	$conn->do("GRANT SELECT on $TableName TO PUBLIC");
	print "GRANT SELECT on $TableName TO PUBLIC: ",$conn->errstr, "\n";

	# Test data
	my @ary = $conn->selectrow_array("select count($IndexAttribute) from $TableName");

	print "Query $TableName: ",$conn->errstr, " ", $ary[0], "\n";
    };
    
    # Yes, this should not be a goto. However, I
    # expect some users to concatenate table files
    # or to load archives
    goto MULTIFILEARCHIVE if $ContinueNextTable;


    # Cleanly leave file
    close(XMLFILE);
};

