###########################################################################
#
# translator.pm --
# 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.
#
###########################################################################


# Common functions used by the different parts of the translator
package translator;


use util;
use GDBM_File;


my $gsdldir = "$ENV{'GSDLHOME'}";
my $maincfgfile = &util::filename_cat($gsdldir, "etc", "main.cfg");
my $translatordir = &util::filename_cat($gsdldir, "translator");
my $translatorcfgfile = &util::filename_cat($gsdldir, "etc", "translator.cfg");

my $cvsroot = ":pserver:cvs_anon\@cvs.scms.waikato.ac.nz:2402/usr/local/global-cvs/gsdl-src";


sub get_translator_dir
{
    return $translatordir;
}


sub get_cvs_root
{
    return $cvsroot;
}


sub read_languages_from_main_cfg_file
{
    my %code2namehash = ();

    # Read the main.cfg file
    if (!open(MAIN_CFG_FILE, "<$maincfgfile")) {
	print STDERR "Error: Could not open $maincfgfile.\n";
	die "\n";
    }
    while (<MAIN_CFG_FILE>) {
	my $line = $_;
	chomp($line);

	# Parse the lines containing a language definition
	if ($line =~ m/^Language\s+/i) {
	    my ($langcode) = ($line =~ /shortname=(\S+)/i);
	    my ($langname) = ($line =~ /longname=(\"[^\"]+\"|\S+)/i);

	    # Casefold the language code, and remove any quotes around the language name
 	    $langcode =~ tr/A-Z/a-z/;
	    $langname =~ s/^\"(.+)\"$/$1/;

  	    $code2namehash{$langcode} = $langname;
	}
    }
    close(MAIN_CFG_FILE);

    return %code2namehash;
}


sub read_translation_files_from_config_file
{
    my %name2deschash = ();

    # Read the translator config file
    if (!open(CONFIG_FILE, "<$translatorcfgfile")) {
	print STDERR "Error: Could not open $translatorcfgfile.\n";
	die "\n";
    }
    while (<CONFIG_FILE>) {
	my $line = $_;
	chomp($line);

	# Check if a file is being defined
	if ($line =~ m/^File\s+/i) {
	    my ($fileid) = ($line =~ /id=(\S+)/i);
	    my ($filedesc) = ($line =~ /description=(\S+)/i);
	    $name2deschash{$fileid} = $filedesc;
	}
    }
    close(CONFIG_FILE);

    return %name2deschash;
}


sub read_file_data_from_config_file
{
    my ($sourceabbr, $targetabbr, $file) = @_;

    # Read the translator config file
    if (!open(CONFIG_FILE, "<$translatorcfgfile")) {
	print STDERR "Error: Could not open $translatorcfgfile.\n";
	die "\n";
    }
    while (<CONFIG_FILE>) {
	my $line = $_;
	chomp($line);

	# Check if a file is being defined
  	if ($line =~ m/^File\s+/i) {
  	    my @lineparts = split(/\s+/, $line);
  	    my ($fileid) = ($lineparts[1] =~ m/^id=(.*)$/);

	    # If this is the file we want, return its details
	    if ($fileid eq $file) {
		my ($filedesc) = ($lineparts[2] =~ m/^description=(.*)$/);
		my ($sourcefile) = ($lineparts[3] =~ m/^sourcefile=(.*)$/);
 		my ($targetfile) = ($lineparts[4] =~ m/^targetfile=(.*)$/);
 		my ($filetype) = ($lineparts[5] =~ m/^type=(.*)$/);

		# Determine sourcebase and targetbase, using the filetype
		my $sourcebase = &get_file_base($sourceabbr, $filetype);
		my $targetbase = &get_file_base($targetabbr, $filetype);

		# Resolve instances of {sourceabbr}, {sourcebase}, {targetabbr}, {targetbase}
		$sourcefile =~ s/\{sourceabbr\}/$sourceabbr/g;
		$sourcefile =~ s/\{sourcebase\}/$sourcebase/g;
  		$targetfile =~ s/\{targetabbr\}/$targetabbr/g;
  		$targetfile =~ s/\{targetbase\}/$targetbase/g;

		close(CONFIG_FILE);
		return ($sourcefile, $targetfile, $filetype);
	    }
  	}
    }
    close(CONFIG_FILE);

    return ();
}


sub get_translation_file_path
{
    my ($translationdir, $relativefilepath) = @_;

    # Extract the file name from the relative file path
    $relativefilepath =~ /([^\\\/]+)$/;
    return &util::filename_cat($translationdir, $1);
}


sub get_file_base
{
    my ($langabbr, $filetype) = @_;

    if ($filetype =~ /^macrofile/) {
	return &get_macrofile_base($langabbr);
    }
    if ($filetype =~ /^resourcebundle/ || $filetype =~ /^myresourcebundle/) {
	return &get_resource_bundle_base($langabbr);
    }

    print STDERR "Error: Unknown file type $filetype.\n";
    die "\n";
}


sub process_file
{
    my ($filepath, $filetype) = @_;

    # Build a mapping from key to lines
    my %linehash = &build_key_to_line_mapping($filepath, $filetype);

    # Build a mapping from chunk key to chunk text, and return
    return &build_key_to_text_mapping($filepath, $filetype, %linehash);
}


sub build_key_to_line_mapping
{
    my ($filepath, $filetype) = @_;

    if ($filetype =~ /^macrofile/) {
	return &build_key_to_line_mapping_for_macrofile($filepath);
    }
    if ($filetype =~ /^resourcebundle/) {
	return &build_key_to_line_mapping_for_resource_bundle($filepath);
    }
    if ($filetype =~ /^myresourcebundle/) {
	return &build_key_to_line_mapping_for_my_resource_bundle($filepath);
    }

    print STDERR "Error: Unknown file type $filetype.\n";
    die "\n";
}


sub build_key_to_text_mapping
{
    my ($filepath, $filetype, %linehash) = @_;

    if (!open(FILE_IN, "<$filepath")) {
	print STDERR "Error: Could not open file $filepath.\n";
	die "\n";
    }
    my @lines = <FILE_IN>;
    close FILE_IN;

    my %chunks = ();

    foreach $key (keys(%linehash)) {
	# Chunk lines in linehash start at 0
	my $chunkstart = (split(/-/, $linehash{$key}))[0];
	my $chunkfinish = (split(/-/, $linehash{$key}))[1];

	my $chunktext = $lines[$chunkstart];
	for ($l = ($chunkstart + 1); $l <= $chunkfinish; $l++) {
	    $chunktext .= $lines[$l];
	}

	# Map from chunk key to (formatted) text
	$chunks{$key} = &import_chunk($chunktext, $filetype);
    }

    return %chunks;
}


sub import_chunk
{
    my ($chunktext, $filetype) = @_;

    if ($filetype =~ /^macrofile/) {
	return &import_chunk_from_macrofile($chunktext);
    }
    if ($filetype =~ /^resourcebundle/) {
	return &import_chunk_from_resource_bundle($chunktext);
    }
    if ($filetype =~ /^myresourcebundle/) {
	return &import_chunk_from_my_resource_bundle($chunktext);
    }

    print STDERR "Error: Unknown file type $filetype.\n";
    die "\n";
}


sub refresh_translation
{
    my ($translationdir, $sourcefile, $filetype) = @_;


    # -----------------------------------------
    #   Process the source language file
    # -----------------------------------------

    # Parse the backup source language file, building a mapping from chunk key to chunk text
    my $sourcepath = &get_translation_file_path($translationdir, $sourcefile);
    my %backuphash = &process_file($sourcepath, $filetype);
    print STDOUT "Number of backup chunks: " . scalar(keys(%backuphash)) . "\n";

    # Remove the (possibly out of date) source file
    my $hotsourcepath = &util::filename_cat($gsdldir, $sourcefile);
#    &util::rm($hotsourcepath);

    # Get the latest version of the source file from CVS
#    my $sourceupdate = `cd $gsdldir; cvs -d $cvsroot update $sourcefile`;
#    if ($sourceupdate !~ /^U /) {
#	print STDERR "Error: Could not update source file.\n";
#	die "\n";
#    }

    # Check that the source file now exists
    if (!-e $hotsourcepath) {
	print STDERR "Error: Source file $hotsourcepath does not exist.\n";
	die "\n";
    }

    # Copy the new version of the source file to become the backup file
    &util::cp($hotsourcepath, $sourcepath);

    # Parse the new source language file, building a mapping from chunk key to chunk text
    my %sourcehash = &process_file($sourcepath, $filetype);
    print STDOUT "Number of source chunks: " . scalar(keys(%sourcehash)) . "\n";


    # -----------------------------------------
    #   Rebuild the translation database
    # -----------------------------------------

    # Open the translation database for this file
    my $translationdb = &util::filename_cat($translationdir, "translation.db");
    my %translationdata = ();
    tie(%translationdata, "GDBM_File", $translationdb, GDBM_WRCREAT, 0666);

    # Remove translation data for any chunks that no longer exist
    foreach $key (keys(%translationdata)) {
	my $sourcekey = $key;
	if ($sourcekey =~ /\*$/) {
	    chop($sourcekey);
	}

	# If the chunk doesn't exist in the new source file, remove it from the database
	if (!defined($sourcehash{$sourcekey})) {
	    print STDOUT "Chunk with key $key no longer exists!\n";
	    delete $translationdata{$key};
	}
    }

    # Update the translation database to reflect the new source file
    foreach $key (keys(%sourcehash)) {
	# Add translation data for any new chunks
	if (!defined($backuphash{$key})) {
	    print STDOUT "Chunk with key $key is new!\n";
	    $translationdata{$key} = "";
	}

	# Source chunks that have changed since last time must have their translations updated
	if ($backuphash{$key} && $backuphash{$key} ne $sourcehash{$key}) {
	    print STDOUT "Chunk with key $key needs updating!\n";
	    $translationdata{$key . "*"} = "";
	}
    }

    # Close the old translation database
    untie(%translationdata);
}


# ==========================================================================================

sub get_macrofile_base
{
    my ($langcode) = @_;

    # List special cases here (macrofile names differ from language longnames)
    my %specialcases = ('es', 'spanish',
			'fr', 'french',
			'id', 'indo',
			'kz', 'kazakh',
			'pt-br', 'port-br',
			'pt-pt', 'port-pt',
			'ru', 'russian',
			'zh-tr', 'chinese-trad',
			'zh', 'chinese' );

    # Special cases override main.cfg entries
    if ($specialcases{$langcode}) {
	return $specialcases{$langcode};
    }

    # Use the language name defined in the main.cfg file as the macrofile name
    my %langhash = &read_languages_from_main_cfg_file();
    my $langname = $langhash{$langcode} || die "Error: Language to base mapping undefined!\n";
    $langname =~ tr/A-Z/a-z/;
    return $langname;
}


sub build_key_to_line_mapping_for_macrofile
{
    my ($filepath) = @_;

    # Open file for reading
    if (!open(FILE_IN, "<$filepath")) {
	print STDERR "Error: Could not open macrofile $filepath.\n";
	die "\n";
    }
    my @lines = <FILE_IN>;
    close FILE_IN;

    # Initialise some my variables
    my $currpackage;
    my %linehash = ();

    # Process the contents of the file, line by line
    for ($i = 0; $i < scalar(@lines); $i++) {
	my $line = $lines[$i];
	$line =~ s/(\s*)$//;  # Remove any nasty whitespace, carriage returns etc.

	# Check if a new package is being defined
	if ($line =~ m/^package\s+(.+)/) {
	    $currpackage = $1;
	}

	# Line contains a macro name
	elsif ($line =~ m/^(_\w+_)/) {
	    my $macroname = $1;
	    $line =~ s/\s*([^\\]\#.+)?$//;  # Remove any comments and nasty whitespace

	    # While there is still text of the macro to go...
	    my $startline = $i;
	    while ($line !~ /\}$/) {
		$i++;
		$line = $lines[$i];
		$line =~ s/(\s*)$//;  # Remove any nasty whitespace, carriage returns etc.
	    }

	    # The key consists of the package name and the macro name
	    my $key = $currpackage . "::" . $macroname;
	    # Map from key to line
	    $linehash{$key} = $startline . "-" . $i;
	}

	# Icon: line in format ## "sometext" ## macro ## macroname ##
	elsif ($line =~ m/^\#\# (.*)/) {
	    my $macroname = $1;

	    # If the macro text contains a new line it will run over two lines
	    my $startline = $i;
	    unless ($line =~ m/^\#\# .*\#\#/) {
		$i++;
		$line = $lines[$i];
		$macroname .= $line;
	    }

	    # Split the image macro header on ##
	    my @names = split(/\s*\#\#\s*/, $macroname);
	    # Overwrite macroname with macroname from ## ... ## ... ## HERE ###
	    $macroname = $names[(scalar @names) - 1];

	    # Read the rest of the text associated with the image macro
	    while (defined($line) && $line !~ /^\s*$/) {
		$i++;
		$line = $lines[$i];
	    }

	    # The key consists of package name and macro name
	    my $key = $currpackage . "::" . $macroname;
	    # Map from key to line
	    $linehash{$key} = $startline . "-" . ($i - 1);
	}
    }

    return %linehash;
}


sub import_chunk_from_macrofile
{
    my ($chunktext) = @_;

    # Is this an icon macro??
    if ($chunktext =~ /^\#\# (.*)/) {
	# Extract image macro text
	$chunktext =~ /^\#\#\s+([^\#]+)\s+\#\#/;
	$chunktext = $1;

	# Remove enclosing quotes
	$chunktext =~ s/^\"//;
	$chunktext =~ s/\"$//;
    }

    # No, so it must be a text macro
    else {
	# Remove macro key
	$chunktext =~ s/^_([^_]+)_(\s*)//;

	# Remove language specifier
	$chunktext =~ s/^\[l=.*\](\s*)//;

	# Remove braces enclosing text
	$chunktext =~ s/^{(\s*)((.|\n)*)}(\s*)(\#.+\s*)?/$2/;
    }

    return $chunktext;
}


# ------------------------------------------------------------------------------------------

sub get_resource_bundle_base
{
    my ($langabbr) = @_;

    return "";
}


sub build_key_to_line_mapping_for_resource_bundle
{
    my ($filepath) = @_;

    # Open file for reading
    if (!open(FILE_IN, "<$filepath")) {
	print STDERR "Error: Could not open resource bundle $filepath.\n";
	die "\n";
    }
    my @lines = <FILE_IN>;
    close FILE_IN;

    # Initialise some my variables
    my %linehash = ();

    # Process the contents of the file, line by line
    for ($i = 0; $i < scalar(@lines); $i++) {
	my $line = $lines[$i];
	$line =~ s/(\s*)$//;  # Remove any nasty whitespace, carriage returns etc.

	# Line contains a dictionary string
	if ($line =~ /^((\w|\.)+):(.*)$/) {
	    my $key = $1;

	    # Map from key to line
	    $linehash{$key} = $i . "-" . $i;
	}
    }

    return %linehash;
}


sub import_chunk_from_resource_bundle
{
    my ($chunktext) = @_;

    # Simple: just remove string key
    $chunktext =~ s/^((\w|\.)+)://;

    return $chunktext;
}



# ------------------------------------------------------------------------------------------

sub build_key_to_line_mapping_for_my_resource_bundle
{
    my ($filepath) = @_;

    # Open file for reading
    if (!open(FILE_IN, "<$filepath")) {
	print STDERR "Error: Could not open resource bundle $filepath.\n";
	die "\n";
    }
    my @lines = <FILE_IN>;
    close FILE_IN;

    # Initialise some my variables
    my %linehash = ();

    # Process the contents of the file, line by line
    for ($i = 0; $i < scalar(@lines); $i++) {
	my $line = $lines[$i];
	$line =~ s/(\s*)$//;  # Remove any nasty whitespace, carriage returns etc.

	# Line contains a dictionary string
	if ($line =~ /^((\w|\.|\-)+):\"(.*)$/) {
	    my $key = $1;
	    my $text = $3;

	    # While there is still text of the chunk to go...
	    my $startline = $i;
	    while ($text !~ /\"$/ || $text =~ /\\\"$/) {
		$i++;
		$text = $lines[$i];
	    }

	    $linehash{$key} = $startline . "-" . $i;
	}
    }

    return %linehash;
}


sub import_chunk_from_my_resource_bundle
{
    my ($chunktext) = @_;

    # Remove chunk key and quotes
    $chunktext =~ s/^((\w|\.|\-)+)://;
    $chunktext =~ s/^\"//;
    $chunktext =~ s/\"$//;

    return $chunktext;
}


1;
