#!/usr/bin/perl -w

###########################################################################
# submit_translation.pl
#
# A component of the Greenstone digital library software
# from the New Zealand Digital Library Project at the 
# University of Waikato, New Zealand.
#
# Copyright (C) 1999 New Zealand Digital Library Project
#
# 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., 675 Mass Ave, Cambridge, MA 02139, USA.
#
###########################################################################

#SYNOPSIS OF CODE:
#Processes translation when user clicks the 'SUBMIT TRANSLATION >>' button on
#greenstone site. Takes the cgiargsclass and the language being translated
#into, extracts the macronames and macrotext from the cgi data and hashes
#them, then links this hash to a database and updates database appropriately

BEGIN {
    die "GSDLHOME not set\n" unless defined $ENV{'GSDLHOME'};
    unshift (@INC, "$ENV{'GSDLHOME'}/perllib");
}


use util;
use GDBM_File;


my %translationdata = ();
my %updatedata = ();


sub main
{
    # Get the name of the source (base) language
    my $sourcelang = shift(@_);
    # Get the name of the target language
    my $targetlang = shift(@_);
    # Get the name of the args file with the cgiargsclass data in it
    my $argsfile = shift(@_);

    # Check that all arguments were supplied
    if (!$sourcelang) {
	die "Error: You didn't supply the name of the source language!\n";
    }
    if (!$targetlang) {
	die "Error: You didn't supply the name of the target language!\n";
    }
    if (!$argsfile) {
	die "Error: You didn't supply the name of the arguments file!\n";
    }

    # Casefold both language names
    $sourcelang =~ tr/A-Z/a-z/;
    $targetlang =~ tr/A-Z/a-z/;

    my $gsdldir = "$ENV{'GSDLHOME'}";
    my $langdir = util::filename_cat($gsdldir, "tmp", "lang");
    my $translationdir = util::filename_cat($langdir, $sourcelang . "-" . $targetlang);
    my $translationdb = util::filename_cat($translationdir, "translation.db");
    my $updatedb = util::filename_cat($translationdir, "update.db");

    # Open the two database files for the translation
    tie(%translationdata, "GDBM_File", $translationdb, 1, 0640);
    tie(%updatedata, "GDBM_File", $updatedb, 1, 0640);

    # Parse the translation submissions
    my $targetcode = $translationdata{"*target_lang_code*"};
    print "Target code: $targetcode\n";
    my $submissions = &parse_user_submission($sourcelang, $targetlang, $targetcode,
					     util::filename_cat($translationdir, $argsfile));

    # Add the submissions to the translation database
    &add_submissions_to_database($submissions);

    # Writes the target macro files
    my $macrosdir = util::filename_cat($gsdldir, "macros");
    &update_target_macrofiles($targetlang, $macrosdir, $submissions);

    # Clean up
    untie %translationdata;
    untie %updatedata;
}


