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

Last change on this file since 10126 was 10126, checked in by mdewsnip, 19 years ago

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