source: trunk/gsdl/bin/script/gti.pl@ 11498

Last change on this file since 11498 was 11498, checked in by mdewsnip, 18 years ago

Code for handling new entities in the XML.
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 50.9 KB
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
35
36use iso639;
37use strict;
38use util;
39
40
41my $anonymous_cvs_root = ":pserver:cvs_anon\@cvs.scms.waikato.ac.nz:2402/usr/local/global-cvs/gsdl-src";
42my $gsdl_root_directory = "$ENV{'GSDLHOME'}";
43my $gti_log_file = &util::filename_cat($gsdl_root_directory, "etc", "gti.log");
44my $source_language_code = "en"; # This is non-negiotable
45
46my $gti_translation_files =
47 [ # Greenstone macrofiles
48 { 'key' => "coredm",
49 'file_type' => "macrofile",
50 'source_file' => "macros/english.dm",
51 '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" },
52 { 'key' => "auxdm",
53 'file_type' => "macrofile",
54 'source_file' => "macros/english2.dm",
55 '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" },
56
57 # GLI dictionary
58 { 'key' => "glidict",
59 'file_type' => "resource_bundle",
60 'source_file' => "gli/classes/dictionary.properties",
61 'target_file' => "gli/classes/dictionary_{target_language_code}.properties" },
62
63 # Greenstone Perl modules
64 { 'key' => "perlmodules",
65 'file_type' => "resource_bundle",
66 'source_file' => "perllib/strings.rb",
67 'target_file' => "perllib/strings_{target_language_code}.rb" },
68
69 # Greenstone tutorial exercises
70 # { 'key' => "tutorials",
71 # 'file_type' => "greenstone_xml",
72 # 'source_file' => "gsdl-tutorials/tutorial_en.xml",
73 # 'target_file' => "gsdl-tutorials/tutorial_{target_language_code}.xml" },
74
75 # Greenstone.org
76 # { 'key' => "greenorg",
77 # 'file_type' => "macrofile",
78 # 'source_file' => "greenorg/macros/english.dm",
79 # 'target_file' => "greenorg/macros/{iso_639_1_target_language_name}.dm" }
80 ];
81
82
83sub main
84{
85 # Get the command to process, and any arguments
86 my $gti_command = shift(@_);
87 my @gti_command_arguments = @_;
88
89 # Open the GTI log file for appending, or write to STDERR if that fails
90 if (!open(GTI_LOG, ">>$gti_log_file")) {
91 open(GTI_LOG, ">&STDERR");
92 }
93
94 # Log the command that launched this script
95 &log_message("Command: $0 @ARGV");
96
97 # Check that a command was supplied
98 if (!$gti_command) {
99 &throw_fatal_error("Missing command.");
100 }
101
102 # Process the command
103 if ($gti_command =~ /^get-first-n-chunks-requiring-work$/i) {
104 print &get_first_n_chunks_requiring_work(@gti_command_arguments);
105 }
106 if ($gti_command =~ /^get-language-status$/i) {
107 print &get_language_status(@gti_command_arguments);
108 }
109 if ($gti_command =~ /^search-chunks$/i) {
110 print &search_chunks(@gti_command_arguments);
111 }
112 if ($gti_command =~ /^submit-translations$/i) {
113 # This command cannot produce any output since it reads input
114 &submit_translations(@gti_command_arguments);
115 }
116
117 # The command was not recognized
118 # &throw_fatal_error("Unknown command \"$gti_command\".");
119}
120
121
122sub throw_fatal_error
123{
124 my $error_message = shift(@_);
125
126 # Write an XML error response
127 print "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>\n";
128 print "<GTIResponse>\n";
129 print " <GTIError time=\"" . time() . "\">" . $error_message . "</GTIError>\n";
130 print "</GTIResponse>\n";
131
132 # Log the error message, then die
133 &log_message("Error: $error_message");
134 die "\n";
135}
136
137
138sub log_message
139{
140 my $log_message = shift(@_);
141 print GTI_LOG time() . " -- " . $log_message . "\n";
142}
143
144
145sub get_first_n_chunks_requiring_work
146{
147 # The code of the target language (ensure it is lowercase)
148 my $target_language_code = lc(shift(@_));
149 # The key of the file to translate (ensure it is lowercase)
150 my $translation_file_key = lc(shift(@_));
151 # The number of chunks to return (defaults to one if not specified)
152 my $num_chunks_to_return = shift(@_) || "1";
153
154 # Check that the necessary arguments were supplied
155 if (!$target_language_code || !$translation_file_key) {
156 &throw_fatal_error("Missing command argument.");
157 }
158
159 # Get (and check) the translation configuration
160 my ($source_file, $target_file, $translation_file_type)
161 = &get_translation_configuration($target_language_code, $translation_file_key);
162
163 # Parse the source language and target language files
164 my $source_file_path = &util::filename_cat($gsdl_root_directory, $source_file);
165 my @source_file_lines = &read_file_lines($source_file_path);
166 my %source_file_key_to_line_mapping = &build_key_to_line_mapping(\@source_file_lines, $translation_file_type);
167
168 my $target_file_path = &util::filename_cat($gsdl_root_directory, $target_file);
169 my @target_file_lines = &read_file_lines($target_file_path);
170 my %target_file_key_to_line_mapping = &build_key_to_line_mapping(\@target_file_lines, $translation_file_type);
171
172 # Filter out any automatically translated chunks
173 foreach my $chunk_key (keys(%source_file_key_to_line_mapping)) {
174 if (&is_chunk_automatically_translated($chunk_key, $translation_file_type)) {
175 delete $source_file_key_to_line_mapping{$chunk_key};
176 delete $target_file_key_to_line_mapping{$chunk_key};
177 }
178 }
179
180 my %source_file_key_to_text_mapping = &build_key_to_text_mapping(\@source_file_lines, \%source_file_key_to_line_mapping, $translation_file_type);
181 my %target_file_key_to_text_mapping = &build_key_to_text_mapping(\@target_file_lines, \%target_file_key_to_line_mapping, $translation_file_type);
182 &log_message("Number of source chunks: " . scalar(keys(%source_file_key_to_text_mapping)));
183 &log_message("Number of target chunks: " . scalar(keys(%target_file_key_to_text_mapping)));
184
185 # Determine the target file chunks requiring translation
186 my @target_file_keys_requiring_translation = &determine_chunks_requiring_translation(\%source_file_key_to_text_mapping, \%target_file_key_to_text_mapping);
187 &log_message("Number of target chunks requiring translation: " . scalar(@target_file_keys_requiring_translation));
188
189 # Determine the target file chunks requiring updating
190 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);
191 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);
192 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);
193 &log_message("Number of target chunks requiring updating: " . scalar(@target_file_keys_requiring_updating));
194
195 # Form an XML response to the command
196 my $xml_response = "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>\n";
197 $xml_response .= "<GTIResponse>\n";
198 $xml_response .= " <TranslationFile"
199 . " key=\"" . $translation_file_key . "\""
200 . " target_file_path=\"" . $target_file . "\""
201 . " num_chunks_translated=\"" . (scalar(keys(%source_file_key_to_text_mapping)) - scalar(@target_file_keys_requiring_translation)) . "\""
202 . " num_chunks_requiring_translation=\"" . scalar(@target_file_keys_requiring_translation) . "\""
203 . " num_chunks_requiring_updating=\"" . scalar(@target_file_keys_requiring_updating) . "\"\/>\n";
204
205 # Do chunks requiring translation first
206 if ($num_chunks_to_return > scalar(@target_file_keys_requiring_translation)) {
207 $xml_response .= " <ChunksRequiringTranslation size=\"" . scalar(@target_file_keys_requiring_translation) . "\">\n";
208 }
209 else {
210 $xml_response .= " <ChunksRequiringTranslation size=\"" . $num_chunks_to_return . "\">\n";
211 }
212
213 foreach my $chunk_key (@target_file_keys_requiring_translation) {
214 last if ($num_chunks_to_return == 0);
215
216 my $source_file_chunk_date = $source_file_key_to_last_update_date_mapping{$chunk_key};
217 my $source_file_chunk_text = &make_text_xml_safe($source_file_key_to_text_mapping{$chunk_key});
218
219 $xml_response .= " <Chunk key=\"$chunk_key\">\n";
220 $xml_response .= " <SourceFileText date=\"$source_file_chunk_date\">$source_file_chunk_text</SourceFileText>\n";
221 $xml_response .= " <TargetFileText></TargetFileText>\n";
222 $xml_response .= " </Chunk>\n";
223
224 $num_chunks_to_return--;
225 }
226
227 $xml_response .= " </ChunksRequiringTranslation>\n";
228
229 # Then do chunks requiring updating
230 if ($num_chunks_to_return > scalar(@target_file_keys_requiring_updating)) {
231 $xml_response .= " <ChunksRequiringUpdating size=\"" . scalar(@target_file_keys_requiring_updating) . "\">\n";
232 }
233 else {
234 $xml_response .= " <ChunksRequiringUpdating size=\"" . $num_chunks_to_return . "\">\n";
235 }
236
237 foreach my $chunk_key (@target_file_keys_requiring_updating) {
238 last if ($num_chunks_to_return == 0);
239
240 my $source_file_chunk_date = $source_file_key_to_last_update_date_mapping{$chunk_key};
241 my $source_file_chunk_text = &make_text_xml_safe($source_file_key_to_text_mapping{$chunk_key});
242 my $target_file_chunk_date = $target_file_key_to_last_update_date_mapping{$chunk_key};
243 my $target_file_chunk_text = &make_text_xml_safe($target_file_key_to_text_mapping{$chunk_key});
244
245 $xml_response .= " <Chunk key=\"$chunk_key\">\n";
246 $xml_response .= " <SourceFileText date=\"$source_file_chunk_date\">$source_file_chunk_text</SourceFileText>\n";
247 $xml_response .= " <TargetFileText date=\"$target_file_chunk_date\">$target_file_chunk_text</TargetFileText>\n";
248 $xml_response .= " </Chunk>\n";
249
250 $num_chunks_to_return--;
251 }
252
253 $xml_response .= " </ChunksRequiringUpdating>\n";
254
255 $xml_response .= "</GTIResponse>\n";
256 return $xml_response;
257}
258
259
260sub get_language_status
261{
262 # The code of the target language (ensure it is lowercase)
263 my $target_language_code = lc(shift(@_));
264
265 # Check that the necessary arguments were supplied
266 if (!$target_language_code) {
267 &throw_fatal_error("Missing command argument.");
268 }
269
270 # Form an XML response to the command
271 my $xml_response = "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>\n";
272 $xml_response .= "<GTIResponse>\n";
273 $xml_response .= " <LanguageStatus code=\"$target_language_code\">\n";
274
275 foreach my $translation_file (@$gti_translation_files) {
276 # Get (and check) the translation configuration
277 my ($source_file, $target_file, $translation_file_type)
278 = &get_translation_configuration($target_language_code, $translation_file->{'key'});
279
280 # Parse the source language and target language files
281 my $source_file_path = &util::filename_cat($gsdl_root_directory, $source_file);
282 my @source_file_lines = &read_file_lines($source_file_path);
283 my %source_file_key_to_line_mapping = &build_key_to_line_mapping(\@source_file_lines, $translation_file_type);
284
285 my $target_file_path = &util::filename_cat($gsdl_root_directory, $target_file);
286 my @target_file_lines = &read_file_lines($target_file_path);
287 my %target_file_key_to_line_mapping = &build_key_to_line_mapping(\@target_file_lines, $translation_file_type);
288
289 # Filter out any automatically translated chunks
290 foreach my $chunk_key (keys(%source_file_key_to_line_mapping)) {
291 if (&is_chunk_automatically_translated($chunk_key, $translation_file_type)) {
292 delete $source_file_key_to_line_mapping{$chunk_key};
293 delete $target_file_key_to_line_mapping{$chunk_key};
294 }
295 }
296
297 my %source_file_key_to_text_mapping = &build_key_to_text_mapping(\@source_file_lines, \%source_file_key_to_line_mapping, $translation_file_type);
298 my %target_file_key_to_text_mapping = &build_key_to_text_mapping(\@target_file_lines, \%target_file_key_to_line_mapping, $translation_file_type);
299 &log_message("Number of source chunks: " . scalar(keys(%source_file_key_to_text_mapping)));
300 &log_message("Number of target chunks: " . scalar(keys(%target_file_key_to_text_mapping)));
301
302 # Determine the target file chunks requiring translation
303 my @target_file_keys_requiring_translation = &determine_chunks_requiring_translation(\%source_file_key_to_text_mapping, \%target_file_key_to_text_mapping);
304 &log_message("Number of target chunks requiring translation: " . scalar(@target_file_keys_requiring_translation));
305
306 # Determine the target file chunks requiring updating
307 my @target_file_keys_requiring_updating = ();
308 if (-e $target_file_path) {
309 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);
310 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);
311 @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);
312 &log_message("Number of target chunks requiring updating: " . scalar(@target_file_keys_requiring_updating));
313 }
314
315 $xml_response .= " <TranslationFile"
316 . " key=\"" . $translation_file->{'key'} . "\""
317 . " target_file_path=\"" . $target_file . "\""
318 . " num_chunks_translated=\"" . (scalar(keys(%source_file_key_to_text_mapping)) - scalar(@target_file_keys_requiring_translation)) . "\""
319 . " num_chunks_requiring_translation=\"" . scalar(@target_file_keys_requiring_translation) . "\""
320 . " num_chunks_requiring_updating=\"" . scalar(@target_file_keys_requiring_updating) . "\"\/>\n";
321 }
322
323 $xml_response .= " </LanguageStatus>\n";
324
325 $xml_response .= "</GTIResponse>\n";
326 return $xml_response;
327}
328
329
330sub search_chunks
331{
332 # The code of the target language (ensure it is lowercase)
333 my $target_language_code = lc(shift(@_));
334 # The key of the file to translate (ensure it is lowercase)
335 my $translation_file_key = lc(shift(@_));
336 # The query string
337 my $query_string = join(' ', @_);
338
339 # Check that the necessary arguments were supplied
340 if (!$target_language_code || !$translation_file_key || !$query_string) {
341 &throw_fatal_error("Missing command argument.");
342 }
343
344 # Get (and check) the translation configuration
345 my ($source_file, $target_file, $translation_file_type)
346 = &get_translation_configuration($target_language_code, $translation_file_key);
347
348 # Parse the source language and target language files
349 my $source_file_path = &util::filename_cat($gsdl_root_directory, $source_file);
350 my @source_file_lines = &read_file_lines($source_file_path);
351 my %source_file_key_to_line_mapping = &build_key_to_line_mapping(\@source_file_lines, $translation_file_type);
352
353 my $target_file_path = &util::filename_cat($gsdl_root_directory, $target_file);
354 my @target_file_lines = &read_file_lines($target_file_path);
355 my %target_file_key_to_line_mapping = &build_key_to_line_mapping(\@target_file_lines, $translation_file_type);
356
357 # Filter out any automatically translated chunks
358 foreach my $chunk_key (keys(%source_file_key_to_line_mapping)) {
359 if (&is_chunk_automatically_translated($chunk_key, $translation_file_type)) {
360 delete $source_file_key_to_line_mapping{$chunk_key};
361 delete $target_file_key_to_line_mapping{$chunk_key};
362 }
363 }
364
365 my %source_file_key_to_text_mapping = &build_key_to_text_mapping(\@source_file_lines, \%source_file_key_to_line_mapping, $translation_file_type);
366 my %target_file_key_to_text_mapping = &build_key_to_text_mapping(\@target_file_lines, \%target_file_key_to_line_mapping, $translation_file_type);
367 &log_message("Number of source chunks: " . scalar(keys(%source_file_key_to_text_mapping)));
368 &log_message("Number of target chunks: " . scalar(keys(%target_file_key_to_text_mapping)));
369
370 # Determine the target file chunks matching the query
371 my @target_file_keys_matching_query = ();
372 foreach my $chunk_key (keys(%target_file_key_to_text_mapping)) {
373 my $target_file_text = $target_file_key_to_text_mapping{$chunk_key};
374 if ($target_file_text =~ /$query_string/i) {
375 # &log_message("Chunk with key $chunk_key matches query.");
376 push(@target_file_keys_matching_query, $chunk_key);
377 }
378 }
379
380 # Form an XML response to the command
381 my $xml_response = "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>\n";
382 $xml_response .= "<GTIResponse>\n";
383
384 $xml_response .= " <ChunksMatchingQuery size=\"" . scalar(@target_file_keys_matching_query) . "\">\n";
385 foreach my $chunk_key (@target_file_keys_matching_query) {
386 my $target_file_chunk_text = &make_text_xml_safe($target_file_key_to_text_mapping{$chunk_key});
387
388 $xml_response .= " <Chunk key=\"$chunk_key\">\n";
389 $xml_response .= " <TargetFileText>$target_file_chunk_text</TargetFileText>\n";
390 $xml_response .= " </Chunk>\n";
391 }
392 $xml_response .= " </ChunksMatchingQuery>\n";
393
394 $xml_response .= "</GTIResponse>\n";
395 return $xml_response;
396}
397
398
399sub submit_translations
400{
401 # The code of the target language (ensure it is lowercase)
402 my $target_language_code = lc(shift(@_));
403 # The key of the file to translate (ensure it is lowercase)
404 my $translation_file_key = lc(shift(@_));
405 # Whether to submit a target chunk even if it hasn't changed
406 my $force_submission_flag = shift(@_);
407
408 # Check that the necessary arguments were supplied
409 if (!$target_language_code || !$translation_file_key) {
410 &log_message("Fatal error (but cannot be thrown): Missing command argument.");
411 die "\n";
412 }
413
414 # Get (and check) the translation configuration
415 my ($source_file, $target_file, $translation_file_type)
416 = &get_translation_configuration($target_language_code, $translation_file_key);
417
418 # Parse the source language and target language files
419 my @source_file_lines = &read_file_lines(&util::filename_cat($gsdl_root_directory, $source_file));
420 my %source_file_key_to_line_mapping = &build_key_to_line_mapping(\@source_file_lines, $translation_file_type);
421 my %source_file_key_to_text_mapping = &build_key_to_text_mapping(\@source_file_lines, \%source_file_key_to_line_mapping, $translation_file_type);
422 my %source_file_key_to_comment_date_mapping = &build_key_to_comment_date_mapping(\@source_file_lines, \%source_file_key_to_line_mapping, $translation_file_type);
423 &log_message("Number of source chunks: " . scalar(keys(%source_file_key_to_text_mapping)));
424
425 my @target_file_lines = &read_file_lines(&util::filename_cat($gsdl_root_directory, $target_file));
426 my %target_file_key_to_line_mapping = &build_key_to_line_mapping(\@target_file_lines, $translation_file_type);
427 my %target_file_key_to_text_mapping = &build_key_to_text_mapping(\@target_file_lines, \%target_file_key_to_line_mapping, $translation_file_type);
428 my %target_file_key_to_comment_date_mapping = &build_key_to_comment_date_mapping(\@target_file_lines, \%target_file_key_to_line_mapping, $translation_file_type);
429 &log_message("Number of target chunks: " . scalar(keys(%target_file_key_to_text_mapping)));
430
431 # Submission date
432 my $day = (localtime)[3];
433 my $month = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")[(localtime)[4]];
434 my $year = (localtime)[5] + 1900;
435 my $submission_date = "$day-$month-$year";
436
437 open(SUBMISSION, "-");
438 my @submission_lines = <SUBMISSION>;
439 close(SUBMISSION);
440
441 # Remove any nasty carriage returns
442 &log_message("Submission:");
443 foreach my $submission_line (@submission_lines) {
444 $submission_line =~ s/\r$//;
445 &log_message(" $submission_line");
446 }
447
448 my %source_file_key_to_submission_mapping = ();
449 my %target_file_key_to_submission_mapping = ();
450 for (my $i = 0; $i < scalar(@submission_lines); $i++) {
451 # Read source file part of submission
452 if ($submission_lines[$i] =~ /^\<SourceFileText key=\"(.+)\"\>/) {
453 my $chunk_key = $1;
454
455 # Read the source file text
456 my $source_file_chunk_text = "";
457 $i++;
458 while ($i < scalar(@submission_lines) && $submission_lines[$i] !~ /^\<\/SourceFileText\>/) {
459 $source_file_chunk_text .= $submission_lines[$i];
460 $i++;
461 }
462 $source_file_chunk_text =~ s/\n$//; # Strip the extra newline character added
463 $source_file_chunk_text = &unmake_text_xml_safe($source_file_chunk_text);
464
465 &log_message("Source file key: $chunk_key");
466 &log_message("Source file text: $source_file_chunk_text");
467 $source_file_key_to_submission_mapping{$chunk_key} = $source_file_chunk_text;
468 }
469
470 # Read target file part of submission
471 if ($submission_lines[$i] =~ /^\<TargetFileText key=\"(.+)\"\>/) {
472 my $chunk_key = $1;
473
474 # Read the target file text
475 my $target_file_chunk_text = "";
476 $i++;
477 while ($i < scalar(@submission_lines) && $submission_lines[$i] !~ /^\<\/TargetFileText\>/) {
478 $target_file_chunk_text .= $submission_lines[$i];
479 $i++;
480 }
481 $target_file_chunk_text =~ s/\n$//; # Strip the extra newline character added
482 $target_file_chunk_text = &unmake_text_xml_safe($target_file_chunk_text);
483
484 &log_message("Target file key: $chunk_key");
485 &log_message("Target file text: $target_file_chunk_text");
486 $target_file_key_to_submission_mapping{$chunk_key} = $target_file_chunk_text;
487 }
488 }
489
490 # -----------------------------------------
491 # Validate the translation submissions
492 # -----------------------------------------
493
494 # Check that the translations are valid
495 foreach my $chunk_key (keys(%source_file_key_to_submission_mapping)) {
496 # Make sure the submitted chunk still exists in the source file
497 if (!defined($source_file_key_to_text_mapping{$chunk_key})) {
498 &log_message("Warning: Source chunk $chunk_key no longer exists (ignoring submission).");
499 delete $source_file_key_to_submission_mapping{$chunk_key};
500 delete $target_file_key_to_submission_mapping{$chunk_key};
501 next;
502 }
503
504 # Make sure the submitted source chunk matches the source file chunk
505 if ($source_file_key_to_submission_mapping{$chunk_key} ne $source_file_key_to_text_mapping{$chunk_key}) {
506 &log_message("Warning: Source chunk $chunk_key has changed (ignoring submission).");
507 &log_message("Submission source: $source_file_key_to_submission_mapping{$chunk_key}");
508 &log_message(" Source text: $source_file_key_to_text_mapping{$chunk_key}");
509 delete $source_file_key_to_submission_mapping{$chunk_key};
510 delete $target_file_key_to_submission_mapping{$chunk_key};
511 next;
512 }
513 }
514
515 # Apply the submitted translations
516 foreach my $chunk_key (keys(%target_file_key_to_submission_mapping)) {
517 # Only apply the submission if it is a change, unless -force_submission has been specified
518 if ($force_submission_flag || $target_file_key_to_submission_mapping{$chunk_key} ne $target_file_key_to_text_mapping{$chunk_key}) {
519 $target_file_key_to_text_mapping{$chunk_key} = $target_file_key_to_submission_mapping{$chunk_key};
520 $target_file_key_to_comment_date_mapping{$chunk_key} = $submission_date;
521 }
522 }
523
524 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_comment_date_mapping, \$target_language_code)";
525}
526
527
528sub get_translation_configuration
529{
530 # Get the code of the target language
531 my $target_language_code = shift(@_);
532 # Get the key of the file to translate
533 my $translation_file_key = shift(@_);
534
535 # Read the translation data from the gti.cfg file
536 my ($source_file, $target_file, $translation_file_type) =
537 &get_translation_data_for($target_language_code, $translation_file_key);
538
539 # Check that the file to translate is defined in the gti.cfg file
540 if (!$source_file || !$target_file || !$translation_file_type) {
541 &throw_fatal_error("Missing or incomplete specification for translation file \"$translation_file_key\" in gti.pl.");
542 }
543
544 # Check that the source file exists
545 my $source_file_path = &util::filename_cat($gsdl_root_directory, $source_file);
546 if (!-e $source_file_path) {
547 &throw_fatal_error("Source file $source_file_path does not exist.");
548 }
549
550 # Check that the source file is up to date
551 # The "2>/dev/null" is very important! If it is missing this will never return when run from the receptionist
552 # unless ($translation_file_is_not_in_cvs) {
553 my $source_file_cvs_status = `cd $gsdl_root_directory; cvs -d $anonymous_cvs_root update $source_file 2>/dev/null`;
554 if ($source_file_cvs_status =~ /^C /) {
555 &throw_fatal_error("Source file $source_file_path conflicts with the repository.");
556 }
557 if ($source_file_cvs_status =~ /^M /) {
558 &throw_fatal_error("Source file $source_file_path contains uncommitted changes.");
559 }
560 # }
561
562 return ($source_file, $target_file, $translation_file_type);
563}
564
565
566sub get_translation_data_for
567{
568 my ($target_language_code, $translation_file_key) = @_;
569
570 foreach my $translation_file (@$gti_translation_files) {
571 # If this isn't the correct translation file, move onto the next one
572 next if ($translation_file_key ne $translation_file->{'key'});
573
574 # Resolve the target language file
575 my $target_language_file = $translation_file->{'target_file'};
576 if ($target_language_file =~ /(\{.+\;.+\})/) {
577 my $unresolved_target_language_file_part = $1;
578
579 # Check for a special case for the target language code
580 if ($unresolved_target_language_file_part =~ /(\{|\;)$target_language_code:([^\;]+)(\;|\})/) {
581 my $resolved_target_language_file_part = $2;
582 $target_language_file =~ s/$unresolved_target_language_file_part/$resolved_target_language_file_part/;
583 }
584 # Otherwise use the last part as the default value
585 else {
586 my ($default_target_language_file_part) = $unresolved_target_language_file_part =~ /([^\;]+)\}/;
587 $target_language_file =~ s/$unresolved_target_language_file_part/\{$default_target_language_file_part\}/;
588 }
589 }
590
591 # Resolve instances of {iso_639_1_target_language_name}
592 my $iso_639_1_target_language_name = $iso639::fromiso639{$target_language_code};
593 $iso_639_1_target_language_name =~ tr/A-Z/a-z/ if $iso_639_1_target_language_name;
594 $target_language_file =~ s/\{iso_639_1_target_language_name\}/$iso_639_1_target_language_name/g;
595
596 # Resolve instances of {target_language_code}
597 $target_language_file =~ s/\{target_language_code\}/$target_language_code/g;
598
599 return ($translation_file->{'source_file'}, $target_language_file, $translation_file->{'file_type'});
600 }
601
602 return ();
603}
604
605
606sub read_file_lines
607{
608 my ($file_path) = @_;
609
610 if (!open(FILE_IN, "<$file_path")) {
611 &log_message("Note: Could not open file $file_path.");
612 return ();
613 }
614 my @file_lines = <FILE_IN>;
615 close(FILE_IN);
616
617 return @file_lines;
618}
619
620
621sub build_key_to_line_mapping
622{
623 my ($file_lines, $translation_file_type) = @_;
624 eval "return &build_key_to_line_mapping_for_${translation_file_type}(\@\$file_lines)";
625}
626
627
628sub build_key_to_text_mapping
629{
630 my ($file_lines, $key_to_line_mapping, $translation_file_type) = @_;
631
632 my %key_to_text_mapping = ();
633 foreach my $chunk_key (keys(%$key_to_line_mapping)) {
634 my $chunk_starting_line = (split(/-/, $key_to_line_mapping->{$chunk_key}))[0];
635 my $chunk_finishing_line = (split(/-/, $key_to_line_mapping->{$chunk_key}))[1];
636
637 my $chunk_text = @$file_lines[$chunk_starting_line];
638 for (my $l = ($chunk_starting_line + 1); $l <= $chunk_finishing_line; $l++) {
639 $chunk_text .= @$file_lines[$l];
640 }
641
642 # Map from chunk key to text
643 eval "\$key_to_text_mapping{\${chunk_key}} = &import_chunk_from_${translation_file_type}(\$chunk_text)";
644 }
645
646 return %key_to_text_mapping;
647}
648
649
650sub build_key_to_last_update_date_mapping
651{
652 my ($file, $file_lines, $key_to_line_mapping, $translation_file_type) = @_;
653
654 # If the files aren't in CVS then we can't tell anything about what needs updating
655 # return () if ($translation_file_is_not_in_cvs);
656
657 # Build a mapping from key to CVS date
658 # Need to be careful with this mapping because the chunk keys won't necessarily all be valid
659 my %key_to_cvs_date_mapping = &build_key_to_cvs_date_mapping($file, $translation_file_type);
660
661 # Build a mapping from key to comment date
662 my %key_to_comment_date_mapping = &build_key_to_comment_date_mapping($file_lines, $key_to_line_mapping, $translation_file_type);
663
664 # Build a mapping from key to last update date (the latter of the CVS date and comment date)
665 my %key_to_last_update_date_mapping = ();
666 foreach my $chunk_key (keys(%$key_to_line_mapping)) {
667 # Use the CVS date as a starting point
668 my $chunk_cvs_date = $key_to_cvs_date_mapping{$chunk_key};
669 $key_to_last_update_date_mapping{$chunk_key} = $chunk_cvs_date;
670
671 # If a comment date exists and it is after the CVS date, use that instead
672 my $chunk_comment_date = $key_to_comment_date_mapping{$chunk_key};
673 if (defined($chunk_comment_date) && (!defined($chunk_cvs_date) || &is_date_after($chunk_comment_date, $chunk_cvs_date))) {
674 $key_to_last_update_date_mapping{$chunk_key} = $chunk_comment_date;
675 }
676 }
677
678 return %key_to_last_update_date_mapping;
679}
680
681
682sub build_key_to_cvs_date_mapping
683{
684 my ($filename, $translation_file_type) = @_;
685
686 # Use CVS to annotate each line of the file with the date it was last edited
687 # The "2>/dev/null" is very important! If it is missing this will never return when run from the receptionist
688 my $cvs_annotated_file = `cd $gsdl_root_directory; cvs -d $anonymous_cvs_root annotate -F $filename 2>/dev/null`;
689 my @cvs_annotated_file_lines = split(/\n/, $cvs_annotated_file);
690
691 my @cvs_annotated_file_lines_date = ();
692 foreach my $cvs_annotated_file_line (@cvs_annotated_file_lines) {
693 # Extract the date from the CVS annotation at the front
694 $cvs_annotated_file_line =~ s/^\S+\s+\(\S+\s+(\S+)\):\s//;
695 push(@cvs_annotated_file_lines_date, $1);
696 }
697
698 # Build a key to line mapping for the CVS annotated file, for matching the chunk key to the CVS date
699 my %key_to_line_mapping = &build_key_to_line_mapping(\@cvs_annotated_file_lines, $translation_file_type);
700
701 my %key_to_cvs_date_mapping = ();
702 foreach my $chunk_key (keys(%key_to_line_mapping)) {
703 my $chunk_starting_line = (split(/-/, $key_to_line_mapping{$chunk_key}))[0];
704 my $chunk_finishing_line = (split(/-/, $key_to_line_mapping{$chunk_key}))[1];
705
706 # Find the date this chunk was last edited, from the CVS annotation
707 my $chunk_date = $cvs_annotated_file_lines_date[$chunk_starting_line];
708 for (my $l = ($chunk_starting_line + 1); $l <= $chunk_finishing_line; $l++) {
709 if (&is_date_after($cvs_annotated_file_lines_date[$l], $chunk_date)) {
710 # This part of the chunk has been updated more recently
711 $chunk_date = $cvs_annotated_file_lines_date[$l];
712 }
713 }
714
715 # Map from chunk key to CVS date
716 $key_to_cvs_date_mapping{$chunk_key} = $chunk_date;
717 }
718
719 return %key_to_cvs_date_mapping;
720}
721
722
723sub build_key_to_comment_date_mapping
724{
725 my ($file_lines, $key_to_line_mapping, $translation_file_type) = @_;
726
727 my %key_to_comment_date_mapping = ();
728 foreach my $chunk_key (keys(%$key_to_line_mapping)) {
729 my $chunk_starting_line = (split(/-/, $key_to_line_mapping->{$chunk_key}))[0];
730 my $chunk_finishing_line = (split(/-/, $key_to_line_mapping->{$chunk_key}))[1];
731
732 my $chunk_text = @$file_lines[$chunk_starting_line];
733 for (my $l = ($chunk_starting_line + 1); $l <= $chunk_finishing_line; $l++) {
734 $chunk_text .= @$file_lines[$l];
735 }
736
737 # Map from chunk key to comment date
738 my $chunk_comment_date;
739 eval "\$chunk_comment_date = &get_${translation_file_type}_chunk_comment_date(\$chunk_text)";
740 $key_to_comment_date_mapping{$chunk_key} = $chunk_comment_date if (defined($chunk_comment_date));
741 }
742
743 return %key_to_comment_date_mapping;
744}
745
746
747sub determine_chunks_requiring_translation
748{
749 my $source_file_key_to_text_mapping = shift(@_);
750 my $target_file_key_to_text_mapping = shift(@_);
751
752 # Chunks needing translation are those in the source file with no translation in the target file
753 my @target_file_keys_requiring_translation = ();
754 foreach my $chunk_key (keys(%$source_file_key_to_text_mapping)) {
755 if ($source_file_key_to_text_mapping->{$chunk_key} && !$target_file_key_to_text_mapping->{$chunk_key}) {
756 # &log_message("Chunk with key $chunk_key needs translating.");
757 push(@target_file_keys_requiring_translation, $chunk_key);
758 }
759 }
760
761 return @target_file_keys_requiring_translation;
762}
763
764
765sub determine_chunks_requiring_updating
766{
767 my $source_file_key_to_last_update_date_mapping = shift(@_);
768 my $target_file_key_to_last_update_date_mapping = shift(@_);
769
770 # Chunks needing updating are those in the target file that have been more recently edited in the source file
771 my @target_file_keys_requiring_updating = ();
772 foreach my $chunk_key (keys(%$source_file_key_to_last_update_date_mapping)) {
773 my $source_chunk_last_update_date = $source_file_key_to_last_update_date_mapping->{$chunk_key};
774 my $target_chunk_last_update_date = $target_file_key_to_last_update_date_mapping->{$chunk_key};
775 if (defined($target_chunk_last_update_date) && &is_date_after($source_chunk_last_update_date, $target_chunk_last_update_date)) {
776 # &log_message("Chunk with key $chunk_key needs updating.");
777 push(@target_file_keys_requiring_updating, $chunk_key);
778 }
779 }
780
781 return @target_file_keys_requiring_updating;
782}
783
784
785sub is_chunk_automatically_translated
786{
787 my ($chunk_key, $translation_file_type) = @_;
788 eval "return &is_${translation_file_type}_chunk_automatically_translated(\$chunk_key)";
789}
790
791
792sub make_text_xml_safe
793{
794 my $text = shift(@_);
795 $text =~ s/\&/\&amp\;/g;
796 $text =~ s/\&amp\;lt\;/\&amp\;amp\;lt\;/g;
797 $text =~ s/\&amp\;gt\;/\&amp\;amp\;gt\;/g;
798 $text =~ s/\&amp\;rarr\;/\&amp\;amp\;rarr\;/g;
799 $text =~ s/\&amp\;mdash\;/\&amp\;amp\;mdash\;/g;
800 $text =~ s/</\&lt\;/g;
801 $text =~ s/>/\&gt\;/g;
802 return $text;
803}
804
805
806sub unmake_text_xml_safe
807{
808 my $text = shift(@_);
809 $text =~ s/\&lt\;/</g;
810 $text =~ s/\&gt\;/>/g;
811 $text =~ s/\&amp\;/\&/g;
812 return $text;
813}
814
815
816# Returns 1 if $date1 is after $date2, 0 otherwise
817sub is_date_after
818{
819 my ($date1, $date2) = @_;
820 my %months = ("Jan", 1, "Feb", 2, "Mar", 3, "Apr", 4, "May", 5, "Jun", 6,
821 "Jul", 7, "Aug", 8, "Sep", 9, "Oct", 10, "Nov", 11, "Dec", 12);
822
823 my @date1parts = split(/-/, $date1);
824 my @date2parts = split(/-/, $date2);
825
826 # Compare year - nasty because we have rolled over into a new century
827 my $year1 = $date1parts[2];
828 if ($year1 < 80) {
829 $year1 += 100;
830 }
831 my $year2 = $date2parts[2];
832 if ($year2 < 80) {
833 $year2 += 100;
834 }
835
836 # Compare year
837 if ($year1 > $year2) {
838 return 1;
839 }
840 elsif ($year1 == $year2) {
841 # Year is the same, so compare month
842 if ($months{$date1parts[1]} > $months{$date2parts[1]}) {
843 return 1;
844 }
845 elsif ($months{$date1parts[1]} == $months{$date2parts[1]}) {
846 # Month is the same, so compare day
847 if ($date1parts[0] > $date2parts[0]) {
848 return 1;
849 }
850 }
851 }
852
853 return 0;
854}
855
856
857# ==========================================================================================
858# MACROFILE FUNCTIONS
859
860sub build_key_to_line_mapping_for_macrofile
861{
862 my (@file_lines) = @_;
863
864 my $macro_package;
865 my %chunk_key_to_line_mapping = ();
866 # Process the contents of the file, line by line
867 for (my $i = 0; $i < scalar(@file_lines); $i++) {
868 my $line = $file_lines[$i];
869 $line =~ s/(\s*)$//; # Remove any nasty whitespace, carriage returns etc.
870
871 # Check if a new package is being defined
872 if ($line =~ m/^package\s+(.+)/) {
873 $macro_package = $1;
874 }
875
876 # Line contains a macro name
877 elsif ($line =~ m/^(_\w+_)/) {
878 my $macro_key = $1;
879 $line =~ s/\s*([^\\]\#[^\}]+)?$//; # Remove any comments and nasty whitespace
880
881 # While there is still text of the macro to go...
882 my $startline = $i;
883 while ($line !~ /\}$/) {
884 $i++;
885 if ($i == scalar(@file_lines)) {
886 &throw_fatal_error("Could not find end of macro $macro_key.");
887 }
888 $line = $file_lines[$i];
889 $line =~ s/\s*([^\\]\#[^\}]+)?$//; # Remove any comments and nasty whitespace
890 }
891
892 # The chunk key consists of the package name and the macro key
893 my $chunk_key = $macro_package . "." . $macro_key;
894 # Map from chunk key to line
895 $chunk_key_to_line_mapping{$chunk_key} = $startline . "-" . $i;
896 }
897
898 # Icon: line in format ## "image text" ## image_type ## macro_name ##
899 elsif ($line =~ m/^\#\# .* \#\# .* \#\# (.*) \#\#/) {
900 # The chunk key consists of package name and macro key
901 my $chunk_key = $macro_package . "." . $1;
902 # Map from chunk key to line
903 $chunk_key_to_line_mapping{$chunk_key} = $i . "-" . $i;
904 }
905 }
906
907 return %chunk_key_to_line_mapping;
908}
909
910
911sub import_chunk_from_macrofile
912{
913 my ($chunk_text) = @_;
914
915 # Is this an icon macro??
916 if ($chunk_text =~ /^\#\# (.*)/) {
917 # Extract image macro text
918 $chunk_text =~ /^\#\#\s+([^\#]+)\s+\#\#/;
919 $chunk_text = $1;
920
921 # Remove enclosing quotes
922 $chunk_text =~ s/^\"//;
923 $chunk_text =~ s/\"$//;
924 }
925
926 # No, so it must be a text macro
927 else {
928 # Remove macro key
929 $chunk_text =~ s/^_([^_]+)_(\s*)//;
930
931 # Remove language specifier
932 $chunk_text =~ s/^\[l=.*\](\s*)//;
933
934 # Remove braces enclosing text
935 $chunk_text =~ s/^{(\s*)((.|\n)*)}(\s*)(\#.+\s*)?/$2/;
936 }
937
938 return $chunk_text;
939}
940
941
942sub get_macrofile_chunk_comment_date
943{
944 my ($chunk_text) = @_;
945
946 # Check for an "Updated DD-MMM-YYYY" comment at the end of the chunk
947 if ($chunk_text =~ /\#\s+Updated\s+(\d?\d-\D\D\D-\d\d\d\d)\s*$/i) {
948 return $1;
949 }
950
951 return undef;
952}
953
954
955sub is_macrofile_chunk_automatically_translated
956{
957 my ($chunk_key) = @_;
958
959 # The _httpiconX_, _widthX_ and _heightX_ image macros are automatically translated
960 if ($chunk_key =~ /\._(httpicon|width|height)/) {
961 return 1;
962 }
963
964 return 0;
965}
966
967
968# Use the source file to generate a target file that is formatted the same
969sub write_translated_macrofile
970{
971 my $source_file = shift(@_); # Not used
972 my @source_file_lines = @{shift(@_)};
973 my $source_file_key_to_text_mapping = shift(@_);
974 my $target_file = shift(@_);
975 my @target_file_lines = @{shift(@_)};
976 my $target_file_key_to_text_mapping = shift(@_);
977 my $target_file_key_to_comment_date_mapping = shift(@_);
978 my $target_language_code = shift(@_);
979
980 # Build a mapping from source file line to chunk key
981 my %source_file_key_to_line_mapping = &build_key_to_line_mapping_for_macrofile(@source_file_lines);
982 my %source_file_line_to_key_mapping = ();
983 foreach my $chunk_key (keys(%source_file_key_to_line_mapping)) {
984 $source_file_line_to_key_mapping{$source_file_key_to_line_mapping{$chunk_key}} = $chunk_key;
985 }
986 my @source_file_line_keys = (sort sort_by_line (keys(%source_file_line_to_key_mapping)));
987 my $source_file_line_number = 0;
988
989 # Build a mapping from target file line to chunk key
990 my %target_file_key_to_line_mapping = &build_key_to_line_mapping_for_macrofile(@target_file_lines);
991 my %target_file_line_to_key_mapping = ();
992 foreach my $chunk_key (keys(%target_file_key_to_line_mapping)) {
993 $target_file_line_to_key_mapping{$target_file_key_to_line_mapping{$chunk_key}} = $chunk_key;
994 }
995 my @target_file_line_keys = (sort sort_by_line (keys(%target_file_line_to_key_mapping)));
996
997 # Write the new target file
998 my $target_file_path = &util::filename_cat($gsdl_root_directory, $target_file);
999 if (!open(TARGET_FILE, ">$target_file_path")) {
1000 &throw_fatal_error("Could not write target file $target_file_path.");
1001 }
1002
1003 # Use the header from the target file, to keep language and author information
1004 if (scalar(@target_file_line_keys) > 0) {
1005 my $target_file_line_number = 0;
1006 my $target_file_chunk_starting_line_number = (split(/-/, $target_file_line_keys[0]))[0];
1007 while ($target_file_line_number < $target_file_chunk_starting_line_number) {
1008 my $target_file_line = $target_file_lines[$target_file_line_number];
1009 last if ($target_file_line =~ /^\# -- Missing translation: /); # We don't want to get into the macros
1010 print TARGET_FILE $target_file_line;
1011 $target_file_line_number++;
1012 }
1013
1014 $source_file_line_number = (split(/-/, $source_file_line_keys[0]))[0];
1015 }
1016
1017 # Model the new target file on the source file, with the target file translations
1018 foreach my $line_key (@source_file_line_keys) {
1019 # Fill in the gaps before this chunk starts
1020 my $source_file_chunk_starting_line_number = (split(/-/, $line_key))[0];
1021 my $source_file_chunk_finishing_line_number = (split(/-/, $line_key))[1];
1022 while ($source_file_line_number < $source_file_chunk_starting_line_number) {
1023 print TARGET_FILE $source_file_lines[$source_file_line_number];
1024 $source_file_line_number++;
1025 }
1026 $source_file_line_number = $source_file_chunk_finishing_line_number + 1;
1027
1028 my $chunk_key = $source_file_line_to_key_mapping{$line_key};
1029 my $source_file_chunk_text = $source_file_key_to_text_mapping->{$chunk_key};
1030 my $target_file_chunk_text = $target_file_key_to_text_mapping->{$chunk_key} || "";
1031
1032 my $macrofile_key = $chunk_key;
1033 $macrofile_key =~ s/^(.+?)\.//;
1034
1035 # If no translation exists for this chunk, show this, and move on
1036 if ($source_file_chunk_text ne "" && $target_file_chunk_text eq "") {
1037 print TARGET_FILE "# -- Missing translation: $macrofile_key\n";
1038 next;
1039 }
1040
1041 # Grab the source chunk text
1042 my $source_file_chunk = $source_file_lines[$source_file_chunk_starting_line_number];
1043 for (my $l = ($source_file_chunk_starting_line_number + 1); $l <= $source_file_chunk_finishing_line_number; $l++) {
1044 $source_file_chunk .= $source_file_lines[$l];
1045 }
1046
1047 # Is this an icon macro??
1048 if ($source_file_chunk =~ /^\#\# (.*)/) {
1049 # Escape any newline and question mark characters so the source text is replaced correctly
1050 $source_file_chunk_text =~ s/\\/\\\\/g;
1051 $source_file_chunk_text =~ s/\?/\\\?/g;
1052
1053 # Build the new target chunk from the source chunk
1054 my $target_file_chunk = $source_file_chunk;
1055 $target_file_chunk =~ s/$source_file_chunk_text/$target_file_chunk_text/;
1056 $target_file_chunk =~ s/(\s)*$//;
1057 print TARGET_FILE "$target_file_chunk";
1058 }
1059
1060 # No, it is just a normal text macro
1061 else {
1062 print TARGET_FILE "$macrofile_key [l=$target_language_code] {$target_file_chunk_text}";
1063 }
1064
1065 # Add the update date, if one exists
1066 if ($target_file_key_to_comment_date_mapping->{$chunk_key}) {
1067 print TARGET_FILE " # Updated " . $target_file_key_to_comment_date_mapping->{$chunk_key};
1068 }
1069 print TARGET_FILE "\n";
1070 }
1071
1072 close(TARGET_FILE);
1073}
1074
1075
1076sub sort_by_line
1077{
1078 return ((split(/-/, $a))[0] <=> (split(/-/, $b))[0]);
1079}
1080
1081
1082# ==========================================================================================
1083# RESOURCE BUNDLE FUNCTIONS
1084
1085sub build_key_to_line_mapping_for_resource_bundle
1086{
1087 my (@file_lines) = @_;
1088
1089 my %chunk_key_to_line_mapping = ();
1090 for (my $i = 0; $i < scalar(@file_lines); $i++) {
1091 my $line = $file_lines[$i];
1092 $line =~ s/(\s*)$//; # Remove any nasty whitespace, carriage returns etc.
1093
1094 # Line contains a dictionary string
1095 if ($line =~ /^(\S+?):(.*)$/) {
1096 my $chunk_key = $1;
1097
1098 # Map from chunk key to line
1099 $chunk_key_to_line_mapping{$chunk_key} = $i . "-" . $i;
1100 }
1101 }
1102
1103 return %chunk_key_to_line_mapping;
1104}
1105
1106
1107sub import_chunk_from_resource_bundle
1108{
1109 my ($chunk_text) = @_;
1110
1111 # Simple: just remove string key
1112 $chunk_text =~ s/^(\S+?):(\s*)//;
1113 $chunk_text =~ s/(\s*)$//; # Remove any nasty whitespace, carriage returns etc.
1114 $chunk_text =~ s/(\s*)\#\s+Updated\s+(\d?\d-\D\D\D-\d\d\d\d)\s*$//i;
1115
1116 return $chunk_text;
1117}
1118
1119
1120sub get_resource_bundle_chunk_comment_date
1121{
1122 my ($chunk_text) = @_;
1123
1124 # Check for an "Updated DD-MMM-YYYY" comment at the end of the chunk
1125 if ($chunk_text =~ /\#\s+Updated\s+(\d?\d-\D\D\D-\d\d\d\d)\s*$/i) {
1126 return $1;
1127 }
1128
1129 return undef;
1130}
1131
1132
1133sub is_resource_bundle_chunk_automatically_translated
1134{
1135 # No resource bundle chunks are automatically translated
1136 return 0;
1137}
1138
1139
1140sub write_translated_resource_bundle
1141{
1142 my $source_file = shift(@_); # Not used
1143 my @source_file_lines = @{shift(@_)};
1144 my $source_file_key_to_text_mapping = shift(@_);
1145 my $target_file = shift(@_);
1146 my @target_file_lines = @{shift(@_)}; # Not used
1147 my $target_file_key_to_text_mapping = shift(@_);
1148 my $target_file_key_to_comment_date_mapping = shift(@_);
1149 my $target_language_code = shift(@_); # Not used
1150
1151 # Build a mapping from chunk key to source file line, and from source file line to chunk key
1152 my %source_file_key_to_line_mapping = &build_key_to_line_mapping_for_resource_bundle(@source_file_lines);
1153 my %source_file_line_to_key_mapping = ();
1154 foreach my $chunk_key (keys(%source_file_key_to_line_mapping)) {
1155 $source_file_line_to_key_mapping{$source_file_key_to_line_mapping{$chunk_key}} = $chunk_key;
1156 }
1157
1158 # Write the new target file
1159 my $target_file_path = &util::filename_cat($gsdl_root_directory, $target_file);
1160 if (!open(TARGET_FILE, ">$target_file_path")) {
1161 &throw_fatal_error("Could not write target file $target_file_path.");
1162 }
1163
1164 # Model the new target file on the source file, with the target file translations
1165 my $source_file_line_number = 0;
1166 foreach my $line_key (sort sort_by_line (keys(%source_file_line_to_key_mapping))) {
1167 # Fill in the gaps before this chunk starts
1168 my $source_file_chunk_starting_line_number = (split(/-/, $line_key))[0];
1169 my $source_file_chunk_finishing_line_number = (split(/-/, $line_key))[1];
1170 while ($source_file_line_number < $source_file_chunk_starting_line_number) {
1171 print TARGET_FILE $source_file_lines[$source_file_line_number];
1172 $source_file_line_number++;
1173 }
1174 $source_file_line_number = $source_file_chunk_finishing_line_number + 1;
1175
1176 my $chunk_key = $source_file_line_to_key_mapping{$line_key};
1177 my $source_file_chunk_text = $source_file_key_to_text_mapping->{$chunk_key};
1178 my $target_file_chunk_text = $target_file_key_to_text_mapping->{$chunk_key} || "";
1179
1180 # If no translation exists for this chunk, show this, and move on
1181 if ($source_file_chunk_text ne "" && $target_file_chunk_text eq "") {
1182 print TARGET_FILE "# -- Missing translation: $chunk_key\n";
1183 next;
1184 }
1185
1186 print TARGET_FILE "$chunk_key:$target_file_chunk_text";
1187 if ($target_file_key_to_comment_date_mapping->{$chunk_key}) {
1188 print TARGET_FILE " # Updated " . $target_file_key_to_comment_date_mapping->{$chunk_key};
1189 }
1190 print TARGET_FILE "\n";
1191 }
1192
1193 close(TARGET_FILE);
1194}
1195
1196
1197# ==========================================================================================
1198# GREENSTONE XML FUNCTIONS
1199
1200sub build_key_to_line_mapping_for_greenstone_xml
1201{
1202 my (@file_lines) = @_;
1203
1204 my %chunk_key_to_line_mapping = ();
1205 for (my $i = 0; $i < scalar(@file_lines); $i++) {
1206 my $line = $file_lines[$i];
1207 $line =~ s/(\s*)$//; # Remove any nasty whitespace, carriage returns etc.
1208
1209 # Line contains a string to translate
1210 if ($line =~ /^\s*<Text id=\"(.*?)\">/) {
1211 my $chunk_key = $1;
1212 $line =~ s/\s*$//; # Remove any nasty whitespace
1213 $line =~ s/<Updated date=\"\d?\d-\D\D\D-\d\d\d\d\"\/>$//;
1214
1215 # While there is still text of the string to go...
1216 my $startline = $i;
1217 while ($line !~ /<\/Text>$/) {
1218 $i++;
1219 if ($i == scalar(@file_lines)) {
1220 &throw_fatal_error("Could not find end of string $chunk_key.");
1221 }
1222 $line = $file_lines[$i];
1223 $line =~ s/\s*$//; # Remove any nasty whitespace
1224 }
1225
1226 # Map from chunk key to line
1227 $chunk_key_to_line_mapping{$chunk_key} = $startline . "-" . $i;
1228 }
1229 }
1230
1231 return %chunk_key_to_line_mapping;
1232}
1233
1234
1235sub import_chunk_from_greenstone_xml
1236{
1237 my ($chunk_text) = @_;
1238
1239 # Simple: just remove the Text tags
1240 $chunk_text =~ s/^\s*<Text id=\"(.*?)\">(\s*)//;
1241 $chunk_text =~ s/<Updated date=\"\d?\d-\D\D\D-\d\d\d\d\"\/>$//;
1242 $chunk_text =~ s/<\/Text>$//;
1243
1244 return $chunk_text;
1245}
1246
1247
1248sub get_greenstone_xml_chunk_comment_date
1249{
1250 my ($chunk_text) = @_;
1251
1252 # Check for an "Updated DD-MMM-YYYY" comment at the end of the chunk
1253 if ($chunk_text =~ /<Updated date=\"(\d?\d-\D\D\D-\d\d\d\d)\"\/>$/i) {
1254 return $1;
1255 }
1256
1257 return undef;
1258}
1259
1260
1261sub is_greenstone_xml_chunk_automatically_translated
1262{
1263 # No greenstone XML chunks are automatically translated
1264 return 0;
1265}
1266
1267
1268sub write_translated_greenstone_xml
1269{
1270 my $source_file = shift(@_); # Not used
1271 my @source_file_lines = @{shift(@_)};
1272 my $source_file_key_to_text_mapping = shift(@_);
1273 my $target_file = shift(@_);
1274 my @target_file_lines = @{shift(@_)}; # Not used
1275 my $target_file_key_to_text_mapping = shift(@_);
1276 my $target_file_key_to_comment_date_mapping = shift(@_);
1277 my $target_language_code = shift(@_); # Not used
1278
1279 # Build a mapping from chunk key to source file line, and from source file line to chunk key
1280 my %source_file_key_to_line_mapping = &build_key_to_line_mapping_for_greenstone_xml(@source_file_lines);
1281 my %source_file_line_to_key_mapping = ();
1282 foreach my $chunk_key (keys(%source_file_key_to_line_mapping)) {
1283 $source_file_line_to_key_mapping{$source_file_key_to_line_mapping{$chunk_key}} = $chunk_key;
1284 }
1285
1286 # Write the new target file
1287 my $target_file_path = &util::filename_cat($gsdl_root_directory, $target_file);
1288 if (!open(TARGET_FILE, ">$target_file_path")) {
1289 &throw_fatal_error("Could not write target file $target_file_path.");
1290 }
1291
1292 # Model the new target file on the source file, with the target file translations
1293 my $source_file_line_number = 0;
1294 foreach my $line_key (sort sort_by_line (keys(%source_file_line_to_key_mapping))) {
1295 # Fill in the gaps before this chunk starts
1296 my $source_file_chunk_starting_line_number = (split(/-/, $line_key))[0];
1297 my $source_file_chunk_finishing_line_number = (split(/-/, $line_key))[1];
1298 while ($source_file_line_number < $source_file_chunk_starting_line_number) {
1299 print TARGET_FILE $source_file_lines[$source_file_line_number];
1300 $source_file_line_number++;
1301 }
1302 $source_file_line_number = $source_file_chunk_finishing_line_number + 1;
1303
1304 my $chunk_key = $source_file_line_to_key_mapping{$line_key};
1305 my $source_file_chunk_text = $source_file_key_to_text_mapping->{$chunk_key};
1306 my $target_file_chunk_text = $target_file_key_to_text_mapping->{$chunk_key} || "";
1307 $target_file_chunk_text =~ s/(\n)*$//g;
1308
1309 # If no translation exists for this chunk, show this, and move on
1310 if ($source_file_chunk_text ne "" && $target_file_chunk_text eq "") {
1311 print TARGET_FILE "<!-- Missing translation: $chunk_key -->\n";
1312 next;
1313 }
1314
1315 print TARGET_FILE "<Text id=\"$chunk_key\">$target_file_chunk_text</Text>";
1316 if ($target_file_key_to_comment_date_mapping->{$chunk_key}) {
1317 print TARGET_FILE "<Updated date=\"" . $target_file_key_to_comment_date_mapping->{$chunk_key} . "\"\/>";
1318 }
1319 print TARGET_FILE "\n";
1320 }
1321
1322 # Fill in the end of the file
1323 while ($source_file_line_number < scalar(@source_file_lines)) {
1324 print TARGET_FILE $source_file_lines[$source_file_line_number];
1325 $source_file_line_number++;
1326 }
1327
1328 close(TARGET_FILE);
1329}
1330
1331
1332&main(@ARGV);
Note: See TracBrowser for help on using the repository browser.