root/main/trunk/greenstone2/bin/script/gti.pl @ 24223

Revision 24223, 77.2 KB (checked in by ak19, 8 years ago)

More changes to do with obtaining the perlpath using Config: moved the Use Config statement into the Begin block (it cannot be a Require statement for some reason).

  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
Line 
1#!/usr/bin/perl -w
2
3###########################################################################
4#
5# gti.pl
6#
7# A component of the Greenstone digital library software
8# from the New Zealand Digital Library Project at the
9# University of Waikato, New Zealand.
10#
11# Copyright (C) 2005 New Zealand Digital Library Project
12#
13# This program is free software; you can redistribute it and/or modify
14# it under the terms of the GNU General Public License as published by
15# the Free Software Foundation; either version 2 of the License, or
16# (at your option) any later version.
17#
18# This program is distributed in the hope that it will be useful,
19# but WITHOUT ANY WARRANTY; without even the implied warranty of
20# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
21# GNU General Public License for more details.
22#
23# You should have received a copy of the GNU General Public License
24# along with this program; if not, write to the Free Software
25# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
26#
27###########################################################################
28
29
30BEGIN {
31    die "GSDLHOME not set\n" unless defined $ENV{'GSDLHOME'};
32    unshift (@INC, "$ENV{'GSDLHOME'}/perllib");
33
34    if(!$ENV{'PERLPATH'}) {
35    use Config; # for getting the perlpath in the recommended way
36    my $full_perl_exec = $Config{perlpath}; #$^X;
37    require File::Basename;
38    my $perl_path = File::Basename::dirname($full_perl_exec);
39    $ENV{'PERLPATH'} = $perl_path;
40    }
41}
42
43use iso639;
44use strict;
45use util;
46
47
48#my $anonymous_cvs_root = ":pserver:cvs_anon\@cvs.scms.waikato.ac.nz:2402/usr/local/global-cvs/gsdl-src";
49#my $anonymous_svn_root = "http://http://svn.greenstone.org/gsdl/trunk/";
50my $gsdl_root_directory = "$ENV{'GSDLHOME'}";
51my $gti_log_file = &util::filename_cat($gsdl_root_directory, "etc", "gti.log");
52my $source_language_code = "en";  # This is non-negiotable
53
54my $gti_translation_files =
55    [ # Greenstone macrofiles
56      { 'key' => "coredm",
57    'file_type' => "macrofile",
58    'source_file' => "macros/english.dm",
59    'target_file' => "macros/{bn:bengali;fa:farsi;gd:gaelic;id:indo;lv:latvian;pt-br:port-br;pt-pt:port-pt;zh-tr:chinese-trad;iso_639_1_target_language_name}.dm" },
60      { 'key' => "auxdm",
61    'file_type' => "macrofile",
62    'source_file' => "macros/english2.dm",
63    'target_file' => "macros/{bn:bengali;fa:farsi;gd:gaelic;id:indo;lv:latvian;pt-br:port-br;pt-pt:port-pt;zh-tr:chinese-trad;iso_639_1_target_language_name}2.dm" },
64
65      # GLI dictionary
66      { 'key' => "glidict",
67    'file_type' => "resource_bundle",
68    'source_file' => "gli/classes/dictionary.properties",
69    'target_file' => "gli/classes/dictionary_{target_language_code}.properties" },
70
71      # GLI help
72      { 'key' => "glihelp",
73    'file_type' => "greenstone_xml",
74    'source_file' => "gli/help/en/help.xml",
75    'target_file' => "gli/help/{target_language_code}/help.xml" },
76
77      # Greenstone Perl modules
78      { 'key' => "perlmodules",
79    'file_type' => "resource_bundle",
80    'source_file' => "perllib/strings.properties",
81    'target_file' => "perllib/strings_{target_language_code}.properties" },
82
83      # Greenstone tutorial exercises
84      # { 'key' => "tutorials",
85    # 'file_type' => "greenstone_xml",
86    # 'source_file' => "gsdl-documentation/tutorials/xml-source/tutorial_en.xml",
87    # 'target_file' => "gsdl-documentation/tutorials/xml-source/tutorial_{target_language_code}.xml" },
88
89      # new Greenstone.org
90      { 'key' => "greenorg",
91        'file_type' => "resource_bundle",
92        'source_file' => "greenstoneorg/website/classes/Gsc.properties",
93        'target_file' => "greenstoneorg/website/classes/Gsc_{iso_639_1_target_language_name}.properties"
94    # 'file_type' => "macrofile",
95    # 'source_file' => "greenorg/macros/english.dm",
96    # 'target_file' => "greenorg/macros/{iso_639_1_target_language_name}.dm"
97      }
98
99      # { 'key' => "gs3interface",
100    #'file_type' => "resource_bundle",
101    #'source_file' => "greenstone3",
102    #'target_file' => "greenstone3"
103      #}
104    ];
105
106my @gs3_interface_files = ("AbstractBrowse", "AbstractGS2FieldSearch", "Authentication", "CrossCollectionSearch", "GATEServices", "GS2Construct", "GS2LuceneSearch", "interface_default", "interface_nzdl", "IViaSearch", "LuceneSearch", "MapRetrieve", "MapSearch", "metadata_names", "PhindPhraseBrowse", "QBRWebServicesHelp", "Visualizer");
107
108
109sub main
110{
111    # Get the command to process, and any arguments
112    my $gti_command = shift(@_);
113    my @gti_command_arguments = @_;
114    my $module = $_[1];
115
116    # Open the GTI log file for appending, or write to STDERR if that fails
117    if (!open(GTI_LOG, ">>$gti_log_file")) {
118    open(GTI_LOG, ">&STDERR");
119    }
120
121    # Log the command that launched this script
122    &log_message("Command: $0 @ARGV");
123
124    # Check that a command was supplied
125    if (!$gti_command) {
126    &throw_fatal_error("Missing command.");
127    }     
128
129    # Process the command
130    if ($gti_command =~ /^get-all-chunks$/i) {
131    # Check that GS3 interface is the target
132    if ($module eq "gs3interface") {       
133        print &get_all_chunks_for_gs3(@gti_command_arguments);
134    } else {
135        print &get_all_chunks(@gti_command_arguments);
136    }
137    }
138    if ($gti_command =~ /^get-first-n-chunks-requiring-work$/i) {
139    if ($module eq "gs3interface") {       
140        print &get_first_n_chunks_requiring_work_for_gs3(@gti_command_arguments);
141    } else {
142        print &get_first_n_chunks_requiring_work(@gti_command_arguments);
143    }
144    }
145    if ($gti_command =~ /^get-language-status$/i) {
146    print &get_language_status(@gti_command_arguments);       
147    }
148    if ($gti_command =~ /^search-chunks$/i) {
149    print &search_chunks(@gti_command_arguments);
150    }
151    if ($gti_command =~ /^submit-translations$/i) {
152    # This command cannot produce any output since it reads input
153    &submit_translations(@gti_command_arguments);
154    }
155    if ($gti_command =~ /^create-glihelp-zip-file$/i) {
156    # This command cannot produce any output since it reads input
157    &create_glihelp_zip_file(@gti_command_arguments);
158    }
159#    else {
160    # The command was not recognized
161    #&throw_fatal_error("Unknown command \"$gti_command\".");
162    #}
163}
164
165
166sub throw_fatal_error
167{
168    my $error_message = shift(@_);
169
170    # Write an XML error response
171    print "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>\n";
172    print "<GTIResponse>\n";
173    print "  <GTIError time=\"" . time() . "\">" . $error_message . "</GTIError>\n";
174    print "</GTIResponse>\n";
175
176    # Log the error message, then die
177    &log_message("Error: $error_message");
178    die "\n";
179}
180
181
182sub log_message
183{
184    my $log_message = shift(@_);
185    print GTI_LOG time() . " -- " . $log_message . "\n";
186}
187
188
189sub get_all_chunks
190{
191    # The code of the target language (ensure it is lowercase)
192    my $target_language_code = lc(shift(@_));
193    # The key of the file to translate (ensure it is lowercase)
194    my $translation_file_key = lc(shift(@_));
195
196    # Check that the necessary arguments were supplied
197    if (!$target_language_code || !$translation_file_key) {
198    &throw_fatal_error("Missing command argument.");
199    }
200
201    # Get (and check) the translation configuration
202    my ($source_file, $target_file, $translation_file_type)
203    = &get_translation_configuration($target_language_code, $translation_file_key);
204
205    # Parse the source language and target language files
206    my $source_file_path = &util::filename_cat($gsdl_root_directory, $source_file);
207    my @source_file_lines = &read_file_lines($source_file_path);
208    my %source_file_key_to_line_mapping = &build_key_to_line_mapping(\@source_file_lines, $translation_file_type);
209   
210    my $target_file_path = &util::filename_cat($gsdl_root_directory, $target_file);
211    my @target_file_lines = &read_file_lines($target_file_path);
212    my %target_file_key_to_line_mapping = &build_key_to_line_mapping(\@target_file_lines, $translation_file_type);
213
214    # Filter out any automatically translated chunks
215    foreach my $chunk_key (keys(%source_file_key_to_line_mapping)) {
216    if (&is_chunk_automatically_translated($chunk_key, $translation_file_type)) {
217        delete $source_file_key_to_line_mapping{$chunk_key};
218        delete $target_file_key_to_line_mapping{$chunk_key};
219    }
220    }
221
222    my %source_file_key_to_text_mapping = &build_key_to_text_mapping(\@source_file_lines, \%source_file_key_to_line_mapping, $translation_file_type);
223    my %target_file_key_to_text_mapping = &build_key_to_text_mapping(\@target_file_lines, \%target_file_key_to_line_mapping, $translation_file_type);
224    &log_message("Number of source chunks: " . scalar(keys(%source_file_key_to_text_mapping)));
225    &log_message("Number of target chunks: " . scalar(keys(%target_file_key_to_text_mapping)));
226
227    my %source_file_key_to_last_update_date_mapping = &build_key_to_last_update_date_mapping($source_file, \@source_file_lines, \%source_file_key_to_line_mapping, $translation_file_type);
228    my %target_file_key_to_last_update_date_mapping = &build_key_to_last_update_date_mapping($target_file, \@target_file_lines, \%target_file_key_to_line_mapping, $translation_file_type);
229
230    my $xml_response = &create_xml_response_for_all_chunks($translation_file_key, $target_file, \%source_file_key_to_text_mapping, \%target_file_key_to_text_mapping, \%source_file_key_to_last_update_date_mapping, \%target_file_key_to_last_update_date_mapping);   
231   
232    return $xml_response;
233}
234
235
236sub get_first_n_chunks_requiring_work
237{
238    # The code of the target language (ensure it is lowercase)
239    my $target_language_code = lc(shift(@_));
240    # The key of the file to translate (ensure it is lowercase)
241    my $translation_file_key = lc(shift(@_));
242    # The number of chunks to return (defaults to one if not specified)
243    my $num_chunks_to_return = shift(@_) || "1";
244
245    # Check that the necessary arguments were supplied
246    if (!$target_language_code || !$translation_file_key) {
247    &throw_fatal_error("Missing command argument.");
248    }
249
250    # Get (and check) the translation configuration
251    my ($source_file, $target_file, $translation_file_type)
252    = &get_translation_configuration($target_language_code, $translation_file_key);
253
254    # Parse the source language and target language files
255    my $source_file_path = &util::filename_cat($gsdl_root_directory, $source_file);
256    my @source_file_lines = &read_file_lines($source_file_path);
257    my %source_file_key_to_line_mapping = &build_key_to_line_mapping(\@source_file_lines, $translation_file_type);
258   
259    my $target_file_path = &util::filename_cat($gsdl_root_directory, $target_file);
260    my @target_file_lines = &read_file_lines($target_file_path);
261    my %target_file_key_to_line_mapping = &build_key_to_line_mapping(\@target_file_lines, $translation_file_type);
262
263    # Filter out any automatically translated chunks
264    foreach my $chunk_key (keys(%source_file_key_to_line_mapping)) {
265    if (&is_chunk_automatically_translated($chunk_key, $translation_file_type)) {
266        delete $source_file_key_to_line_mapping{$chunk_key};
267        delete $target_file_key_to_line_mapping{$chunk_key};
268    }
269    }
270
271    my %source_file_key_to_text_mapping = &build_key_to_text_mapping(\@source_file_lines, \%source_file_key_to_line_mapping, $translation_file_type);
272    my %target_file_key_to_text_mapping = &build_key_to_text_mapping(\@target_file_lines, \%target_file_key_to_line_mapping, $translation_file_type);
273    &log_message("Number of source chunks: " . scalar(keys(%source_file_key_to_text_mapping)));
274    &log_message("Number of target chunks: " . scalar(keys(%target_file_key_to_text_mapping)));
275
276    # Determine the target file chunks requiring translation
277    my @target_file_keys_requiring_translation = &determine_chunks_requiring_translation(\%source_file_key_to_text_mapping, \%target_file_key_to_text_mapping);
278    &log_message("Number of target chunks requiring translation: " . scalar(@target_file_keys_requiring_translation));
279
280    # Determine the target file chunks requiring updating
281    my %source_file_key_to_last_update_date_mapping = &build_key_to_last_update_date_mapping($source_file, \@source_file_lines, \%source_file_key_to_line_mapping, $translation_file_type);
282    my %target_file_key_to_last_update_date_mapping = &build_key_to_last_update_date_mapping($target_file, \@target_file_lines, \%target_file_key_to_line_mapping, $translation_file_type);
283    my @target_file_keys_requiring_updating = &determine_chunks_requiring_updating(\%source_file_key_to_last_update_date_mapping, \%target_file_key_to_last_update_date_mapping);
284    &log_message("Number of target chunks requiring updating: " . scalar(@target_file_keys_requiring_updating));
285
286    my $xml_response = &create_xml_response_for_chunks_requiring_work($translation_file_key, $target_file, scalar(keys(%source_file_key_to_text_mapping)), \@target_file_keys_requiring_translation, \@target_file_keys_requiring_updating, $num_chunks_to_return, \%source_file_key_to_text_mapping, \%target_file_key_to_text_mapping, \%source_file_key_to_last_update_date_mapping, \%target_file_key_to_last_update_date_mapping);   
287   
288    return $xml_response;
289}
290
291
292sub get_language_status
293{
294    # The code of the target language (ensure it is lowercase)
295    my $target_language_code = lc(shift(@_));
296
297    # Check that the necessary arguments were supplied
298    if (!$target_language_code) {
299    &throw_fatal_error("Missing command argument.");
300    }
301
302    # Form an XML response to the command
303    my $xml_response = "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>\n";
304    $xml_response .= "<GTIResponse>\n";
305    $xml_response .= "  <LanguageStatus code=\"$target_language_code\">\n";
306
307    foreach my $translation_file (@$gti_translation_files) {   
308    my ($num_source_chunks, $num_target_chunks, $num_chunks_requiring_translation, $num_chunks_requiring_updating) = 0;
309    my $target_file_name = "";
310   
311    if ($translation_file->{'key'} eq "gs3interface") {
312        my (%source_file_key_to_text_mapping, %target_file_key_to_text_mapping, %source_file_key_to_last_update_date_mapping, %target_file_key_to_last_update_date_mapping ) = ();
313        &build_gs3_configuration($target_language_code, \%source_file_key_to_text_mapping, \%target_file_key_to_text_mapping, \%source_file_key_to_last_update_date_mapping, \%target_file_key_to_last_update_date_mapping );   
314       
315        my @target_file_keys_requiring_translation = &determine_chunks_requiring_translation(\%source_file_key_to_text_mapping, \%target_file_key_to_text_mapping);     
316        my @target_file_keys_requiring_updating = &determine_chunks_requiring_updating(\%source_file_key_to_last_update_date_mapping, \%target_file_key_to_last_update_date_mapping);
317
318        $num_source_chunks = scalar(keys(%source_file_key_to_text_mapping));
319        $num_target_chunks = scalar(keys(%target_file_key_to_text_mapping));
320        $num_chunks_requiring_translation = scalar(@target_file_keys_requiring_translation);
321        $num_chunks_requiring_updating = scalar(@target_file_keys_requiring_updating);
322    }
323    else {
324        # Get (and check) the translation configuration
325        my ($source_file, $target_file, $translation_file_type) = &get_translation_configuration($target_language_code, $translation_file->{'key'});
326        $target_file_name = $target_file;
327
328        # Parse the source language and target language files
329        my $source_file_path = &util::filename_cat($gsdl_root_directory, $source_file);
330        my @source_file_lines = &read_file_lines($source_file_path);
331        my %source_file_key_to_line_mapping = &build_key_to_line_mapping(\@source_file_lines, $translation_file_type);
332
333        my $target_file_path = &util::filename_cat($gsdl_root_directory, $target_file);
334        my @target_file_lines = &read_file_lines($target_file_path);
335        my %target_file_key_to_line_mapping = &build_key_to_line_mapping(\@target_file_lines, $translation_file_type);
336
337        # Filter out any automatically translated chunks
338        foreach my $chunk_key (keys(%source_file_key_to_line_mapping)) {
339        if (&is_chunk_automatically_translated($chunk_key, $translation_file_type)) {
340            delete $source_file_key_to_line_mapping{$chunk_key};
341            delete $target_file_key_to_line_mapping{$chunk_key};
342        }
343        }
344
345        my %source_file_key_to_text_mapping = &build_key_to_text_mapping(\@source_file_lines, \%source_file_key_to_line_mapping, $translation_file_type);
346        my %target_file_key_to_text_mapping = &build_key_to_text_mapping(\@target_file_lines, \%target_file_key_to_line_mapping, $translation_file_type);
347
348        # Determine the target file chunks requiring translation
349        my @target_file_keys_requiring_translation = &determine_chunks_requiring_translation(\%source_file_key_to_text_mapping, \%target_file_key_to_text_mapping);     
350
351        # Determine the target file chunks requiring updating
352        my @target_file_keys_requiring_updating = ();
353        if (-e $target_file_path) {
354        my %source_file_key_to_last_update_date_mapping = &build_key_to_last_update_date_mapping($source_file, \@source_file_lines, \%source_file_key_to_line_mapping, $translation_file_type);
355        my %target_file_key_to_last_update_date_mapping = &build_key_to_last_update_date_mapping($target_file, \@target_file_lines, \%target_file_key_to_line_mapping, $translation_file_type);
356        @target_file_keys_requiring_updating = &determine_chunks_requiring_updating(\%source_file_key_to_last_update_date_mapping, \%target_file_key_to_last_update_date_mapping);     
357        }
358
359        $num_source_chunks = scalar(keys(%source_file_key_to_text_mapping));
360        $num_target_chunks = scalar(keys(%target_file_key_to_text_mapping));
361        $num_chunks_requiring_translation = scalar(@target_file_keys_requiring_translation);
362        $num_chunks_requiring_updating = scalar(@target_file_keys_requiring_updating);
363    }
364   
365    &log_message("Status of " . $translation_file->{'key'});
366    &log_message("Number of source chunks: " . $num_source_chunks);
367    &log_message("Number of target chunks: " . $num_target_chunks);
368    &log_message("Number of target chunks requiring translation: " . $num_chunks_requiring_translation);
369    &log_message("Number of target chunks requiring updating: " . $num_chunks_requiring_updating);
370
371    $xml_response .= "    <TranslationFile"
372        . " key=\"" . $translation_file->{'key'} . "\""
373        . " target_file_path=\"" . $target_file_name . "\""
374        . " num_chunks_translated=\"" . ($num_source_chunks - $num_chunks_requiring_translation) . "\""
375        . " num_chunks_requiring_translation=\"" . $num_chunks_requiring_translation . "\""
376        . " num_chunks_requiring_updating=\"" . $num_chunks_requiring_updating . "\"\/>\n";
377    }
378
379    $xml_response .= "  </LanguageStatus>\n";
380
381    $xml_response .= "</GTIResponse>\n";
382    return $xml_response;
383}
384
385
386sub search_chunks
387{
388    # The code of the target language (ensure it is lowercase)
389    my $target_language_code = lc(shift(@_));
390    # The key of the file to translate (ensure it is lowercase)
391    my $translation_file_key = lc(shift(@_));
392    # The query string
393    my $query_string = join(' ', @_);
394
395    # Check that the necessary arguments were supplied
396    if (!$target_language_code || !$translation_file_key || !$query_string) {
397    &throw_fatal_error("Missing command argument.");
398    }
399
400    my ($source_file, $target_file, $translation_file_type) = ();
401    my %source_file_key_to_text_mapping = ();
402    my %target_file_key_to_text_mapping = ();
403   
404   
405    if ($translation_file_key ne "gs3interface") {
406    # Get (and check) the translation configuration
407    ($source_file, $target_file, $translation_file_type) = &get_translation_configuration($target_language_code, $translation_file_key);
408
409    # Parse the source language and target language files
410    my $source_file_path = &util::filename_cat($gsdl_root_directory, $source_file);
411    my @source_file_lines = &read_file_lines($source_file_path);
412    my %source_file_key_to_line_mapping = &build_key_to_line_mapping(\@source_file_lines, $translation_file_type);
413
414    my $target_file_path = &util::filename_cat($gsdl_root_directory, $target_file);
415    my @target_file_lines = &read_file_lines($target_file_path);
416    my %target_file_key_to_line_mapping = &build_key_to_line_mapping(\@target_file_lines, $translation_file_type);
417
418    # Filter out any automatically translated chunks
419    foreach my $chunk_key (keys(%source_file_key_to_line_mapping)) {
420        if (&is_chunk_automatically_translated($chunk_key, $translation_file_type)) {
421        delete $source_file_key_to_line_mapping{$chunk_key};
422        delete $target_file_key_to_line_mapping{$chunk_key};
423        }
424    }
425
426    %source_file_key_to_text_mapping = &build_key_to_text_mapping(\@source_file_lines, \%source_file_key_to_line_mapping, $translation_file_type);
427    %target_file_key_to_text_mapping = &build_key_to_text_mapping(\@target_file_lines, \%target_file_key_to_line_mapping, $translation_file_type);
428    }
429    else {
430    # Not needed in this case
431    my (%source_file_key_to_gti_command_mapping, %target_file_key_to_gti_command_mapping) = ();
432    &build_gs3_configuration($target_language_code, \%source_file_key_to_text_mapping, \%target_file_key_to_text_mapping,
433                 \%source_file_key_to_gti_command_mapping, \%target_file_key_to_gti_command_mapping);
434    }
435
436    &log_message("Number of source chunks: " . scalar(keys(%source_file_key_to_text_mapping)));
437    &log_message("Number of target chunks: " . scalar(keys(%target_file_key_to_text_mapping)));
438
439    # Determine the target file chunks matching the query
440    my @target_file_keys_matching_query = ();
441    foreach my $chunk_key (keys(%target_file_key_to_text_mapping)) {
442    my $target_file_text = $target_file_key_to_text_mapping{$chunk_key};
443    if ($target_file_text =~ /$query_string/i) {
444        # &log_message("Chunk with key $chunk_key matches query.");
445        push(@target_file_keys_matching_query, $chunk_key);
446    }
447    }
448
449    # Form an XML response to the command
450    my $xml_response = "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>\n";
451    $xml_response .= "<GTIResponse>\n";
452
453    $xml_response .= "  <ChunksMatchingQuery size=\"" . scalar(@target_file_keys_matching_query) . "\">\n";
454    foreach my $chunk_key (@target_file_keys_matching_query) {
455    my $target_file_chunk_text = &make_text_xml_safe($target_file_key_to_text_mapping{$chunk_key});
456
457    $xml_response .= "    <Chunk key=\"$chunk_key\">\n";
458    $xml_response .= "      <TargetFileText>$target_file_chunk_text</TargetFileText>\n";
459    $xml_response .= "    </Chunk>\n";
460    }
461    $xml_response .= "  </ChunksMatchingQuery>\n";
462
463    $xml_response .= "</GTIResponse>\n";
464    return $xml_response;
465}
466
467
468sub submit_translations
469{
470    # The code of the target language (ensure it is lowercase)
471    my $target_language_code = lc(shift(@_));
472    # The key of the file to translate (ensure it is lowercase)
473    my $translation_file_key = lc(shift(@_));
474    # The username of the translation submitter
475    my $submitter_username = shift(@_);
476    # Whether to submit a target chunk even if it hasn't changed
477    my $force_submission_flag = shift(@_);
478
479    # Check that the necessary arguments were supplied
480    if (!$target_language_code || !$translation_file_key || !$submitter_username) {
481    &log_message("Fatal error (but cannot be thrown): Missing command argument.");
482    die "\n";
483    }
484   
485    my %source_file_key_to_text_mapping = ();
486    my %source_file_key_to_gti_comment_mapping = ();
487    my %target_file_key_to_text_mapping = ();
488    my %target_file_key_to_gti_comment_mapping = ();
489
490    my (@source_file_lines, @target_file_lines) = ();
491    my ($source_file, $target_file, $translation_file_type);
492
493   
494    if ($translation_file_key ne "gs3interface") {
495    # Get (and check) the translation configuration
496    ($source_file, $target_file, $translation_file_type)
497        = &get_translation_configuration($target_language_code, $translation_file_key);
498
499    # Parse the source language and target language files
500    @source_file_lines = &read_file_lines(&util::filename_cat($gsdl_root_directory, $source_file));
501    my %source_file_key_to_line_mapping = &build_key_to_line_mapping(\@source_file_lines, $translation_file_type);
502    %source_file_key_to_text_mapping = &build_key_to_text_mapping(\@source_file_lines, \%source_file_key_to_line_mapping, $translation_file_type);
503    %source_file_key_to_gti_comment_mapping = &build_key_to_gti_comment_mapping(\@source_file_lines, \%source_file_key_to_line_mapping, $translation_file_type);   
504
505    @target_file_lines = &read_file_lines(&util::filename_cat($gsdl_root_directory, $target_file));
506    my %target_file_key_to_line_mapping = &build_key_to_line_mapping(\@target_file_lines, $translation_file_type);
507    %target_file_key_to_text_mapping = &build_key_to_text_mapping(\@target_file_lines, \%target_file_key_to_line_mapping, $translation_file_type);
508    %target_file_key_to_gti_comment_mapping = &build_key_to_gti_comment_mapping(\@target_file_lines, \%target_file_key_to_line_mapping, $translation_file_type);   
509    }
510    else {
511    &build_gs3_configuration($target_language_code, \%source_file_key_to_text_mapping, \%target_file_key_to_text_mapping,
512                 \%source_file_key_to_gti_comment_mapping, \%target_file_key_to_gti_comment_mapping);
513    }
514    &log_message("Number of source chunks: " . scalar(keys(%source_file_key_to_text_mapping)));
515    &log_message("Number of target chunks: " . scalar(keys(%target_file_key_to_text_mapping)));
516
517    # Submission date
518    my $day = (localtime)[3];
519    my $month = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")[(localtime)[4]];
520    my $year = (localtime)[5] + 1900;
521    my $submission_date = "$day-$month-$year";
522
523    open(SUBMISSION, "-");
524    my @submission_lines = <SUBMISSION>;
525    close(SUBMISSION);
526
527    # Remove any nasty carriage returns
528    # &log_message("Submission:");
529    foreach my $submission_line (@submission_lines) {
530    $submission_line =~ s/\r$//;
531    #&log_message("  $submission_line");
532    }
533
534    my %source_file_key_to_submission_mapping = ();
535    my %target_file_key_to_submission_mapping = ();
536    for (my $i = 0; $i < scalar(@submission_lines); $i++) {
537    # Read source file part of submission
538    if ($submission_lines[$i] =~ /^\<SourceFileText key=\"(.+)\"\>/) {
539        my $chunk_key = $1;
540
541        # Read the source file text
542        my $source_file_chunk_text = "";
543        $i++;
544        while ($i < scalar(@submission_lines) && $submission_lines[$i] !~ /^\<\/SourceFileText\>/) {
545        $source_file_chunk_text .= $submission_lines[$i];
546        $i++;
547        }
548        $source_file_chunk_text =~ s/\n$//;  # Strip the extra newline character added
549        $source_file_chunk_text = &unmake_text_xml_safe($source_file_chunk_text);
550
551        #&log_message("Source file key: $chunk_key");
552        #&log_message("Source file text: $source_file_chunk_text");
553        $source_file_key_to_submission_mapping{$chunk_key} = $source_file_chunk_text;
554    }
555
556    # Read target file part of submission
557    if ($submission_lines[$i] =~ /^\<TargetFileText key=\"(.+)\"\>/) {
558        my $chunk_key = $1;
559
560        # Read the target file text
561        my $target_file_chunk_text = "";
562        $i++;
563        while ($i < scalar(@submission_lines) && $submission_lines[$i] !~ /^\<\/TargetFileText\>/) {
564        $target_file_chunk_text .= $submission_lines[$i];
565        $i++;
566        }
567        $target_file_chunk_text =~ s/\n$//;  # Strip the extra newline character added
568        $target_file_chunk_text = &unmake_text_xml_safe($target_file_chunk_text);
569
570        #&log_message("Target file key: $chunk_key");
571        #&log_message("Target file text: $target_file_chunk_text");
572        $target_file_key_to_submission_mapping{$chunk_key} = $target_file_chunk_text;
573    }
574    }
575
576    # -----------------------------------------
577    #   Validate the translation submissions
578    # -----------------------------------------
579
580    # Check that the translations are valid
581    foreach my $chunk_key (keys(%source_file_key_to_submission_mapping)) {
582    # Make sure the submitted chunk still exists in the source file
583    if (!defined($source_file_key_to_text_mapping{$chunk_key})) {
584        &log_message("Warning: Source chunk $chunk_key no longer exists (ignoring submission).");
585        delete $source_file_key_to_submission_mapping{$chunk_key};
586        delete $target_file_key_to_submission_mapping{$chunk_key};
587        next;
588    }
589
590    # Make sure the submitted source chunk matches the source file chunk
591    if ($source_file_key_to_submission_mapping{$chunk_key} ne &unmake_text_xml_safe($source_file_key_to_text_mapping{$chunk_key})) {
592        &log_message("Warning: Source chunk $chunk_key has changed (ignoring submission).");
593        &log_message("Submission source: $source_file_key_to_submission_mapping{$chunk_key}");
594        &log_message("      Source text: $source_file_key_to_text_mapping{$chunk_key}");
595        delete $source_file_key_to_submission_mapping{$chunk_key};
596        delete $target_file_key_to_submission_mapping{$chunk_key};
597        next;
598    }
599    }
600
601    # Apply the submitted translations
602    foreach my $chunk_key (keys(%target_file_key_to_submission_mapping)) {
603    # Only apply the submission if it is a change, unless -force_submission has been specified
604    if ($force_submission_flag || !defined($target_file_key_to_text_mapping{$chunk_key}) || $target_file_key_to_submission_mapping{$chunk_key} ne $target_file_key_to_text_mapping{$chunk_key}) {
605        $target_file_key_to_text_mapping{$chunk_key} = $target_file_key_to_submission_mapping{$chunk_key};
606        $target_file_key_to_gti_comment_mapping{$chunk_key} = "Updated $submission_date by $submitter_username";
607    }
608    }
609   
610    if ($translation_file_key ne "gs3interface") {
611    eval "&write_translated_${translation_file_type}(\$source_file, \\\@source_file_lines, \\\%source_file_key_to_text_mapping, \$target_file, \\\@target_file_lines, \\\%target_file_key_to_text_mapping, \\\%target_file_key_to_gti_comment_mapping, \$target_language_code)";
612    } else {
613    eval "&write_translated_gs3interface(\\\%source_file_key_to_text_mapping, \\\%target_file_key_to_text_mapping, \\\%target_file_key_to_gti_comment_mapping, \$target_language_code)";
614    }
615}
616
617
618sub create_glihelp_zip_file
619{
620    my $target_language_code = shift(@_);
621    my $translation_file_key = "glihelp";
622   
623    &log_message("Creating GLI Help zip file for $target_language_code");
624
625    my ($source_file, $target_file, $translation_file_type) = &get_translation_data_for($target_language_code, $translation_file_key);   
626   
627    my $classpath = &util::filename_cat($gsdl_root_directory, "gti-lib");
628    if ( ! -e $classpath) {
629    &throw_fatal_error("$classpath doesn't exist! Need the files in this directory (ApplyXLST and its related files) to create the zip file for GLI Help");
630    }   
631   
632    my $gli_help_directory = &util::filename_cat($gsdl_root_directory, "gli");
633    $gli_help_directory = &util::filename_cat($gli_help_directory, "help");
634   
635    my $gen_many_html_xsl_filepath = &util::filename_cat($gli_help_directory, "gen-many-html.xsl");
636    if ( ! -e $gen_many_html_xsl_filepath) {
637    &throw_fatal_error("$gen_many_html_xsl_filepath doesn't exist! Need this file to create the zip file for GLI Help");
638    }
639
640    my $gen_index_xml_xsl_filepath = &util::filename_cat($gli_help_directory, "gen-index-xml.xsl");   
641    my $split_script_filepath = &util::filename_cat($gli_help_directory, "splithelpdocument.pl");   
642   
643    my $target_file_directory = &util::filename_cat($gli_help_directory, $target_language_code);
644    $target_file_directory = $target_file_directory."/";
645
646    my $target_filepath = &util::filename_cat($gsdl_root_directory, $target_file);
647    my $perl_exec = &util::filename_cat($ENV{'PERLPATH'}, "perl");
648    my $java_exec = "java";
649    if(defined($ENV{'JAVA_HOME'}) && $ENV{'JAVA_HOME'} ne ""){
650    $java_exec = &util::filename_cat($ENV{'JAVA_HOME'}, "bin", "java");
651    }
652
653    my $cmd = "$java_exec -cp $classpath:$classpath/xalan.jar ApplyXSLT $target_language_code $gen_many_html_xsl_filepath $target_filepath | \"$perl_exec\" -S $split_script_filepath $target_file_directory";
654    my $response = `$cmd`;
655    &log_message($cmd);
656    &log_message($response);   
657    &log_message("Created HTML operational files");
658   
659    $cmd = "$java_exec -cp $classpath:$classpath/xalan.jar ApplyXSLT $target_language_code $gen_index_xml_xsl_filepath $target_filepath > " . $target_file_directory . "help_index.xml"; # 2>/dev/null";
660    $response = `$cmd`;
661    &log_message($cmd);
662    &log_message($response);   
663    &log_message("Created xml index file");
664
665    my $zip_file_path = "/greenstone/custom/gti/" . $target_language_code . "_GLIHelp.zip";
666    $cmd = "zip -rj $zip_file_path $target_file_directory -i \*.htm \*.xml";
667    $response = `$cmd`;
668    &log_message($cmd);
669    &log_message($response);   
670    &log_message("Created the zip file");
671}
672
673
674sub get_translation_configuration
675{
676    # Get the code of the target language
677    my $target_language_code = shift(@_);
678    # Get the key of the file to translate
679    my $translation_file_key = shift(@_);
680
681    # Read the translation data from the gti.cfg file
682    my ($source_file, $target_file, $translation_file_type) =
683    &get_translation_data_for($target_language_code, $translation_file_key);
684
685    # Check that the file to translate is defined in the gti.cfg file
686    if (!$source_file || !$target_file || !$translation_file_type) {
687    &throw_fatal_error("Missing or incomplete specification for translation file \"$translation_file_key\" in gti.pl.");
688    }
689
690    # Check that the source file exists
691    my $source_file_path = &util::filename_cat($gsdl_root_directory, $source_file);
692    if (!-e $source_file_path) {
693    &throw_fatal_error("Source file $source_file_path does not exist.");
694    }
695
696    # Check that the source file is up to date
697    # The "2>/dev/null" is very important! If it is missing this will never return when run from the receptionist
698    # unless ($translation_file_is_not_in_cvs) {
699    #my $source_file_cvs_status = `cd $gsdl_root_directory; cvs -d $anonymous_cvs_root update $source_file 2>/dev/null`;
700        my $source_file_cvs_status = `cd $gsdl_root_directory; svn status $source_file 2>/dev/null`;
701    if ($source_file_cvs_status =~ /^C /) {
702        &throw_fatal_error("Source file $source_file_path conflicts with the repository.");
703    }
704    if ($source_file_cvs_status =~ /^M /) {
705        &throw_fatal_error("Source file $source_file_path contains uncommitted changes.");
706    }
707    # }
708
709    return ($source_file, $target_file, $translation_file_type);
710}
711
712
713sub get_translation_data_for
714{
715    my ($target_language_code, $translation_file_key) = @_;
716
717    foreach my $translation_file (@$gti_translation_files) {
718    # If this isn't the correct translation file, move onto the next one
719    next if ($translation_file_key ne $translation_file->{'key'});
720
721    # Resolve the target language file
722    my $target_language_file = $translation_file->{'target_file'};
723    if ($target_language_file =~ /(\{.+\;.+\})/) {
724        my $unresolved_target_language_file_part = $1;
725
726        # Check for a special case for the target language code
727        if ($unresolved_target_language_file_part =~ /(\{|\;)$target_language_code:([^\;]+)(\;|\})/) {
728        my $resolved_target_language_file_part = $2;
729        $target_language_file =~ s/$unresolved_target_language_file_part/$resolved_target_language_file_part/;
730        }
731        # Otherwise use the last part as the default value
732        else {
733        my ($default_target_language_file_part) = $unresolved_target_language_file_part =~ /([^\;]+)\}/;
734        $target_language_file =~ s/$unresolved_target_language_file_part/\{$default_target_language_file_part\}/;           
735        }
736    }
737
738    # Resolve instances of {iso_639_1_target_language_name}
739    my $iso_639_1_target_language_name = $iso639::fromiso639{$target_language_code};
740    $iso_639_1_target_language_name =~ tr/A-Z/a-z/ if $iso_639_1_target_language_name;
741    $target_language_file =~ s/\{iso_639_1_target_language_name\}/$iso_639_1_target_language_name/g;
742
743    # Resolve instances of {target_language_code}
744    $target_language_file =~ s/\{target_language_code\}/$target_language_code/g;
745
746    return ($translation_file->{'source_file'}, $target_language_file, $translation_file->{'file_type'});
747    }
748
749    return ();
750}
751
752
753sub read_file_lines
754{
755    my ($file_path) = @_;
756
757    if (!open(FILE_IN, "<$file_path")) {
758    &log_message("Note: Could not open file $file_path.");
759    return ();
760    }
761    my @file_lines = <FILE_IN>;
762    close(FILE_IN);
763
764    return @file_lines;
765}
766
767
768sub build_key_to_line_mapping
769{
770    my ($file_lines, $translation_file_type) = @_;
771    eval "return &build_key_to_line_mapping_for_${translation_file_type}(\@\$file_lines)";
772}
773
774
775sub build_key_to_text_mapping
776{
777    my ($file_lines, $key_to_line_mapping, $translation_file_type) = @_;
778
779    my %key_to_text_mapping = ();
780    foreach my $chunk_key (keys(%$key_to_line_mapping)) {
781    my $chunk_starting_line = (split(/-/, $key_to_line_mapping->{$chunk_key}))[0];
782    my $chunk_finishing_line = (split(/-/, $key_to_line_mapping->{$chunk_key}))[1];
783
784    my $chunk_text = @$file_lines[$chunk_starting_line];
785    for (my $l = ($chunk_starting_line + 1); $l <= $chunk_finishing_line; $l++) {
786        $chunk_text .= @$file_lines[$l];
787    }
788
789    # Map from chunk key to text
790    eval "\$key_to_text_mapping{\${chunk_key}} = &import_chunk_from_${translation_file_type}(\$chunk_text)";
791    }
792
793    return %key_to_text_mapping;
794}
795
796
797sub build_key_to_last_update_date_mapping
798{
799    my ($file, $file_lines, $key_to_line_mapping, $translation_file_type) = @_;
800
801    # If the files aren't in CVS then we can't tell anything about what needs updating
802    # return () if ($translation_file_is_not_in_cvs);
803
804    # Build a mapping from key to CVS date
805    # Need to be careful with this mapping because the chunk keys won't necessarily all be valid
806    my %key_to_cvs_date_mapping = &build_key_to_cvs_date_mapping($file, $translation_file_type);
807
808    # Build a mapping from key to comment date
809    my %key_to_gti_comment_mapping = &build_key_to_gti_comment_mapping($file_lines, $key_to_line_mapping, $translation_file_type);
810
811    # Build a mapping from key to last update date (the latter of the CVS date and comment date)
812    my %key_to_last_update_date_mapping = ();
813    foreach my $chunk_key (keys(%$key_to_line_mapping)) {
814    # Use the CVS date as a starting point
815    my $chunk_cvs_date = $key_to_cvs_date_mapping{$chunk_key};
816    $key_to_last_update_date_mapping{$chunk_key} = $chunk_cvs_date;
817
818    # If a comment date exists and it is after the CVS date, use that instead
819        # need to convert the comment date format to SVN format
820    my $chunk_gti_comment = $key_to_gti_comment_mapping{$chunk_key};
821    if (defined($chunk_gti_comment) && $chunk_gti_comment =~ /(\d?\d-\D\D\D-\d\d\d\d)/) {
822        my $chunk_comment_date = $1;           
823        # if the changes were made on 2009 Jan 27, ie. tidying up the GTI commands following each fragment,
824        # then should use the GTI comment date instead
825        # if ((!defined($chunk_cvs_date) || &is_date_after($chunk_comment_date, $chunk_cvs_date))) {
826        if ((!defined($chunk_cvs_date) || &is_date_after($chunk_comment_date, $chunk_cvs_date)
827         || (&is_date_after($chunk_cvs_date,$chunk_comment_date) && ($chunk_cvs_date eq "2009-01-27" || $chunk_cvs_date eq "2009-01-28")))) {
828        $key_to_last_update_date_mapping{$chunk_key} = $chunk_comment_date;
829       
830        # &log_message("cvs date: $chunk_cvs_date, comment date: $chunk_comment_date");
831        # die;
832        }
833    }
834    }
835
836    return %key_to_last_update_date_mapping;
837}
838
839
840sub build_key_to_cvs_date_mapping
841{
842    my ($filename, $translation_file_type) = @_;
843
844    # Use CVS to annotate each line of the file with the date it was last edited
845    # The "2>/dev/null" is very important! If it is missing this will never return when run from the receptionist
846    # my $cvs_annotated_file = `cd $gsdl_root_directory; cvs -d $anonymous_cvs_root annotate -F $filename 2>/dev/null`;   
847    # my $cvs_annotated_file = `cd $gsdl_root_directory; export PATH=.:/research/lh92/programs/subversion/bin; svn annotate -v --force $filename`;
848    my $cvs_annotated_file = `cd $gsdl_root_directory; svn annotate -v $filename`;
849   
850    my @cvs_annotated_file_lines = split(/\n/, $cvs_annotated_file);
851
852    my @cvs_annotated_file_lines_date = ();
853    foreach my $cvs_annotated_file_line (@cvs_annotated_file_lines) {
854    # Extract the date from the CVS annotation at the front
855        # cvs format : 07-Jun-02
856        # svn format : 2007-07-16
857    # $cvs_annotated_file_line =~ s/^\S+\s+\(\S+\s+(\S+)\):\s//;
858        $cvs_annotated_file_line =~ s/^\s+\S+\s+\S+\s(\S+)//;
859       
860        push(@cvs_annotated_file_lines_date, $1);
861       
862        # trim extra date information in svn annotation format
863        # 15:42:49 +1200 (Wed, 21 Jun 2006)
864        $cvs_annotated_file_line =~ s/^\s+\S+\s\S+\s\((.+?)\)\s//;
865    }   
866   
867    # Build a key to line mapping for the CVS annotated file, for matching the chunk key to the CVS date
868    my %key_to_line_mapping = &build_key_to_line_mapping(\@cvs_annotated_file_lines, $translation_file_type);
869       
870    my %key_to_cvs_date_mapping = ();
871    foreach my $chunk_key (keys(%key_to_line_mapping)) {
872    my $chunk_starting_line = (split(/-/, $key_to_line_mapping{$chunk_key}))[0];
873    my $chunk_finishing_line = (split(/-/, $key_to_line_mapping{$chunk_key}))[1];
874               
875    # Find the date this chunk was last edited, from the CVS annotation
876    my $chunk_date = $cvs_annotated_file_lines_date[$chunk_starting_line];       
877    for (my $l = ($chunk_starting_line + 1); $l <= $chunk_finishing_line; $l++) {
878        if (&is_date_after($cvs_annotated_file_lines_date[$l], $chunk_date)) {
879        # This part of the chunk has been updated more recently
880        $chunk_date = $cvs_annotated_file_lines_date[$l];
881       
882        }
883    }
884
885    # Map from chunk key to CVS date
886    $key_to_cvs_date_mapping{$chunk_key} = $chunk_date;
887    }
888
889    return %key_to_cvs_date_mapping;
890}
891
892
893sub build_key_to_gti_comment_mapping
894{
895    my ($file_lines, $key_to_line_mapping, $translation_file_type) = @_;
896
897    my %key_to_gti_comment_mapping = ();
898    foreach my $chunk_key (keys(%$key_to_line_mapping)) {
899    my $chunk_starting_line = (split(/-/, $key_to_line_mapping->{$chunk_key}))[0];
900    my $chunk_finishing_line = (split(/-/, $key_to_line_mapping->{$chunk_key}))[1];
901
902    my $chunk_text = @$file_lines[$chunk_starting_line];
903    for (my $l = ($chunk_starting_line + 1); $l <= $chunk_finishing_line; $l++) {
904        $chunk_text .= @$file_lines[$l];
905    }
906
907    # Map from chunk key to GTI comment
908    my $chunk_gti_comment;
909    eval "\$chunk_gti_comment = &get_${translation_file_type}_chunk_gti_comment(\$chunk_text)";
910    $key_to_gti_comment_mapping{$chunk_key} = $chunk_gti_comment if (defined($chunk_gti_comment));
911    }
912
913    return %key_to_gti_comment_mapping;
914}
915
916
917sub determine_chunks_requiring_translation
918{
919    my $source_file_key_to_text_mapping = shift(@_);
920    my $target_file_key_to_text_mapping = shift(@_);
921
922    # Chunks needing translation are those in the source file with no translation in the target file
923    my @target_file_keys_requiring_translation = ();
924    foreach my $chunk_key (keys(%$source_file_key_to_text_mapping)) {
925    if ($source_file_key_to_text_mapping->{$chunk_key} && !$target_file_key_to_text_mapping->{$chunk_key}) {
926        # &log_message("Chunk with key $chunk_key needs translating.");
927        push(@target_file_keys_requiring_translation, $chunk_key);
928    }
929    }
930
931    return @target_file_keys_requiring_translation;
932}
933
934
935sub determine_chunks_requiring_updating
936{
937    my $source_file_key_to_last_update_date_mapping = shift(@_);
938    my $target_file_key_to_last_update_date_mapping = shift(@_);
939
940    # Chunks needing updating are those in the target file that have been more recently edited in the source file
941    my @target_file_keys_requiring_updating = ();
942    foreach my $chunk_key (keys(%$source_file_key_to_last_update_date_mapping)) {
943    my $source_chunk_last_update_date = $source_file_key_to_last_update_date_mapping->{$chunk_key};
944    my $target_chunk_last_update_date = $target_file_key_to_last_update_date_mapping->{$chunk_key};
945       
946        # print "key: $chunk_key\nsource date : $source_chunk_last_update_date\ntarget date : $target_chunk_last_update_date\nafter? ". &is_date_after($source_chunk_last_update_date, $target_chunk_last_update_date) . "\n\n";       
947                   
948        if (defined($target_chunk_last_update_date) && &is_date_after($source_chunk_last_update_date, $target_chunk_last_update_date)) {
949        # &log_message("Chunk with key $chunk_key needs updating.");
950        push(@target_file_keys_requiring_updating, $chunk_key);
951    }
952    }
953
954    return @target_file_keys_requiring_updating;
955}
956
957
958sub is_chunk_automatically_translated
959{
960    my ($chunk_key, $translation_file_type) = @_;
961    eval "return &is_${translation_file_type}_chunk_automatically_translated(\$chunk_key)";
962}
963
964
965sub make_text_xml_safe
966{
967    my $text = shift(@_);
968    $text =~ s/\&/\&amp\;/g;
969    $text =~ s/\&amp\;lt\;/\&amp\;amp\;lt\;/g;
970    $text =~ s/\&amp\;gt\;/\&amp\;amp\;gt\;/g;
971    $text =~ s/\&amp\;rarr\;/\&amp\;amp\;rarr\;/g;
972    $text =~ s/\&amp\;mdash\;/\&amp\;amp\;mdash\;/g;
973    $text =~ s/</\&lt\;/g;
974    $text =~ s/>/\&gt\;/g;
975    return $text;
976}
977
978
979sub unmake_text_xml_safe
980{
981    my $text = shift(@_);
982    $text =~ s/\&lt\;/</g;
983    $text =~ s/\&gt\;/>/g;
984    $text =~ s/\&amp\;/\&/g;
985    return $text;
986}
987
988
989# Returns 1 if $date1 is after $date2, 0 otherwise
990sub is_date_after_cvs
991{
992    my ($date1, $date2) = @_;
993    my %months = ("Jan", 1, "Feb", 2, "Mar", 3, "Apr",  4, "May",  5, "Jun",  6,
994          "Jul", 7, "Aug", 8, "Sep", 9, "Oct", 10, "Nov", 11, "Dec", 12);
995
996    if(!defined $date1) {
997        return 1;
998    }
999
1000    my @date1parts = split(/-/, $date1);
1001    my @date2parts = split(/-/, $date2);
1002
1003    # Compare year - nasty because we have rolled over into a new century
1004    my $year1 = $date1parts[2];
1005    if ($year1 < 80) {
1006        $year1 += 2000;
1007    }
1008    my $year2 = $date2parts[2];
1009    if ($year2 < 80) {
1010        $year2 += 2000;
1011    }
1012
1013    # Compare year
1014    if ($year1 > $year2) {
1015    return 1;
1016    }
1017    elsif ($year1 == $year2) {
1018    # Year is the same, so compare month
1019    if ($months{$date1parts[1]} > $months{$date2parts[1]}) {
1020        return 1;
1021    }
1022    elsif ($months{$date1parts[1]} == $months{$date2parts[1]}) {
1023        # Month is the same, so compare day
1024        if ($date1parts[0] > $date2parts[0]) {
1025        return 1;
1026        }
1027    }
1028    }
1029
1030    return 0;
1031}
1032
1033sub is_date_after
1034{
1035    my ($date1, $date2) = @_;
1036   
1037    if(!defined $date1) {
1038      return 1;
1039    }
1040    if(!defined $date2) {
1041      return 0;
1042    }
1043   
1044    # 16-Aug-2006
1045    if($date1=~ /(\d+?)-(\S\S\S)-(\d\d\d\d)/){
1046       my %months = ("Jan", "01", "Feb", "02", "Mar", "03", "Apr",  "04", "May",  "05", "Jun",  "06",
1047          "Jul", "07", "Aug", "08", "Sep", "09", "Oct", "10", "Nov", "11", "Dec", "12");
1048       $date1=$3 . "-" . $months{$2} . "-" . $1;
1049       # print "** converted date1: $date1\n";
1050    }
1051    if($date2=~ /(\d+?)-(\S\S\S)-(\d\d\d\d)/){
1052       my %months = ("Jan", "01", "Feb", "02", "Mar", "03", "Apr",  "04", "May",  "05", "Jun",  "06",
1053          "Jul", "07", "Aug", "08", "Sep", "09", "Oct", "10", "Nov", "11", "Dec", "12");
1054       $date2=$3 . "-" . $months{$2} . "-" . $1;
1055       # print "** converted date2: $date2\n";
1056    }
1057   
1058   
1059    # 2006-08-16
1060    my @date1parts = split(/-/, $date1);
1061    my @date2parts = split(/-/, $date2);
1062   
1063    # Compare year
1064    if ($date1parts[0] > $date2parts[0]) {
1065    return 1;
1066    }
1067    elsif ($date1parts[0] == $date2parts[0]) {
1068    # Year is the same, so compare month
1069    if ($date1parts[1] > $date2parts[1]) {
1070        return 1;
1071    }
1072    elsif ($date1parts[1] == $date2parts[1]) {
1073        # Month is the same, so compare day
1074        if ($date1parts[2] > $date2parts[2]) {
1075        return 1;
1076        }
1077    }
1078    }   
1079   
1080    return 0;
1081}
1082
1083
1084sub create_xml_response_for_chunks_requiring_work
1085{
1086    my ($translation_file_key, $target_file, $total_num_chunks, $target_files_keys_requiring_translation, $target_files_keys_requiring_updating, $num_chunks_to_return, $source_files_key_to_text_mapping, $target_files_key_to_text_mapping, $source_files_key_to_last_update_date_mapping, $target_files_key_to_last_update_date_mapping) = @_;
1087
1088    # Form an XML response to the command
1089    my $xml_response = "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>\n";
1090    $xml_response .= "<GTIResponse>\n";
1091    $xml_response .= "  <TranslationFile"
1092    . " key=\"" . $translation_file_key . "\""
1093    . " target_file_path=\"" . $target_file . "\""
1094    . " num_chunks_translated=\"" . ($total_num_chunks - scalar(@$target_files_keys_requiring_translation)) . "\""
1095    . " num_chunks_requiring_translation=\"" . scalar(@$target_files_keys_requiring_translation) . "\""
1096    . " num_chunks_requiring_updating=\"" . scalar(@$target_files_keys_requiring_updating) . "\"\/>\n";
1097
1098    # Do chunks requiring translation first
1099    if ($num_chunks_to_return > scalar(@$target_files_keys_requiring_translation)) {
1100    $xml_response .= "  <ChunksRequiringTranslation size=\"" . scalar(@$target_files_keys_requiring_translation) . "\">\n";
1101    }
1102    else {
1103    $xml_response .= "  <ChunksRequiringTranslation size=\"" . $num_chunks_to_return . "\">\n";
1104    }
1105
1106    my @sorted_chunk_keys = sort (@$target_files_keys_requiring_translation);
1107    foreach my $chunk_key (@sorted_chunk_keys) {
1108    last if ($num_chunks_to_return == 0);
1109
1110    my $source_file_chunk_date = $source_files_key_to_last_update_date_mapping->{$chunk_key} || "";
1111    my $source_file_chunk_text = &make_text_xml_safe($source_files_key_to_text_mapping->{$chunk_key}); 
1112   
1113    $xml_response .= "    <Chunk key=\"" . &make_text_xml_safe($chunk_key) . "\">\n";
1114    $xml_response .= "      <SourceFileText date=\"$source_file_chunk_date\">$source_file_chunk_text</SourceFileText>\n";   
1115    $xml_response .= "      <TargetFileText></TargetFileText>\n";
1116    $xml_response .= "    </Chunk>\n";
1117
1118    $num_chunks_to_return--;
1119    }
1120
1121    $xml_response .= "  </ChunksRequiringTranslation>\n";
1122
1123    # Then do chunks requiring updating
1124    if ($num_chunks_to_return > scalar(@$target_files_keys_requiring_updating)) {
1125    $xml_response .= "  <ChunksRequiringUpdating size=\"" . scalar(@$target_files_keys_requiring_updating) . "\">\n";
1126    }
1127    else {
1128    $xml_response .= "  <ChunksRequiringUpdating size=\"" . $num_chunks_to_return . "\">\n";
1129    }
1130       
1131    # foreach my $chunk_key (@target_file_keys_requiring_updating) {
1132    @sorted_chunk_keys = sort (@$target_files_keys_requiring_updating);
1133    foreach my $chunk_key (@sorted_chunk_keys) {
1134    last if ($num_chunks_to_return == 0);
1135
1136    my $source_file_chunk_date = $source_files_key_to_last_update_date_mapping->{$chunk_key} || "";
1137    my $source_file_chunk_text = &make_text_xml_safe($source_files_key_to_text_mapping->{$chunk_key});
1138    my $target_file_chunk_date = $target_files_key_to_last_update_date_mapping->{$chunk_key} || "";
1139    my $target_file_chunk_text = &make_text_xml_safe($target_files_key_to_text_mapping->{$chunk_key});
1140
1141    $xml_response .= "    <Chunk key=\"" . &make_text_xml_safe($chunk_key) . "\">\n";   
1142    $xml_response .= "      <SourceFileText date=\"$source_file_chunk_date\">$source_file_chunk_text</SourceFileText>\n";
1143    $xml_response .= "      <TargetFileText date=\"$target_file_chunk_date\">$target_file_chunk_text</TargetFileText>\n";
1144    $xml_response .= "    </Chunk>\n";
1145
1146    $num_chunks_to_return--;
1147    }
1148
1149    $xml_response .= "  </ChunksRequiringUpdating>\n";
1150
1151    $xml_response .= "</GTIResponse>\n";
1152
1153    return $xml_response;
1154}
1155
1156
1157sub create_xml_response_for_all_chunks
1158{
1159    my ($translation_file_key, $target_file, $source_file_key_to_text_mapping, $target_file_key_to_text_mapping, $source_file_key_to_last_update_date_mapping, $target_file_key_to_last_update_date_mapping) = @_;
1160
1161    # Form an XML response to the command
1162    my $xml_response = "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>\n";
1163    $xml_response .= "<GTIResponse>\n";
1164    $xml_response .= "  <TranslationFile"
1165    . " key=\"" . $translation_file_key . "\""
1166    . " target_file_path=\"" . $target_file . "\"\/>\n";
1167   
1168    # Do all the chunks
1169    $xml_response .= "  <Chunks size=\"" . scalar(keys(%$source_file_key_to_text_mapping)) . "\">\n";
1170
1171    my @sorted_chunk_keys = sort (keys(%$source_file_key_to_text_mapping));
1172    foreach my $chunk_key (@sorted_chunk_keys) {
1173    my $source_file_chunk_date = $source_file_key_to_last_update_date_mapping->{$chunk_key} || "";
1174    my $source_file_chunk_text = &make_text_xml_safe($source_file_key_to_text_mapping->{$chunk_key});
1175
1176    $xml_response .= "    <Chunk key=\"" . &make_text_xml_safe($chunk_key) . "\">\n";
1177    $xml_response .= "      <SourceFileText date=\"$source_file_chunk_date\">$source_file_chunk_text</SourceFileText>\n";
1178    if (defined($target_file_key_to_text_mapping->{$chunk_key})) {
1179        my $target_file_chunk_date = $target_file_key_to_last_update_date_mapping->{$chunk_key} || "";
1180        my $target_file_chunk_text = &make_text_xml_safe($target_file_key_to_text_mapping->{$chunk_key});
1181        $xml_response .= "      <TargetFileText date=\"$target_file_chunk_date\">$target_file_chunk_text</TargetFileText>\n";
1182    }
1183    else {
1184        $xml_response .= "      <TargetFileText></TargetFileText>\n";
1185    }
1186
1187    $xml_response .= "    </Chunk>\n";
1188    }
1189    $xml_response .= "  </Chunks>\n";
1190   
1191    $xml_response .= "</GTIResponse>\n";
1192    return $xml_response;
1193}
1194
1195
1196
1197# ==========================================================================================
1198#   MACROFILE FUNCTIONS
1199
1200sub build_key_to_line_mapping_for_macrofile
1201{
1202    my (@file_lines) = @_;
1203
1204    my $macro_package;
1205    my %chunk_key_to_line_mapping = ();
1206    # Process the contents of the file, line by line
1207    for (my $i = 0; $i < scalar(@file_lines); $i++) {
1208    my $line = $file_lines[$i];
1209    $line =~ s/(\s*)$//;  # Remove any nasty whitespace, carriage returns etc.
1210
1211    # Check if a new package is being defined
1212    if ($line =~ m/^package\s+(.+)/) {
1213        $macro_package = $1;
1214    }
1215
1216    # Line contains a macro name
1217    elsif ($line =~ m/^(_\w+_)/) {
1218        my $macro_key = $1;
1219        $line =~ s/\s*([^\\]\#[^\}]+)?$//;  # Remove any comments and nasty whitespace
1220
1221        # While there is still text of the macro to go...
1222        my $startline = $i;
1223        while ($line !~ /\}$/) {
1224        $i++;
1225        if ($i == scalar(@file_lines)) {
1226            &throw_fatal_error("Could not find end of macro $macro_key.");
1227        }
1228        $line = $file_lines[$i];
1229        $line =~ s/\s*([^\\]\#[^\}]+)?$//;  # Remove any comments and nasty whitespace
1230        }
1231
1232        # The chunk key consists of the package name and the macro key
1233        my $chunk_key = $macro_package . "." . $macro_key;
1234        # Map from chunk key to line
1235        $chunk_key_to_line_mapping{$chunk_key} = $startline . "-" . $i;
1236    }
1237
1238    # Icon: line in format ## "image text" ## image_type ## macro_name ##
1239    elsif ($line =~ m/^\#\# .* \#\# .* \#\# (.*) \#\#/) {
1240        # The chunk key consists of package name and macro key
1241        my $chunk_key = $macro_package . "." . $1;
1242        # Map from chunk key to line
1243        $chunk_key_to_line_mapping{$chunk_key} = $i . "-" . $i;
1244    }
1245    }
1246
1247    return %chunk_key_to_line_mapping;
1248}
1249
1250
1251sub import_chunk_from_macrofile
1252{
1253    my ($chunk_text) = @_;
1254
1255    # Is this an icon macro??
1256    if ($chunk_text =~ /^\#\# (.*)/) {
1257    # Extract image macro text
1258    $chunk_text =~ /^\#\#\s+([^\#]+)\s+\#\#/;
1259    $chunk_text = $1;
1260
1261    # Remove enclosing quotes
1262    $chunk_text =~ s/^\"//;
1263    $chunk_text =~ s/\"$//;
1264    }
1265
1266    # No, so it must be a text macro
1267    else {
1268    # Remove macro key
1269    $chunk_text =~ s/^_([^_]+)_(\s*)//;
1270
1271    # Remove language specifier
1272    $chunk_text =~ s/^\[l=.*\](\s*)//;
1273
1274    # Remove braces enclosing text
1275    $chunk_text =~ s/^{(\s*)((.|\n)*)}(\s*)(\#.+\s*)?/$2/;
1276    }
1277
1278    return $chunk_text;
1279}
1280
1281
1282sub get_macrofile_chunk_gti_comment
1283{
1284    my ($chunk_text) = @_;
1285
1286    # Check for an "Updated DD-MMM-YYYY" comment at the end of the chunk
1287    if ($chunk_text =~ /\#\s+(Updated\s+\d?\d-\D\D\D-\d\d\d\d.*)\s*$/i) {
1288    return $1;
1289    }
1290
1291    return undef;
1292}
1293
1294
1295sub is_macrofile_chunk_automatically_translated
1296{
1297    my ($chunk_key) = @_;
1298
1299    # The _httpiconX_, _widthX_ and _heightX_ image macros are automatically translated
1300    if ($chunk_key =~ /\._(httpicon|width|height)/) {
1301    return 1;
1302    }
1303
1304    return 0;
1305}
1306
1307
1308# Use the source file to generate a target file that is formatted the same
1309sub write_translated_macrofile
1310{
1311    my $source_file = shift(@_);  # Not used
1312    my @source_file_lines = @{shift(@_)};
1313    my $source_file_key_to_text_mapping = shift(@_);
1314    my $target_file = shift(@_);
1315    my @target_file_lines = @{shift(@_)};
1316    my $target_file_key_to_text_mapping = shift(@_);
1317    my $target_file_key_to_gti_comment_mapping = shift(@_);
1318    my $target_language_code = shift(@_);
1319
1320    # Build a mapping from source file line to chunk key
1321    my %source_file_key_to_line_mapping = &build_key_to_line_mapping_for_macrofile(@source_file_lines);
1322    my %source_file_line_to_key_mapping = ();
1323    foreach my $chunk_key (keys(%source_file_key_to_line_mapping)) {
1324    $source_file_line_to_key_mapping{$source_file_key_to_line_mapping{$chunk_key}} = $chunk_key;
1325    }
1326    my @source_file_line_keys = (sort sort_by_line (keys(%source_file_line_to_key_mapping)));
1327    my $source_file_line_number = 0;
1328
1329    # Build a mapping from target file line to chunk key
1330    my %target_file_key_to_line_mapping = &build_key_to_line_mapping_for_macrofile(@target_file_lines);
1331    my %target_file_line_to_key_mapping = ();
1332    foreach my $chunk_key (keys(%target_file_key_to_line_mapping)) {
1333    $target_file_line_to_key_mapping{$target_file_key_to_line_mapping{$chunk_key}} = $chunk_key;
1334    }
1335    my @target_file_line_keys = (sort sort_by_line (keys(%target_file_line_to_key_mapping)));
1336
1337    # Write the new target file
1338    my $target_file_path = &util::filename_cat($gsdl_root_directory, $target_file);
1339    if (!open(TARGET_FILE, ">$target_file_path")) {
1340    &throw_fatal_error("Could not write target file $target_file_path.");
1341    }
1342
1343    # Use the header from the target file, to keep language and author information
1344    if (scalar(@target_file_line_keys) > 0) {
1345    my $target_file_line_number = 0;
1346    my $target_file_chunk_starting_line_number = (split(/-/, $target_file_line_keys[0]))[0];
1347    while ($target_file_line_number < $target_file_chunk_starting_line_number) {
1348        my $target_file_line = $target_file_lines[$target_file_line_number];
1349        last if ($target_file_line =~ /^\# -- Missing translation: /);  # We don't want to get into the macros
1350        print TARGET_FILE $target_file_line;
1351        $target_file_line_number++;
1352    }
1353
1354    $source_file_line_number = (split(/-/, $source_file_line_keys[0]))[0];
1355    }
1356
1357    # Model the new target file on the source file, with the target file translations
1358    foreach my $line_key (@source_file_line_keys) {
1359    # Fill in the gaps before this chunk starts
1360    my $source_file_chunk_starting_line_number = (split(/-/, $line_key))[0];
1361    my $source_file_chunk_finishing_line_number = (split(/-/, $line_key))[1];
1362    while ($source_file_line_number < $source_file_chunk_starting_line_number) {
1363        print TARGET_FILE $source_file_lines[$source_file_line_number];
1364        $source_file_line_number++;
1365    }
1366    $source_file_line_number = $source_file_chunk_finishing_line_number + 1;
1367
1368    my $chunk_key = $source_file_line_to_key_mapping{$line_key};
1369    my $source_file_chunk_text = $source_file_key_to_text_mapping->{$chunk_key};
1370    my $target_file_chunk_text = $target_file_key_to_text_mapping->{$chunk_key} || "";
1371
1372    my $macrofile_key = $chunk_key;
1373    $macrofile_key =~ s/^(.+?)\.//;
1374
1375    # If no translation exists for this chunk, show this, and move on
1376    if ($source_file_chunk_text ne "" && $target_file_chunk_text eq "") {
1377        print TARGET_FILE "# -- Missing translation: $macrofile_key\n";
1378        next;
1379    }
1380
1381    # Grab the source chunk text
1382    my $source_file_chunk = $source_file_lines[$source_file_chunk_starting_line_number];
1383    for (my $l = ($source_file_chunk_starting_line_number + 1); $l <= $source_file_chunk_finishing_line_number; $l++) {
1384        $source_file_chunk .= $source_file_lines[$l];
1385    }
1386
1387    # Is this an icon macro??
1388    if ($source_file_chunk =~ /^\#\# (.*)/) {
1389        # Escape any newline and question mark characters so the source text is replaced correctly
1390        $source_file_chunk_text =~ s/\\/\\\\/g;
1391        $source_file_chunk_text =~ s/\?/\\\?/g;
1392
1393        # Build the new target chunk from the source chunk
1394        my $target_file_chunk = $source_file_chunk;
1395        $target_file_chunk =~ s/$source_file_chunk_text/$target_file_chunk_text/;
1396        $target_file_chunk =~ s/(\s)*$//;
1397        print TARGET_FILE "$target_file_chunk";
1398    }
1399
1400    # No, it is just a normal text macro
1401    else {
1402        print TARGET_FILE "$macrofile_key [l=$target_language_code] {$target_file_chunk_text}";
1403    }
1404
1405    # Add the "updated" comment, if one exists
1406    if ($target_file_key_to_gti_comment_mapping->{$chunk_key}) {
1407        print TARGET_FILE "  # " . $target_file_key_to_gti_comment_mapping->{$chunk_key};
1408    }
1409    print TARGET_FILE "\n";
1410    }
1411
1412    close(TARGET_FILE);
1413}
1414
1415
1416sub sort_by_line
1417{
1418    return ((split(/-/, $a))[0] <=> (split(/-/, $b))[0]);
1419}
1420
1421
1422# ==========================================================================================
1423#   RESOURCE BUNDLE FUNCTIONS
1424
1425sub build_key_to_line_mapping_for_resource_bundle
1426{
1427    my (@file_lines) = @_;
1428
1429    my %chunk_key_to_line_mapping = ();
1430    for (my $i = 0; $i < scalar(@file_lines); $i++) {
1431    my $line = $file_lines[$i];
1432    $line =~ s/(\s*)$//;  # Remove any nasty whitespace, carriage returns etc.
1433
1434    # Line contains a dictionary string
1435    if ($line =~ /^(\S+?)[:|=](.*)$/) {
1436        my $chunk_key = $1;
1437
1438        # Map from chunk key to line
1439        $chunk_key_to_line_mapping{$chunk_key} = $i . "-" . $i;
1440    }
1441    }
1442
1443    return %chunk_key_to_line_mapping;
1444}
1445
1446
1447sub import_chunk_from_resource_bundle
1448{
1449    my ($chunk_text) = @_;
1450
1451    # Simple: just remove string key
1452    $chunk_text =~ s/^(\S+?)[:|=](\s*)//;
1453    $chunk_text =~ s/(\s*)$//;  # Remove any nasty whitespace, carriage returns etc.
1454    $chunk_text =~ s/(\s*)\#\s+Updated\s+(\d?\d-\D\D\D-\d\d\d\d.*)\s*$//i;
1455
1456    return $chunk_text;
1457}
1458
1459
1460sub get_resource_bundle_chunk_gti_comment
1461{
1462    my ($chunk_text) = @_;
1463
1464    # Check for an "Updated DD-MMM-YYYY" comment at the end of the chunk
1465    if ($chunk_text =~ /\#\s+(Updated\s+\d?\d-\D\D\D-\d\d\d\d.*)\s*$/i) {
1466    return $1;
1467    }
1468
1469    return undef;
1470}
1471
1472
1473sub is_resource_bundle_chunk_automatically_translated
1474{
1475    # No resource bundle chunks are automatically translated
1476    return 0;
1477}
1478
1479
1480sub write_translated_resource_bundle
1481{
1482    my $source_file = shift(@_);  # Not used
1483    my @source_file_lines = @{shift(@_)};
1484    my $source_file_key_to_text_mapping = shift(@_);
1485    my $target_file = shift(@_);
1486    my @target_file_lines = @{shift(@_)};  # Not used
1487    my $target_file_key_to_text_mapping = shift(@_);
1488    my $target_file_key_to_gti_comment_mapping = shift(@_);
1489    my $target_language_code = shift(@_);  # Not used
1490
1491    # Build a mapping from chunk key to source file line, and from source file line to chunk key
1492    my %source_file_key_to_line_mapping = &build_key_to_line_mapping_for_resource_bundle(@source_file_lines);
1493    my %source_file_line_to_key_mapping = ();
1494    foreach my $chunk_key (keys(%source_file_key_to_line_mapping)) {
1495    $source_file_line_to_key_mapping{$source_file_key_to_line_mapping{$chunk_key}} = $chunk_key;
1496    }
1497
1498    # Write the new target file
1499    my $target_file_path = &util::filename_cat($gsdl_root_directory, $target_file);
1500    if (!open(TARGET_FILE, ">$target_file_path")) {
1501    &throw_fatal_error("Could not write target file $target_file_path.");
1502    }
1503
1504    # Model the new target file on the source file, with the target file translations
1505    my $source_file_line_number = 0;
1506    foreach my $line_key (sort sort_by_line (keys(%source_file_line_to_key_mapping))) {
1507    # Fill in the gaps before this chunk starts
1508    my $source_file_chunk_starting_line_number = (split(/-/, $line_key))[0];
1509    my $source_file_chunk_finishing_line_number = (split(/-/, $line_key))[1];
1510    while ($source_file_line_number < $source_file_chunk_starting_line_number) {
1511        print TARGET_FILE $source_file_lines[$source_file_line_number];
1512        $source_file_line_number++;
1513    }
1514    $source_file_line_number = $source_file_chunk_finishing_line_number + 1;
1515
1516    my $chunk_key = $source_file_line_to_key_mapping{$line_key};
1517    my $source_file_chunk_text = $source_file_key_to_text_mapping->{$chunk_key};
1518    my $target_file_chunk_text = $target_file_key_to_text_mapping->{$chunk_key} || "";
1519
1520    # If no translation exists for this chunk, show this, and move on
1521    if ($source_file_chunk_text ne "" && $target_file_chunk_text eq "") {
1522        print TARGET_FILE "# -- Missing translation: $chunk_key\n";
1523        next;
1524    }
1525
1526    print TARGET_FILE "$chunk_key:$target_file_chunk_text";
1527    if ($target_file_key_to_gti_comment_mapping->{$chunk_key}) {
1528        print TARGET_FILE "  # " . $target_file_key_to_gti_comment_mapping->{$chunk_key};
1529    }
1530    print TARGET_FILE "\n";
1531    }
1532
1533    close(TARGET_FILE);
1534}
1535
1536
1537# ==========================================================================================
1538#   GREENSTONE XML FUNCTIONS
1539
1540sub build_key_to_line_mapping_for_greenstone_xml
1541{
1542    my (@file_lines) = @_;
1543
1544    my %chunk_key_to_line_mapping = ();
1545    for (my $i = 0; $i < scalar(@file_lines); $i++) {
1546    my $line = $file_lines[$i];
1547    $line =~ s/(\s*)$//;  # Remove any nasty whitespace, carriage returns etc.
1548
1549    # Line contains a string to translate
1550    if ($line =~ /^\s*<Text id=\"(.*?)\">/) {
1551        my $chunk_key = $1;
1552        $line =~ s/\s*$//;  # Remove any nasty whitespace
1553        $line =~ s/<Updated date=\"\d?\d-\D\D\D-\d\d\d\d.*\"\/>$//;
1554
1555        # While there is still text of the string to go...
1556        my $startline = $i;
1557        while ($line !~ /<\/Text>$/) {
1558        $i++;
1559        if ($i == scalar(@file_lines)) {
1560            &throw_fatal_error("Could not find end of string $chunk_key.");
1561        }
1562        $line = $file_lines[$i];
1563        $line =~ s/\s*$//;  # Remove any nasty whitespace
1564        $line =~ s/<Updated date=\"\d?\d-\D\D\D-\d\d\d\d.*\"\/>$//;
1565        }
1566
1567        # Map from chunk key to line
1568        if (!defined($chunk_key_to_line_mapping{$chunk_key})) {
1569        $chunk_key_to_line_mapping{$chunk_key} = $startline . "-" . $i;
1570        }
1571        else {
1572        &throw_fatal_error("Duplicate key $chunk_key.");
1573        }
1574    }
1575    }
1576
1577    return %chunk_key_to_line_mapping;
1578}
1579
1580
1581sub import_chunk_from_greenstone_xml
1582{
1583    my ($chunk_text) = @_;
1584
1585    # Simple: just remove the Text tags
1586    $chunk_text =~ s/^\s*<Text id=\"(.*?)\">(\s*)//;
1587    $chunk_text =~ s/<Updated date=\"\d?\d-\D\D\D-\d\d\d\d.*\"\/>$//;
1588    $chunk_text =~ s/<\/Text>$//;
1589
1590    return $chunk_text;
1591}
1592
1593
1594sub get_greenstone_xml_chunk_gti_comment
1595{
1596    my ($chunk_text) = @_;
1597
1598    # Check for an "Updated DD-MMM-YYYY" comment at the end of the chunk
1599    if ($chunk_text =~ /<Updated date=\"(\d?\d-\D\D\D-\d\d\d\d.*)\"\/>$/i) {
1600    return $1;
1601    }
1602
1603    return undef;
1604}
1605
1606
1607sub is_greenstone_xml_chunk_automatically_translated
1608{
1609    # No greenstone XML chunks are automatically translated
1610    return 0;
1611}
1612
1613
1614sub write_translated_greenstone_xml
1615{
1616    my $source_file = shift(@_);  # Not used
1617    my @source_file_lines = @{shift(@_)};
1618    my $source_file_key_to_text_mapping = shift(@_);
1619    my $target_file = shift(@_);
1620    my @target_file_lines = @{shift(@_)};  # Not used
1621    my $target_file_key_to_text_mapping = shift(@_);
1622    my $target_file_key_to_gti_comment_mapping = shift(@_);
1623    my $target_language_code = shift(@_);  # Not used
1624
1625    # Build a mapping from chunk key to source file line, and from source file line to chunk key
1626    my %source_file_key_to_line_mapping = &build_key_to_line_mapping_for_greenstone_xml(@source_file_lines);
1627    my %source_file_line_to_key_mapping = ();
1628    foreach my $chunk_key (keys(%source_file_key_to_line_mapping)) {
1629    $source_file_line_to_key_mapping{$source_file_key_to_line_mapping{$chunk_key}} = $chunk_key;
1630    }
1631
1632    # Write the new target file
1633    my $target_file_path = &util::filename_cat($gsdl_root_directory, $target_file);
1634    if (!open(TARGET_FILE, ">$target_file_path")) {
1635    &throw_fatal_error("Could not write target file $target_file_path.");
1636    }
1637
1638    # Model the new target file on the source file, with the target file translations
1639    my $source_file_line_number = 0;
1640    foreach my $line_key (sort sort_by_line (keys(%source_file_line_to_key_mapping))) {
1641    # Fill in the gaps before this chunk starts
1642    my $source_file_chunk_starting_line_number = (split(/-/, $line_key))[0];
1643    my $source_file_chunk_finishing_line_number = (split(/-/, $line_key))[1];
1644    while ($source_file_line_number < $source_file_chunk_starting_line_number) {
1645        print TARGET_FILE $source_file_lines[$source_file_line_number];
1646        $source_file_line_number++;
1647    }
1648    $source_file_line_number = $source_file_chunk_finishing_line_number + 1;
1649
1650    my $chunk_key = $source_file_line_to_key_mapping{$line_key};
1651    my $source_file_chunk_text = $source_file_key_to_text_mapping->{$chunk_key};
1652    my $target_file_chunk_text = $target_file_key_to_text_mapping->{$chunk_key} || "";
1653    $target_file_chunk_text =~ s/(\n)*$//g;
1654
1655    # If no translation exists for this chunk, show this, and move on
1656    if ($source_file_chunk_text ne "" && $target_file_chunk_text eq "") {
1657        print TARGET_FILE "<!-- Missing translation: $chunk_key -->\n";
1658        next;
1659    }
1660
1661    print TARGET_FILE "<Text id=\"$chunk_key\">$target_file_chunk_text</Text>";
1662    if ($target_file_key_to_gti_comment_mapping->{$chunk_key}) {
1663        my $chunk_gti_comment = $target_file_key_to_gti_comment_mapping->{$chunk_key};
1664        $chunk_gti_comment =~ s/^Updated //;
1665        print TARGET_FILE "<Updated date=\"" . $chunk_gti_comment . "\"\/>";
1666    }
1667    print TARGET_FILE "\n";
1668    }
1669
1670    # Fill in the end of the file
1671    while ($source_file_line_number < scalar(@source_file_lines)) {
1672    print TARGET_FILE $source_file_lines[$source_file_line_number];
1673    $source_file_line_number++;
1674    }
1675
1676    close(TARGET_FILE);
1677}
1678
1679
1680# ==========================================================================================
1681#   GREENSTONE3 FUNCTIONS
1682
1683sub get_all_chunks_for_gs3
1684{
1685    # The code of the target language (ensure it is lowercase)
1686    my $target_language_code = lc(shift(@_));
1687    my $translation_file_key = lc(shift(@_));
1688
1689    # Check that the necessary arguments were supplied
1690    if (!$target_language_code) {
1691    &throw_fatal_error("Missing command argument.");
1692    }
1693
1694    # Get (and check) the translation configuration
1695    # my ($source_file_dir, $target_file, $translation_file_type) = &get_translation_configuration($target_language_code, $translation_file_key);
1696   
1697    my %source_files_key_to_text_mapping = ();
1698    my %target_files_key_to_text_mapping = ();
1699    my %source_files_key_to_last_update_date_mapping = ();
1700    my %target_files_key_to_last_update_date_mapping = ();
1701
1702    &build_gs3_configuration($target_language_code, \%source_files_key_to_text_mapping, \%target_files_key_to_text_mapping, \%source_files_key_to_last_update_date_mapping, \%target_files_key_to_last_update_date_mapping);
1703
1704    &log_message("Total number of source chunks: " . scalar(keys(%source_files_key_to_text_mapping)));
1705    &log_message("Total number of target chunks: " . scalar(keys(%target_files_key_to_text_mapping)));
1706
1707    my $xml_response = &create_xml_response_for_all_chunks($translation_file_key, "", \%source_files_key_to_text_mapping, \%target_files_key_to_text_mapping, \%source_files_key_to_last_update_date_mapping, \%target_files_key_to_last_update_date_mapping);   
1708    return $xml_response;
1709}
1710
1711
1712sub get_first_n_chunks_requiring_work_for_gs3
1713{
1714    # The code of the target language (ensure it is lowercase)
1715    my $target_language_code = lc(shift(@_));
1716    # The key of the file to translate (ensure it is lowercase)
1717    my $translation_file_key = lc(shift(@_));
1718    # The number of chunks to return (defaults to one if not specified)
1719    my $num_chunks_to_return = shift(@_) || "1";
1720   
1721    # Check that the necessary arguments were supplied
1722    if (!$target_language_code || !$translation_file_key) {
1723    &throw_fatal_error("Missing command argument.");
1724    }
1725   
1726    my %source_files_key_to_text_mapping = ();
1727    my %target_files_key_to_text_mapping = ();
1728    my %source_files_key_to_last_update_date_mapping = ();
1729    my %target_files_key_to_last_update_date_mapping = ();
1730
1731    &build_gs3_configuration($target_language_code, \%source_files_key_to_text_mapping, \%target_files_key_to_text_mapping,
1732                 \%source_files_key_to_last_update_date_mapping, \%target_files_key_to_last_update_date_mapping);
1733   
1734    # Determine the target file chunks requiring translation
1735    my @target_files_keys_requiring_translation = &determine_chunks_requiring_translation(\%source_files_key_to_text_mapping, \%target_files_key_to_text_mapping);   
1736    # Determine the target file chunks requiring updating
1737    my @target_files_keys_requiring_updating = &determine_chunks_requiring_updating(\%source_files_key_to_last_update_date_mapping, \%target_files_key_to_last_update_date_mapping);
1738    &log_message("Total number of target chunks requiring translation: " . scalar(@target_files_keys_requiring_translation));
1739    &log_message("Total number of target chunks requiring updating: " . scalar(@target_files_keys_requiring_updating));
1740
1741    my $xml_response = &create_xml_response_for_chunks_requiring_work($translation_file_key, "", scalar(keys(%source_files_key_to_text_mapping)),
1742                                      \@target_files_keys_requiring_translation, \@target_files_keys_requiring_updating,
1743                                      $num_chunks_to_return, \%source_files_key_to_text_mapping, \%target_files_key_to_text_mapping,
1744                                      \%source_files_key_to_last_update_date_mapping, \%target_files_key_to_last_update_date_mapping);
1745   
1746    return $xml_response;
1747}
1748
1749
1750
1751sub build_gs3_configuration
1752{
1753    my ($target_language_code, $source_files_key_to_text_mapping, $target_files_key_to_text_mapping,
1754    $source_files_key_to_gti_comment_mapping, $target_files_key_to_gti_comment_mapping) = @_;
1755   
1756    my $source_file_directory = "greenstone3";
1757    my $translation_file_type = "resource_bundle";
1758
1759    foreach my $interface_file_key (@gs3_interface_files) {
1760
1761    &log_message("Greenstone 3 interface file: " . $interface_file_key);
1762
1763    # Parse the source language and target language files
1764    my $source_file = &util::filename_cat($source_file_directory, $interface_file_key.".properties");
1765    my @source_file_lines = &read_file_lines(&util::filename_cat($gsdl_root_directory, $source_file));
1766    my %source_file_key_to_line_mapping = &build_key_to_line_mapping(\@source_file_lines, $translation_file_type);
1767    my %source_file_key_to_text_mapping = &build_key_to_text_mapping(\@source_file_lines, \%source_file_key_to_line_mapping, $translation_file_type);
1768    my %source_file_key_to_gti_comment_mapping = &build_key_to_gti_comment_mapping(\@source_file_lines, \%source_file_key_to_line_mapping, $translation_file_type);
1769   
1770    my $target_file = &util::filename_cat($source_file_directory, $interface_file_key."_".$target_language_code.".properties");
1771    my @target_file_lines = &read_file_lines(&util::filename_cat($gsdl_root_directory, $target_file));
1772    my %target_file_key_to_line_mapping = &build_key_to_line_mapping(\@target_file_lines, $translation_file_type);
1773    my %target_file_key_to_text_mapping = &build_key_to_text_mapping(\@target_file_lines, \%target_file_key_to_line_mapping, $translation_file_type);
1774    my %target_file_key_to_gti_comment_mapping = &build_key_to_gti_comment_mapping(\@target_file_lines, \%target_file_key_to_line_mapping, $translation_file_type);
1775
1776
1777    # Filter out any automatically translated chunks
1778    foreach my $chunk_key (keys(%source_file_key_to_line_mapping)) {
1779        if (&is_chunk_automatically_translated($chunk_key, $translation_file_type)) {
1780        delete $source_file_key_to_line_mapping{$chunk_key};
1781        delete $target_file_key_to_line_mapping{$chunk_key};
1782        }
1783    }
1784
1785    &log_message("Number of source chunks: " . scalar(keys(%source_file_key_to_text_mapping)));
1786    &log_message("Number of target chunks: " . scalar(keys(%target_file_key_to_text_mapping)));
1787
1788    foreach my $chunk_key (keys(%source_file_key_to_text_mapping)) {
1789        my $global_chunk_key = "$interface_file_key.$chunk_key";
1790        $source_files_key_to_text_mapping->{$global_chunk_key} = $source_file_key_to_text_mapping{$chunk_key};
1791        $source_files_key_to_gti_comment_mapping->{$global_chunk_key} = $source_file_key_to_gti_comment_mapping{$chunk_key};
1792
1793        if (defined $target_file_key_to_text_mapping{$chunk_key}) {
1794        $target_files_key_to_text_mapping->{$global_chunk_key} = $target_file_key_to_text_mapping{$chunk_key};
1795        $target_files_key_to_gti_comment_mapping->{$global_chunk_key} = $target_file_key_to_gti_comment_mapping{$chunk_key};
1796        }
1797    }   
1798    }
1799}
1800
1801
1802sub write_translated_gs3interface
1803{
1804    my $source_file_key_to_text_mapping = shift(@_);
1805    my $target_file_key_to_text_mapping = shift(@_);
1806    my $target_file_key_to_gti_comment_mapping = shift(@_);
1807    my $target_language_code = shift(@_);
1808   
1809    my @sorted_chunk_keys = sort (keys(%$source_file_key_to_text_mapping));
1810
1811    my %translated_interface_file_keys = ();
1812    foreach my $chunk_key (keys(%$target_file_key_to_text_mapping)) {
1813    $chunk_key =~ /^([^\.]+)?\.(.*)$/;
1814    if (!defined $translated_interface_file_keys{$1}) {
1815        &log_message("Updated interface file: " . $1); 
1816        $translated_interface_file_keys{$1}="";
1817    }
1818    }
1819    &log_message("Updated interface files: " . scalar(keys(%translated_interface_file_keys)));
1820   
1821    my $source_file_directory = "greenstone3";   
1822   
1823    foreach my $interface_file_key (keys(%translated_interface_file_keys)) {
1824   
1825    # Build a mapping from chunk key to source file line, and from source file line to chunk key
1826    my $source_file = &util::filename_cat($source_file_directory, "$interface_file_key.properties");
1827    my @source_file_lines = &read_file_lines(&util::filename_cat($gsdl_root_directory, $source_file));
1828    my %source_file_key_to_line_mapping = &build_key_to_line_mapping_for_resource_bundle(@source_file_lines);
1829    my %source_file_line_to_key_mapping = ();
1830    foreach my $chunk_key (keys(%source_file_key_to_line_mapping)) {
1831        $source_file_line_to_key_mapping{$source_file_key_to_line_mapping{$chunk_key}} = $chunk_key;
1832    }
1833   
1834    # Write the new target file
1835    my $target_file = &util::filename_cat($source_file_directory, $interface_file_key . "_" . $target_language_code . ".properties");
1836    my $target_file_path = &util::filename_cat($gsdl_root_directory, $target_file);
1837    if (!open(TARGET_FILE, ">$target_file_path")) {
1838        &throw_fatal_error("Could not write target file $target_file_path.");
1839    }
1840
1841    # Model the new target file on the source file, with the target file translations
1842    my $source_file_line_number = 0;
1843    foreach my $line_key (sort sort_by_line (keys(%source_file_line_to_key_mapping))) {
1844        # Fill in the gaps before this chunk starts
1845        my $source_file_chunk_starting_line_number = (split(/-/, $line_key))[0];
1846        my $source_file_chunk_finishing_line_number = (split(/-/, $line_key))[1];
1847        while ($source_file_line_number < $source_file_chunk_starting_line_number) {
1848        print TARGET_FILE $source_file_lines[$source_file_line_number];
1849        $source_file_line_number++;
1850        }
1851        $source_file_line_number = $source_file_chunk_finishing_line_number + 1;
1852
1853        my $chunk_key = $source_file_line_to_key_mapping{$line_key};
1854        my $global_chunk_key = "$interface_file_key.$chunk_key";
1855        my $source_file_chunk_text = $source_file_key_to_text_mapping->{$global_chunk_key};
1856        my $target_file_chunk_text = $target_file_key_to_text_mapping->{$global_chunk_key} || "";
1857
1858        # If no translation exists for this chunk, show this, and move on
1859        if ($source_file_chunk_text ne "" && $target_file_chunk_text eq "") {
1860        print TARGET_FILE "# -- Missing translation: $chunk_key\n";
1861        next;
1862        }
1863
1864        print TARGET_FILE "$chunk_key:$target_file_chunk_text";
1865        if ($target_file_key_to_gti_comment_mapping->{$global_chunk_key}) {
1866        print TARGET_FILE "  # " . $target_file_key_to_gti_comment_mapping->{$global_chunk_key};
1867        }
1868        print TARGET_FILE "\n";
1869    }
1870
1871    close(TARGET_FILE);
1872    }           
1873}
1874
1875&main(@ARGV);
Note: See TracBrowser for help on using the browser.