Index: trunk/gsdl/perllib/translator.pm
===================================================================
--- trunk/gsdl/perllib/translator.pm	(revision 5276)
+++ trunk/gsdl/perllib/translator.pm	(revision 5276)
@@ -0,0 +1,476 @@
+###########################################################################
+#
+# 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
+{
+    local %name2abbrhash = ();
+
+    # 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>) {
+	local $line = $_;
+	chomp($line);
+
+	# Parse the lines containing a language definition
+	if ($line =~ m/^Language\s+/i) {
+	    local @lineparts = split(/\s+/, $line);
+	    local ($langabbr) = ($lineparts[1] =~ m/^shortname=(.*)$/);
+	    local ($langname) = ($lineparts[2] =~ m/^longname=(.*)$/);
+
+	    # Casefold language name and code
+	    $langabbr =~ tr/A-Z/a-z/;
+	    $langname =~ tr/A-Z/a-z/;
+
+	    $name2abbrhash{$langname} = $langabbr;
+	}
+    }
+    close(MAIN_CFG_FILE);
+
+    return %name2abbrhash;
+}
+
+
+sub read_translation_files_from_config_file
+{
+    local %name2deschash = ();
+
+    # Read the translator config file
+    if (!open(CONFIG_FILE, "<$translatorcfgfile")) {
+	print STDERR "Error: Could not open $translatorcfgfile.\n";
+	die "\n";
+    }
+    while (<CONFIG_FILE>) {
+	local $line = $_;
+	chomp($line);
+
+	# Check if a file is being defined
+	if ($line =~ m/^File\s+/i) {
+	    local @lineparts = split(/\s+/, $line);
+	    local ($fileid) = ($lineparts[1] =~ m/^id=(.*)$/i);
+	    local ($filedesc) = ($lineparts[2] =~ m/^description=(.*)$/i);
+	    $name2deschash{$fileid} = $filedesc;
+	}
+    }
+    close(CONFIG_FILE);
+
+    return %name2deschash;
+}
+
+
+sub read_file_data_from_config_file
+{
+    my ($sourcelang, $sourceabbr, $targetlang, $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>) {
+	local $line = $_;
+	chomp($line);
+
+	# Check if a file is being defined
+  	if ($line =~ m/^File\s+/i) {
+  	    local @lineparts = split(/\s+/, $line);
+  	    local ($fileid) = ($lineparts[1] =~ m/^id=(.*)$/);
+
+	    # If this is the file we want, return its details
+	    if ($fileid eq $file) {
+		local ($filedesc) = ($lineparts[2] =~ m/^description=(.*)$/);
+		local ($sourcefile) = ($lineparts[3] =~ m/^sourcefile=(.*)$/);
+ 		local ($targetfile) = ($lineparts[4] =~ m/^targetfile=(.*)$/);
+ 		local ($filetype) = ($lineparts[5] =~ m/^type=(.*)$/);
+
+		# Resolve instances of {sourcelang}, {sourceabbr}, {targetlang}, {targetabbr}
+		$sourcefile =~ s/\{sourcelang\}/$sourcelang/g;
+		$sourcefile =~ s/\{sourceabbr\}/$sourceabbr/g;
+  		$targetfile =~ s/\{targetlang\}/$targetlang/g;
+  		$targetfile =~ s/\{targetabbr\}/$targetabbr/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 process_file
+{
+    my ($filepath, $filetype) = @_;
+
+    # Build a mapping from key to lines
+    local %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);
+    }
+
+    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";
+    }
+    local @lines = <FILE_IN>;
+    close FILE_IN;
+
+    my %chunks = ();
+
+    foreach $key (keys(%linehash)) {
+	# Chunk lines in linehash start at 0
+	local $chunkstart = (split(/-/, $linehash{$key}))[0];
+	local $chunkfinish = (split(/-/, $linehash{$key}))[1];
+
+	local $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
+{
+    local ($chunktext, $filetype) = @_;
+
+    if ($filetype =~ /^macrofile/) {
+	return &import_chunk_from_macrofile($chunktext);
+    }
+    if ($filetype =~ /^resourcebundle/) {
+	return &import_chunk_from_resource_bundle($chunktext);
+    }
+
+    print STDERR "Error: Unknown file type $filetype.\n";
+    die "\n";
+}
+
+
+sub refresh_translation
+{
+    local ($translationdir, $sourcefile, $filetype) = @_;
+
+
+    # -----------------------------------------
+    #   Process the source language file
+    # -----------------------------------------
+
+    # Parse the backup source language file, building a mapping from chunk key to chunk text
+    local $sourcepath = &get_translation_file_path($translationdir, $sourcefile);
+    local %backuphash = &process_file($sourcepath, $filetype);
+    print STDOUT "Number of backup chunks: " . scalar(keys(%backuphash)) . "\n";
+
+    # Remove the (possibly out of date) source file
+    local $hotsourcepath = &util::filename_cat($gsdldir, $sourcefile);
+#    &util::rm($hotsourcepath);
+
+    # Get the latest version of the source file from CVS
+#    local $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
+    local %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
+    local $translationdb = &util::filename_cat($translationdir, "translation.db");
+    local %translationdata = ();
+    tie(%translationdata, "GDBM_File", $translationdb, GDBM_WRCREAT, 0666);
+
+    # Remove translation data for any chunks that no longer exist
+    foreach $key (keys(%translationdata)) {
+	local $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 build_key_to_line_mapping_for_macrofile
+{
+    local ($filepath) = @_;
+
+    # Open file for reading
+    if (!open(FILE_IN, "<$filepath")) {
+	print STDERR "Error: Could not open macrofile $filepath.\n";
+	die "\n";
+    }
+    local @lines = <FILE_IN>;
+    close FILE_IN;
+
+    # Initialise some local variables
+    local $currpackage;
+    local %linehash = ();
+
+    # Process the contents of the file, line by line
+    for ($i = 0; $i < scalar(@lines); $i++) {
+	local $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+_)/) {
+	    local $macroname = $1;
+
+	    # While there is still text of the macro to go...
+	    local $startline = $i;
+	    while ($line !~ /.*\}/) {
+		$i++;
+		$line = $lines[$i];
+	    }
+
+	    # The key consists of the package name and the macro name
+	    local $key = $currpackage . "::" . $macroname;
+	    # Map from key to line
+	    $linehash{$key} = $startline . "-" . $i;
+	}
+
+	# Icon: line in format ## "sometext" ## macro ## macroname ##
+	elsif ($line =~ m/^\#\# (.*)/) {
+	    local $macroname = $1;
+
+	    # If the macro text contains a new line it will run over two lines
+	    local $startline = $i;
+	    unless ($line =~ m/^\#\# .*\#\#/) {
+		$line = $lines[++$i];
+		$macroname .= $line;
+	    }
+
+	    # Split the image macro header on ##
+	    local @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 ($line !~ /^\s*$/) {
+		$i++;
+		$line = $lines[$i];
+	    }
+
+	    # The key consists of package name and macro name
+	    local $key = $currpackage . "::" . $macroname;
+	    # Map from key to line
+	    $linehash{$key} = $startline . "-" . ($i - 1);
+	}
+    }
+
+    return %linehash;
+}
+
+
+sub import_chunk_from_macrofile
+{
+    local ($chunktext) = @_;
+
+    # Is this an icon macro??
+    if ($chunktext =~ m/^\#\# (.*)/) {
+	# Extract image macro text
+	$chunktext =~ s/^\#\# ((.|\n)+) \#\# (.+) \#\# (.|\n)+/$1/;
+
+	# Remove enclosing quotes
+	$chunktext =~ s/^\s*\"((.|\n)+)\"\s*/$1/;
+    }
+
+    # 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*)/$2/;
+    }
+
+    return $chunktext;
+}
+
+
+# ------------------------------------------------------------------------------------------
+
+sub build_key_to_line_mapping_for_resource_bundle
+{
+    local ($filepath) = @_;
+
+    # Open file for reading
+    if (!open(FILE_IN, "<$filepath")) {
+	print STDERR "Error: Could not open resource bundle $filepath.\n";
+	die "\n";
+    }
+    local @lines = <FILE_IN>;
+    close FILE_IN;
+
+    # Initialise some local variables
+    local %linehash = ();
+
+    # Process the contents of the file, line by line
+    for ($i = 0; $i < scalar(@lines); $i++) {
+	local $line = $lines[$i];
+	$line =~ s/(\s*)$//;  # Remove any nasty whitespace, carriage returns etc.
+
+	# Line contains a dictionary string
+	if ($line =~ m/^((\w|\.)+):/) {
+	    local $key = $1;
+
+	    # Map from key to line
+	    $linehash{$key} = $i . "-" . $i;
+	}
+    }
+
+    return %linehash;
+}
+
+
+sub import_chunk_from_resource_bundle
+{
+    local ($chunktext) = @_;
+
+    # Simple: just remove string key
+    $chunktext =~ s/^((\w|\.)+)://;
+
+    return $chunktext;
+}
+
+
+1;