sub parse_user_submission
{
    my ($sourcelang, $targetlang, $targetcode, $filename) = @_;

    #opens the args file or kills program
    open(ARGUMENTS, "<$filename") or die("Error: Could not open $filename.\n");

    #stores a hash of macronames with numbers still appended and their values
    my %distinctkeys = ();
    my %icontextvals = ();

    #while there are still lines left to read
    my $macroname = "";
    my $macrovalue = "";
    while (<ARGUMENTS>) {
	#gets the line
	$line = $_;
	#chomps off the final newline character
	chomp($line);
	# removes nasty carriage returns and formfeeds
	$line =~ s/\r$//;
	$line =~ s/\f$//;
	# print "Line: $line\n";

	# Does the line contain a new CGI argument?
	if ($line =~ m/^ \"/) {
	    # If the line contains :: (browser converts to %3A%3A) then it has a macroname
	    if ($line =~ m/%3A%3A/) {
		#hashes the previous macro and its value, provided the value is non-empty
		if ($macrovalue =~ m/\S+/) {
		    # Add the icontext macros to a separate list
		    if ($macroname =~ m/::icontext$/) {
			$icontextvals{$macroname} = $macrovalue;
		    }
		    else {
			$distinctkeys{$macroname} = $macrovalue;
		    }
		}

		$macroname = $line;
		#changes the codes back to ::
		$macroname =~ s/%3A%3A/::/g;
		#removes value of macro leaving just the name
		$macroname =~ s/=.*//;
		#saves the value
		$macrovalue = $&;
		#removes all " from macro
		$macroname =~ s/\"//g;
		#removes any whitespace from macro
		$macroname =~ s/\s+//g;

		#removes all " and = from value
		$macrovalue =~ s/=//g;
		$macrovalue =~ s/\A\"//;
		$macrovalue =~ s/\"\Z//;
		$macrovalue =~ s/<br>/\n/g;
	    }
	    else {
		#hashes the previous macro and its value, provided the value is non-empty
		if ($macroname ne "" && $macrovalue =~ m/\S+/) {
		    # Add the icontext macros to a separate list
		    if ($macroname =~ m/::icontext$/) {
			$icontextvals{$macroname} = $macrovalue;
		    }
		    else {
			$distinctkeys{$macroname} = $macrovalue;
		    }
		}
		$macroname = "";
		$macrovalue = "";
	    }
	}
	# No, so check if it is part of a multi-line macro
	else {
	    if ($macroname ne "") {
		$extravalue = $line;
		#removes all " and = from value
		$extravalue =~ s/=//g;
		$extravalue =~ s/\A\"//;
		$extravalue =~ s/\"\Z//;
		$extravalue =~ s/<br>/\n/g;
		# add this line to the current macro value
		$macrovalue = $macrovalue . "\n" . $extravalue;
	    }
	}
    }

    close ARGUMENTS;

    # Create a hash map containing the translations to add
    my %translations = ();

    for $sourcekey (sort keys %distinctkeys) {
	my $macrotext = "";

	# Check if this macro is an icon macro
	my $iconkey = $sourcekey . "::icontext";
	if ($icontextvals{$iconkey}) {
	    my $icontext = $icontextvals{$iconkey};

	    # Add the language code to each part of the icon macro
	    # -- This should be done by translate.pl when the images are created --
	    $icontext =~ s/(\n_[^_]+_)(\s*)/$1 \[l=$targetcode\] /g;
	    $icontext =~ s/( {_[^_]+_)(.*)(\/([^\/]+)})/$1\/$targetcode$3/g;

	    $macrotext = "## \"" . $distinctkeys{$sourcekey} . "\" " . $icontext . "\n";
	}
	# It must be a text macro
	else {
	    $macrotext = "[l=$targetcode] {" . $distinctkeys{$sourcekey} . "}\n";
	}

	my $targetkey = &get_macroname_equivalent($sourcelang, $targetlang, $sourcekey);
	$translations{$targetkey} = $macrotext;
    }

    return (\%translations);
}


sub get_macrofile_name
{
    my ($language, $suffix) = @_;

    my $macrofilename = $language;

    # Handles cases where the macro file name is different to the language name
    $macrofilename = "port" if ($language =~ m/portuguese/);
    $macrofilename = "indo" if ($language =~ m/indonesian/);

    # Add suffix (if any) and file extension, and return
    $macrofilename = $macrofilename . $suffix . ".dm";
    return $macrofilename;
}


sub get_macroname_equivalent
{
    my ($languageA, $languageB, $languageAkey) = @_;

    my $macrofile = $languageAkey;
    $macrofile =~ s/^([^:]+)::(.*)/$1/;
    my $key = $languageAkey;
    $key =~ s/^([^:])+::(.*)/$2/;

    my $languageBkey;
    if ($macrofile eq &get_macrofile_name($languageA, "")) {
	$languageBkey = &get_macrofile_name($languageB, "") . "::" . $key;
    }
    if ($macrofile eq &get_macrofile_name($languageA, "2")) {
	$languageBkey = &get_macrofile_name($languageB, "2") . "::" . $key;
    }

    return ($languageBkey);
}


sub add_submissions_to_database
{
    my ($submissions) = @_;

    # Write each submission to the database
    foreach $key (sort keys(%$submissions)) {
	$translationdata{$key} = $submissions->{$key};

	# If this was one of the macros needing updating, it has been
	if ($updatedata{$key}) {
	    delete $updatedata{$key};
	}
    }
}


