source: main/tags/2.40/gsdl/bin/script/submit_translation.pl@ 21085

#!/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);