sub update_target_macrofiles
{
    my ($targetlang, $macrosdir, $submissions) = @_;

    # Split the submissions by macrofile
    my %submissions1 = ();
    my %submissions2 = ();
    foreach $key (keys %$submissions) {
	if (&core_or_auxiliary_macro($targetlang, $key) eq "core") {
	    $submissions1->{$key} = $submissions->{$key};
	}
	else {
	    $submissions2->{$key} = $submissions->{$key};
	}
    }

    # Add the submissions into the appropriate files
    my $macrofile1 = &get_macrofile_name($targetlang, "");
    &add_submissions_into_macrofile($targetlang, $macrosdir, $macrofile1, $submissions1);
    my $macrofile2 = &get_macrofile_name($targetlang, "2");
    &add_submissions_into_macrofile($targetlang, $macrosdir, $macrofile2, $submissions2);
}


sub core_or_auxiliary_macro
{
    my ($language, $sourcekey) = @_;

    my $macrofile = $sourcekey;
    $macrofile =~ s/^([^:]+)::(.*)/$1/;

    if ($macrofile eq ($language . ".dm")) {
	return "core";
    }
    if ($macrofile eq ($language . "2.dm")) {
	return "auxiliary";
    }
}


sub add_submissions_into_macrofile
{
    my ($targetlang, $macrosdir, $macrofile, $submissions) = @_;

    # Opens the macro file or dies a miserable death
    my $macropath = util::filename_cat($macrosdir, $macrofile);
    open(MACROFILE_IN, "<$macropath") or die "Error: Could not open $macropath.\n";
    open(MACROFILE_TMP, ">$macrofile.tmp") or die "Error: Could not write $macrofile.tmp\n";

    my $curroutline = 0;
    my $currpackage;
    my $currpackageinsertionpoint = $curroutline;
    my %insertionpoints = ();
    while (<MACROFILE_IN>) {
	#currline++;

	# Check if a new package is being defined
	if (/^package (.*)/) {
	    # Is this the end of a previous package?
	    if ($currpackage) {
		# Yes, so remember the insertion point for the package
		$insertionpoints{$currpackageinsertionpoint} = $currpackage;
	    }
	    $currpackage = $1;
	    print MACROFILE_TMP $_;
	    $curroutline++;
	}

	# Check if an icon macro is being defined
	elsif (/^(\#\# .*)/) {
	    my $iconmacro = $1;

	    # In the case where the macroname contains a new line, read the next line too
	    unless ($iconmacro =~ m/^\#\# .*\#\#/) {
		$iconmacro .= "\n" . <MACROFILE_IN>;
		chomp($iconmacro);
		# $currline++;
		$curroutline++;
	    }

	    # Split the icon macro header on "##"
	    my @iconparts = split(/\s*\#\#\s*/, $iconmacro);
	    # The macroname is the last element of the header (ie. ## ... ## ... ## this ##)
	    my $macroname = $iconparts[(scalar @iconparts) - 1];

	    # The key consists of macro file, package name, and macro name
	    my $macrokey = $macrofile . "::" . $currpackage . "::" . $macroname;

	    # Check if this macro has just been submitted
	    my $newsubmission = "false";
	    if ($submissions->{$macrokey}) {
		# It has, so write the submitted text
		$newsubmission = "true";
		print MACROFILE_TMP $submissions->{$macrokey} . "\n";
		$count = ($submissions->{$macrokey} =~ tr/\n/\n/);
		$curroutline = $curroutline + $count;
		delete $submissions->{$macrokey};
	    }
	    else {
		# It hasn't, so write the old macro
		print MACROFILE_TMP $iconmacro . "\n";
		$curroutline++;
	    }

	    # Chew up the old macro text, spitting it out if necessary
	    do {
		$_ = <MACROFILE_IN>;
		# $currline++;
		if ($newsubmission ne "true") {
		    print MACROFILE_TMP $_;
		    $curroutline++;
		}
	    } until ($_ =~ /^\s+/);

	    # Remember where this macro finished
	    $currpackageinsertionpoint = $curroutline;
	}

	# Check if a text macro is being defined
	elsif (/^(_\w+_)(.*)/) {
	    # Get the name of the macro
	    my $macroname = $1;
	    print MACROFILE_TMP $macroname;

	    # The key consists of macro file, package name, and macro name
	    my $macrokey = $macrofile . "::" . $currpackage . "::" . $macroname;

	    # Check if this macro has just been submitted
	    my $newsubmission = "false";
	    if ($submissions->{$macrokey}) {
		# It has, so write the submitted text
		$newsubmission = "true";
		print MACROFILE_TMP $submissions->{$macrokey};
		$count = ($submissions->{$macrokey} =~ tr/\n/\n/);
		$curroutline = $curroutline + $count;
		delete $submissions->{$macrokey};
	    }
	    else {
		# It hasn't, so write the old macro text
		print MACROFILE_TMP $2 . "\n";
		$curroutline++;
	    }

	    # Chew up the old macro text, spitting it out if necessary
	    while ($_ !~ /.*\}/) {
		$_ = <MACROFILE_IN>;
		# $currline++;
		if ($newsubmission ne "true") {
		    print MACROFILE_TMP $_;
		    $curroutline++;
		}
	    }

	    # Remember where this macro finished
	    $currpackageinsertionpoint = $curroutline;
	}

	# The line must just be a comment or whitespace
	else {
	    print MACROFILE_TMP $_;
	    $curroutline++;
	}
    }

    # Close opened files
    close MACROFILE_TMP;
    close MACROFILE_IN;

    open(MACROFILE_TMP, "<$macrofile.tmp") or die "Error: Could not open $macrofile.tmp\n";
    # open(MACROFILE_OUT, ">$macrofile.out") or die "Error: Could not write $macrofile.out\n";
    open(MACROFILE_OUT, ">$macropath") or die "Error: Could not write $macropath\n";

    # Insert the new macro submissions in the correct place
    $currline = 0;
    while (<MACROFILE_TMP>) {
	$currline++;

	# Are we at a package insertion point?
	if ($insertionpoints{$currline}) {
	    $currpackage = $insertionpoints{$currline};

	    # Yes, so check if there are any macros to insert here
	    foreach $key (keys %$submissions) {
		$key =~ m/^[^:]+::([^:]+)::(.*)/;
		my $packagename = $1;
		my $macroname = $2;

		if ($packagename eq $currpackage) {
		    # Insert this macro here
		    &write_macro_to_file($macroname, $submissions->{$key}, MACROFILE_OUT);
		    delete $submissions->{$key};
		}
	    }
	}

	print MACROFILE_OUT $_;
    }

    # If there are any submissions still remaining, write them to a new package at the end
    $currpackage = "";
    foreach $key (sort (keys %$submissions)) {
	$key =~ m/^[^:]+::([^:]+)::(.*)/;
	my $packagename = $1;
	my $macroname = $2;

	if ($packagename ne $currpackage) {
	    # Write package header
	    print MACROFILE_OUT "\n";
	    print MACROFILE_OUT "########################################################\n";
	    print MACROFILE_OUT "package $packagename\n";
	    print MACROFILE_OUT "########################################################\n";

	    $currpackage = $packagename;
	}

	# Write macro
	&write_macro_to_file($macroname, $submissions->{$key}, MACROFILE_OUT);
	delete $submissions->{$key};
    }

    # Close opened files
    close MACROFILE_OUT;
    close MACROFILE_TMP;

    # Delete the temporary file
    unlink("$macrofile.tmp");
}


sub write_macro_to_file
{
    my ($macroname, $macrotext, $filehandle) = @_;

    print MACROFILE_OUT "\n";
    print MACROFILE_OUT "# Macro added using the translation agency\n";

    if ($macrotext =~ m/\#\# (^|.)*/) {
	# Icon macro
	print MACROFILE_OUT $macrotext;
    }
    else {
	# Text macro
	print MACROFILE_OUT $macroname . $macrotext;
    }
}


&main(@ARGV);
