source: trunk/gsdl/bin/script/translator.pl@ 4135

Last change on this file since 4135 was 4135, checked in by mdewsnip, 21 years ago

Tidy up and bug fix in page generation code.

  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 28.2 KB
Line 
1#!/usr/bin/perl -w
2
3###########################################################################
4#
5# translator.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) 1999 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 util;
37use GDBM_File;
38use CGI;
39
40
41my $translationdir;
42my $translationdb;
43my %translationdata = ();
44my $updatedb;
45my %updatedata = ();
46
47
48sub main
49{
50 # Get the name of the source (base) language
51 my $sourcelang = shift(@_);
52 # Get the name of the target language
53 my $targetlang = shift(@_);
54
55 # Check that both arguments were supplied
56 if (!$sourcelang) {
57 die "Error: You didn't supply the name of the source language!\n";
58 }
59 if (!$targetlang) {
60 die "Error: You didn't supply the name of the target language!\n";
61 }
62
63 # Casefold both language names
64 $sourcelang =~ tr/A-Z/a-z/;
65 $targetlang =~ tr/A-Z/a-z/;
66
67 # If the source language is not English, it may not be up to date
68 if ($sourcelang !~ m/english/) {
69 print STDERR "Warning: Source language is not English. You should check that" .
70 " the source language is up to date before beginning.\n";
71 }
72
73 my $gsdldir = "$ENV{'GSDLHOME'}";
74 my $macrosdir = util::filename_cat($gsdldir, "macros");
75
76 # Check that the source language macro files exist, and parse them
77 my $sourcedmname1 = &get_macrofile_name($sourcelang, "");
78 my $sourcehash1 = &parse_macrofile($macrosdir, $sourcedmname1);
79 my $sourcedmname2 = &get_macrofile_name($sourcelang, "2");
80 my $sourcehash2 = &parse_macrofile($macrosdir, $sourcedmname2);
81
82 # Make sure some macros exist to be translated
83 if (!$sourcehash1 && !$sourcehash2) {
84 die "Error: No source macro information exists.\n";
85 }
86
87 # Combine the two source hashes
88 my $sourcehash = &combine_hashes($sourcehash1, $sourcehash2);
89
90 # Check if this is a new translation process or the continuation of an old one
91 $translationdir = util::filename_cat($gsdldir, "tmp", "lang", "$sourcelang-$targetlang");
92 $translationdb = util::filename_cat($translationdir, "translation.db");
93 $updatedb = util::filename_cat($translationdir, "update.db");
94
95 if (! -e $translationdir) {
96 # Create a directory to store the data for the new translation, make world-writeable
97 my $currentmask = umask;
98 umask(0000);
99 if (! mkdir($translationdir, 0777)) {
100 umask($currentmask);
101 die "Error: Couldn't create directory $translationdir.\n";
102 }
103 umask($currentmask);
104
105 # Start a new database for the translation information
106 tie(%translationdata, "GDBM_File", $translationdb, GDBM_WRCREAT, 0640);
107
108 # Work out what the target language code should be, and store it in the database
109 my $maincfgfile = util::filename_cat($gsdldir, "etc", "main.cfg");
110 my $languagecodes = &get_language_codes();
111 my $targetcode = &get_language_code($targetlang, $maincfgfile, $languagecodes);
112 $translationdata{"*target_lang_code*"} = $targetcode;
113
114 # Start a new update database
115 tie(%updatedata, "GDBM_File", $updatedb, GDBM_WRCREAT, 0640);
116 }
117 else {
118 # This translation is a continuation of an old one, so open the database files for it
119 tie(%translationdata, "GDBM_File", $translationdb, 1, 0640);
120 tie(%updatedata, "GDBM_File", $updatedb, 1, 0640);
121 }
122
123 # Create the target language macro files if they don't exist
124 my $targetdmname1 = &get_macrofile_name($targetlang, "");
125 my $targetdmfile1 = util::filename_cat($macrosdir, $targetdmname1);
126 if (! -e $targetdmfile1) {
127 my $sourcedmfile1 = util::filename_cat($macrosdir, $sourcedmname1);
128 &create_empty_macrofile($sourcedmfile1, $targetdmfile1);
129 }
130 my $targetdmname2 = &get_macrofile_name($targetlang, "2");
131 my $targetdmfile2 = util::filename_cat($macrosdir, $targetdmname2);
132 if (! -e $targetdmfile2) {
133 my $sourcedmfile2 = util::filename_cat($macrosdir, $sourcedmname2);
134 &create_empty_macrofile($sourcedmfile2, $targetdmfile2);
135 }
136
137 # Parse the target language macro files
138 my $targethash1 = &parse_macrofile($macrosdir, $targetdmname1);
139 my $targethash2 = &parse_macrofile($macrosdir, $targetdmname2);
140
141 # Combine the two target hashes
142 my $targethash = &combine_hashes($targethash1, $targethash2);
143
144 # Determine the macros that need translating
145 my $needstranslating = &find_macros_needing_translation($sourcelang, $sourcehash,
146 $targetlang, $targethash);
147
148 # Generates HTML code to display user interface on webpage with what needs translation
149 my $targetcode = $translationdata{"*target_lang_code*"};
150 print STDERR "Target language code: $targetcode\n";
151 &generate_pages($sourcelang, $targetlang, $targetcode, $needstranslating);
152
153 # Clean up
154 untie %translationdata;
155 untie %updatedata;
156}
157
158
159sub get_macrofile_name
160{
161 my ($language, $suffix) = @_;
162
163 my $macrofilename = $language;
164
165 # Handles cases where the macro file name is different to the language name
166 $macrofilename = "port" if ($language =~ m/portuguese/);
167 $macrofilename = "indo" if ($language =~ m/indonesian/);
168
169 # Add suffix (if any) and file extension, and return
170 $macrofilename = $macrofilename . $suffix . ".dm";
171 return $macrofilename;
172}
173
174
175sub get_language_code
176{
177 my ($language, $maincfgfile, $languagecodes) = @_;
178
179 # Check if the language is in the main.cfg file
180 open(MAIN_CFG_IN, "<$maincfgfile") or die "Error: Could not open $maincfgfile.\n";
181 my $lastlangline;
182 while (<MAIN_CFG_IN>) {
183 $line = $_;
184 chomp($line);
185 # print "Line: $line\n";
186 if ($line =~ m/^Language\s+/i) {
187 my @args = split(/ +/,$line);
188 my ($lang_abbr) = ($args[1] =~ m/^shortname=(.*)$/);
189 $lang_abbr =~ tr/A-Z/a-z/;
190 my ($lang_long) = ($args[2] =~ m/^longname=(.*)$/);
191 $lang_long =~ tr/A-Z/a-z/;
192
193 # Is this the language we are translating into?
194 if ($lang_long eq $language) {
195 return $lang_abbr;
196 }
197
198 $lastlangline = $line;
199 }
200 }
201 close MAIN_CFG_IN;
202
203 # Try to find it using the ISO 639 language codes
204 my $langcode;
205 if ($languagecodes->{$language}) {
206 $langcode = $languagecodes->{$language};
207 }
208 # Otherwise we just have to make something up
209 else {
210 $langcode = &make_up_language_code($language, $languagecodes);
211 }
212
213 # Add the new language code into the main.cfg file, and make sure it is world writeable
214 my $currentmask = umask;
215 umask(0000);
216 if (! open(MAIN_CFG_OUT,">$maincfgfile.new")) {
217 umask($currentmask);
218 die "Error: Could not create $maincfgfile.new: $!\n";
219 }
220 umask($currentmask);
221
222 open MAIN_CFG_IN, "<$maincfgfile" or die "Error: Could not open $maincfgfile.\n";
223 my $inmacros = "false";
224 while (<MAIN_CFG_IN>) {
225 $line = $_;
226 chomp($line);
227 print MAIN_CFG_OUT $line;
228 if ($line =~ m/^macrofiles /) {
229 $inmacros = "true";
230 }
231 if ($inmacros eq "true" && $line !~ m/\\$/) {
232 print MAIN_CFG_OUT " \\\n";
233 print MAIN_CFG_OUT " $language" . ".dm $language" . "2.dm";
234 $inmacros = "false";
235 }
236 print MAIN_CFG_OUT "\n";
237
238 if ($line eq $lastlangline) {
239 # Change language into title case
240 my $langtitlecase = $language;
241 substr($langtitlecase, 0, 1) =~ tr/a-z/A-Z/;
242 print MAIN_CFG_OUT ("Language shortname=$langcode longname=$langtitlecase ",
243 "default_encoding=utf-8\n");
244 }
245 }
246 close MAIN_CFG_IN;
247 close MAIN_CFG_OUT;
248
249 # Delete the old main.cfg and replace it with the new one
250 unlink($maincfgfile);
251 rename("$maincfgfile.new", $maincfgfile);
252
253 return $langcode;
254}
255
256
257sub make_up_language_code
258{
259 my ($language, $languagecodes) = @_;
260
261 # !! TO FINISH !!
262 print STDERR "Making up language code...\n";
263 $langcode = $& if ($language =~ m/\w\w/);
264 $language =~ s/\A.//;
265
266 return $langcode;
267}
268
269
270sub create_empty_macrofile
271{
272 my ($sourcedmfile, $targetdmfile) = @_;
273
274 open(SOURCE_DM_FILE_IN, "<$sourcedmfile") or die "Error: Could not open file.\n";
275 open(TARGET_DM_FILE_OUT, ">$targetdmfile") or die "Error: Could not write file.\n";
276
277 # Reads in contents of macro file, line by line
278 while (<SOURCE_DM_FILE_IN>) {
279 # Check if a new package is being defined
280 if (s/^package //) {
281 $packagename = $_;
282 chomp($packagename);
283
284 # It is, so write an empty package section to the target macro file
285 print TARGET_DM_FILE_OUT "package $packagename\n";
286 print TARGET_DM_FILE_OUT "# text macros\n";
287 print TARGET_DM_FILE_OUT "# icons\n";
288 }
289 }
290
291 close SOURCE_DM_FILE_IN;
292 close TARGET_DM_FILE_OUT;
293}
294
295
296sub parse_macrofile
297{
298 my ($macrosdir, $macrofile) = @_;
299
300 # Opens macro file or returns
301 my $macropath = util::filename_cat($macrosdir, $macrofile);
302 open(IN, "<$macropath") or return;
303
304 # Initialises some local variables
305 my $currpackage;
306 my %macros = ();
307
308 # Reads in contents of macro file, line by line
309 while (<IN>) {
310 # Check if a new package is being defined
311 if (s/^package //) {
312 $currpackage = $_;
313 chomp($currpackage);
314 }
315
316 # Line contains a macro name
317 elsif (/^(_\w+_)/) {
318 # gets the name of the macro ($1 contains text matched by corresponding
319 # set of parentheses in the last matched pattern within the dynamic scope
320 # which here matches (_\w+_) )
321 my $macroname = $1;
322 my $macrotext;
323
324 # get the first line of the macro
325 $_ =~ s/^_\w+_ *//;
326 # while there is still text of the macro to go...
327 while ($_ !~ /.*\}/) {
328 # ... adds it to the macrotext variable
329 $macrotext .= $_;
330 $_ = <IN>;
331 }
332 $macrotext .= $_;
333
334 # The key consists of macro file, package name, and macro name
335 my $key = $macrofile . "::" . $currpackage . "::" . $macroname;
336 # Store the macro text in the database
337 $macros{$key} = $macrotext;
338 }
339
340 # Icon: line in format ## "sometext" ## macro ## macroname ##
341 elsif (/^\#\# .*/) {
342 my $macroname = $_;
343 my $macrotext;
344
345 #if the macro text contains a new line will run over two lines
346 unless ($macroname =~ m/^\#\# .*\#\#/) {
347 $macroname = $_;
348 chomp($macroname);
349 $_ = <IN>;
350 $macroname .= $_;
351 }
352
353 #split the image macro header on ##
354 my @names = split(/\s*\#\#\s*/, $macroname);
355 #save current contents of macroname into macrotext
356 $macrotext .= $macroname;
357 $_ = <IN>;
358 # overwrite macroname with macroname from ## ... ## ... ## HERE ###
359 $macroname = $names[(scalar @names) - 1];
360
361 # read in the rest of the text associated with the image macro
362 while ($_ !~ /^\s+/) {
363 $macrotext .= $_;
364 $_ = <IN>;
365 }
366
367 # key to the hash and the database
368 my $key = $macrofile . "::" . $currpackage . "::" . $macroname;
369 # print "Icon, key: $key\n text: $macrotext\n";
370 # hashes macroname and macrotext
371 $macros{$key} = $macrotext;
372 }
373 }
374 close IN;
375
376 return (\%macros);
377}
378
379
380# Combines two existing hashes of the same format together
381sub combine_hashes
382{
383 my ($hash1, $hash2) = @_;
384 my %combined = ();
385
386 foreach $key (sort (keys %$hash1)) {
387 $combined{$key} = $hash1->{$key};
388 }
389 foreach $key (sort (keys %$hash2)) {
390 $combined{$key} = $hash2->{$key};
391 }
392
393 return (\%combined);
394}
395
396
397sub find_macros_needing_translation
398{
399 my ($sourcelang, $sourcehash, $targetlang, $targethash) = @_;
400
401 # Find source macros whose text has changed
402 foreach $sourcekey (sort keys(%$sourcehash)) {
403 if ($translationdata{$sourcekey}) {
404 if ($translationdata{$sourcekey} ne $sourcehash->{$sourcekey}) {
405 # print "Source macro $sourcekey has changed value.\n";
406 my $targetkey = &get_macroname_equivalent($sourcelang, $targetlang,
407 $sourcekey);
408 if ($targethash->{$targetkey}) {
409 $updatedata{$targetkey} = $targethash->{$targetkey};
410 }
411 else {
412 $updatedata{$targetkey} = "";
413 }
414 }
415 }
416 }
417
418 # Clear out the database
419 my $targetcode = $translationdata{"*target_lang_code*"};
420 untie %translationdata;
421 unlink($translationdb);
422 %translationdata = ();
423 tie(%translationdata, "GDBM_File", $translationdb, GDBM_WRCREAT, 0640);
424 $translationdata{"*target_lang_code*"} = $targetcode;
425
426 # Re-add source and target macros
427 foreach $sourcekey (sort keys(%$sourcehash)) {
428 $translationdata{$sourcekey} = $sourcehash->{$sourcekey};
429 }
430 foreach $targetkey (sort keys(%$targethash)) {
431 $translationdata{$targetkey} = $targethash->{$targetkey};
432 }
433
434 my %needstranslating = ();
435
436 # Macros that need translating are those that are in the source language macro file
437 # but no translation exists in the translation database...
438 foreach $sourcekey (sort keys(%$sourcehash)) {
439 my $targetkey = &get_macroname_equivalent($sourcelang, $targetlang, $sourcekey);
440 if (!$translationdata{$targetkey}) {
441 # print "Macro $sourcekey needs translating.\n";
442 # print "Text to translate: $sourcehash->{$sourcekey}\n";
443 $needstranslating{$sourcekey}[0] = $sourcehash->{$sourcekey};
444 $needstranslating{$sourcekey}[1] = "";
445 }
446 }
447
448 # ...and those in the list of macros to update
449 foreach $targetkey (sort keys(%updatedata)) {
450 my $sourcekey = &get_macroname_equivalent($targetlang, $sourcelang, $targetkey);
451 $needstranslating{$sourcekey}[0] = $sourcehash->{$sourcekey};
452 $needstranslating{$sourcekey}[1] = $updatedata{$targetkey};
453 }
454
455 return (\%needstranslating);
456}
457
458
459sub get_macroname_equivalent
460{
461 my ($languageA, $languageB, $languageAkey) = @_;
462
463 my $macrofile = $languageAkey;
464 $macrofile =~ s/^([^:]+)::(.*)/$1/;
465 my $key = $languageAkey;
466 $key =~ s/^([^:])+::(.*)/$2/;
467
468 my $languageBkey;
469 if ($macrofile eq &get_macrofile_name($languageA, "")) {
470 $languageBkey = &get_macrofile_name($languageB, "") . "::" . $key;
471 }
472 if ($macrofile eq &get_macrofile_name($languageA, "2")) {
473 $languageBkey = &get_macrofile_name($languageB, "2") . "::" . $key;
474 }
475
476 return ($languageBkey);
477}
478
479
480# generates whole website by seperating hash of differences into groups
481# of at most 15 macros and then generating a page from each group
482sub generate_pages
483{
484 my ($sourcelang, $targetlang, $targetcode, $needstranslating) = @_;
485
486 my %pagehash = ();
487
488 $pageno = 1;
489 $keysperpage = 0;
490 $limit = 15;
491
492 # goes through hash of differences between base language and translation
493 # sorted first by whether it is from the core or auxiliary macrofile then
494 # alphabetically by macroname
495 foreach $sourcekey (sort keys(%$needstranslating)) {
496 #nested hash. The pagehash contains a hash of all of the translation pages.
497 #Then each page is itself contains a hash of all the macros on that page, where
498 #each macro is associated with some macrotext and whether it was from the core
499 #or auxiliary macrofile
500 $pagehash->{$pageno}->{$sourcekey} = $needstranslating->{$sourcekey};
501 $keysperpage++;
502
503 # If have enough keys to generate a page with
504 if ($keysperpage == $limit) {
505 #opens a file to write the HTML code to for current page
506 my $transpagefile = util::filename_cat($translationdir, $pageno . ".lang");
507 open HTMLFILE, ">$transpagefile";
508
509 #passes hash of keys for current page and filehandle, returns CGI data
510 &generate_form($sourcelang, $targetlang, $targetcode,
511 $pagehash->{$pageno}, \*HTMLFILE);
512 close HTMLFILE;
513 $pageno++;
514
515 #resets key counting variable
516 $keysperpage = 0;
517 $limit = 15;
518 }
519 }
520
521 # if you exit the loop with keys still to write
522 if ($keysperpage != 0) {
523 # writes out the remaining keys, same format as above
524 my $transpagefile = util::filename_cat($translationdir, $pageno . ".lang");
525 open HTMLFILE, ">$transpagefile";
526 &generate_form($sourcelang, $targetlang, $targetcode, $pagehash->{$pageno}, \*HTMLFILE);
527 close HTMLFILE;
528 $pageno++;
529 }
530
531 # Write the number of pages to a file for use by the receptionist
532 my $numpagesfile = util::filename_cat($translationdir, "numpages.log");
533 open NUMPAGESLOG, ">$numpagesfile" or die "Error: Could not write $numpagesfile.\n";
534 print NUMPAGESLOG ($pageno - 1);
535 close NUMPAGESLOG;
536
537 # Write thankyou page for language translator once translation is complete
538 my $thankyoufile = util::filename_cat($translationdir, "thankyou.lang");
539 open THANKYOU, ">$thankyoufile" or die "Error: Could not write $thankyoufile.\n";
540 print THANKYOU ("<center> _textthanks_ $targetlang _texttrans_ ",
541 "<br> _textviewtranslation_ ",
542 "<a href=\"_gwcgi_?a=p&p=home&l=$targetcode\">_texthere_</a>.",
543 # "_textgetdmfiles_ ",
544 # "<a href=\"_httpprefix_/gsdl/macros/$targetlang" . ".dm\">_texthere_</a>",
545 # " &amp; ",
546 # "<a href=\"_httpprefix_/gsdl/macros/$targetlang" . "2.dm\">_texthere_</a>.",
547 "<p></center>\n");
548 close THANKYOU;
549}
550
551
552sub generate_form
553{
554 my $sourcelang = shift(@_);
555 my $targetlang = shift(@_);
556 my $targetcode = shift(@_);
557 my $formhash = shift(@_);
558 my $fh = shift(@_);
559
560 # common gateway interface for writing the stuff to the web
561 my $query = new CGI;
562 my $keynamecount;
563
564 $first = "true";
565 foreach $key (sort (keys(%$formhash))) {
566
567 my $text = $formhash->{$key}[0];
568 my $default = $formhash->{$key}[1];
569
570 # whole lot of formatting on strings
571 # escape all the '_' with '\' so that Greenstone doesn't substitute
572 # the macro names for the contents of the macro itself
573 my $keyname = $key;
574 $keyname =~ s/_/\\_/g;
575
576 $text =~ s/_/\\_/g;
577 $text =~ s/(\[l=.*\])//;
578 $default =~ s/_/\\_/g;
579 $default =~ s/(\[l=.*\] )//;
580
581 # must take care of image macros single and multiple line ones
582 $text =~ s/(\<br\>\#\#.*\#\#\s*\<br\>).*/$1/g;
583 $default =~ s/(\<br\>\#\#.*\#\#\s*\<br\>).*/$1/g;
584
585 # format the text for displaying in the browser
586 $text =~ s/[\{\}]//g unless($text =~ m/\#\# /);
587 $default =~ s/[\{\}]//g unless($text =~ m/\#\# /);
588
589 $text =~ s/(\A\n)//;
590 $text =~ s/(\n\Z)//;
591 $default =~ s/(\A\n)//;
592 $default =~ s/(\n\Z)//;
593
594 # $keynamecount = 1;
595
596 #tells whether is a core or auxiliary macro
597 my $priority = &core_or_auxiliary_macro($sourcelang, $keyname);
598
599 if ($first eq "true") {
600 print $fh ($query->hidden(-name=>"tlng",-default=>"$targetlang"),
601 $query->hidden(-name=>"bl",-default=>"$sourcelang"));
602
603 # If it is a core macro, table header displays core
604 if ($priority eq "1") {
605 print $fh "</center><img src=\"_httpimg_/core.gif\">";
606
607 #shows that have seen first macro of core type
608 $first = "been";
609 }
610
611 # If it is an auxiliary macro, table header displays auxiliary
612 if ($priority eq "2") {
613 print $fh "</center><img src=\"_httpimg_/auxiliary.gif\">";
614 $first = "false";
615 }
616
617 print $fh ("<table cellpadding=\"10\">\n<tr>",
618 "<td><strong><center>". uc ($sourcelang)."</center></strong></td>\n",
619 "<td><strong><center>". uc ($targetlang)."</center></strong></td>\n",
620 "</tr>\n");
621 }
622
623 # If this is the first auxiliary macro, but not the first macro, finish the
624 # current table and start a new auxiliary table underneath
625 if($priority eq "2" and $first eq "been") {
626 print $fh ("</table><br></center><img src=\"_httpimg_/auxiliary.gif\">",
627 "<table cellpadding=\"10\">\n<tr>",
628 "<td><strong><center>". uc ($sourcelang)."</strong></center></td>\n",
629 "<td><strong><center>". uc ($targetlang)."</strong></center></td>\n",
630 "</tr>\n");
631 $first = "false";
632 }
633
634 # so that when it is an image only get the text to translate not coding stuff aswell
635 if ($text =~ m/\#\# (^|.)*/) {
636 # print STDERR "\nIcon -- Key: $keyname\nText: $text\n"; # Default: $default\n";
637 if ($& =~ m/".*"/) {
638 #prints to the file two text fields, the left one contains the base language
639 #macro text, the right contains the translation language macro text if any exists
640 my $icontext = $&;
641 $icontext =~ s/"(.*)"/$1/;
642 # print "Text to translate: $icontext\n";
643
644 my $remainder = $text;
645 $remainder =~ s/^\#\# ([^\#]*)//;
646 # print "Remainder: $remainder\n";
647
648 $rows = 1;
649
650 my $textbox1;
651 if (1) {
652 $textbox1 = "<textarea name=\"whocaresh\" rows=\"$rows\" cols=\"50\" readonly=\"1\">";
653 $textbox1 .= "$icontext</textarea>\n";
654 }
655 else {
656 $textbox1 = $query->textfield(-name=>"whocares", -default=>"$icontext",
657 -size=>50, -readonly=>1);
658 }
659 print $fh ("<tr><td align=center>", $textbox1, "</td><td align=center>");
660 # $query->hidden(-name=>"$keyname" . "$keynamecount",-default=>"$`"));
661 # $keynamecount++;
662
663 my $textbox2;
664 if (1) {
665 $textbox2 = "<textarea name=\"$keyname\" rows=\"$rows\" cols=\"50\">";
666 $textbox2 .= "$default</textarea><br>\n";
667 }
668 else {
669 $textbox2 = $query->textfield(-name=>"$keyname", -default=>"$default",
670 -size=>50);
671 }
672 print $fh $textbox2;
673
674 print $fh $query->hidden(-name=>"$keyname" . "::icontext",
675 -default=>"$remainder");
676 print $fh "</td></tr>\n";
677
678 # $keynamecount++;
679 # print $fh ($query->hidden(-name=>"$keyname" . "$keynamecount",-default=>"$'"),
680 # "</td></tr>\n");
681 }
682 }
683 # Text macro
684 elsif ($text =~ m/\S+/) {
685 $text =~ s/\s+/ /g;
686
687 my @words = split(/ /, $text);
688 my $words = scalar(@words);
689 my $rows = sprintf("%.0f", $words/5);
690 print $fh ("<tr><td align=center>\n");
691 #determines how many rows of text are required to display the base language
692 #macro text then use this value to determine whether we should use a text area
693 #or a text field
694
695 # Experimenting with textfield and text area
696 # for now use exclusively textareas.
697
698 # if ($rows >= 0) {
699 if (1) {
700 $rows = 1 if ($rows < 1);
701
702 #prints to the file two text areas, the left one contains the base language
703 #macro text, the right contains the translation language macro text if any exists
704
705 $text =~ s/<p>/<p>\n/g;
706 $text =~ s/<br>/<br>\n/g;
707 $text =~ s/<\/td>/<\/td>\n/g;
708
709 print $fh ("<textarea name=\"whocaresh\" rows=\"$rows\" cols=\"50\" readonly=\"1\">",
710 "$text</textarea>\n",
711 "</td><td align=center>\n",
712 "<textarea name=\"$keyname\" rows=\"$rows\" cols=\"50\">",
713 "$default</textarea><br></td></tr>\n");
714 }
715 else {
716 #prints to the file two text fields, the left one contains the base language
717 #macro text, the right contains the translation language macro text if any exists
718 print $fh ($query->textfield(-name=>"whocares",
719 -default=>"$text",
720 -size=>50,
721 -readonly=>1),
722 "</td><td align=center>\n",
723 $query->textfield(-name=>"$keyname" . "$keynamecount",
724 -default=>"$default",
725 -size=>50),
726 "<br></td></tr>\n");
727 }
728 }
729 }
730
731 #finishes table and adds a SUBMIT CHANGES option on the end
732 print $fh ("</table><br><center>\n",
733 "<table><tr><td align=left width=\"50%\">",
734 $query->reset("RESET FORM"),
735 "</td><td align=right width=\"50%\">",
736 $query->submit($pageno, "_textsubmit_"),
737 "</td></tr><tr><td width=\"50%\"></td><td align=right width=\"50%\">",
738 "<br> _textsubmittext_ <br> _textviewtranslation_ ",
739 "<a href=\"_gwcgi_?a=p&p=home&l=$targetcode\">_texthere_</a>.",
740 # "_textgetdmfiles_ ",
741 # "<a href=\"_httpprefix_/gsdl/macros/$targetlang" . ".dm\">_texthere_</a>",
742 # " &amp; ",
743 # "<a href=\"_httpprefix_/gsdl/macros/$targetlang" . "2.dm\">_texthere_</a>.",
744 "</td></tr></table>");
745}
746
747
748sub source_or_target_macro
749{
750 my ($sourcelang, $targetlang, $key) = @_;
751
752 my $macrofile = $key;
753 $macrofile =~ s/^([^:]+)::(.*)/$1/;
754
755 if ($macrofile eq ($sourcelang . ".dm") || $macrofile eq ($sourcelang . "2.dm")) {
756 return "1"; # Source macro
757 }
758 else {
759 return "2"; # Target macro
760 }
761}
762
763
764sub core_or_auxiliary_macro
765{
766 my ($sourcelang, $sourcekey) = @_;
767
768 my $macrofile = $sourcekey;
769 $macrofile =~ s/^([^:]+)::(.*)/$1/;
770
771 if ($macrofile eq ($sourcelang . ".dm")) {
772 return "1"; # Core macro
773 }
774 if ($macrofile eq ($sourcelang . "2.dm")) {
775 return "2"; # Auxiliary macro
776 }
777}
778
779
780sub display_hash
781{
782 my ($hash) = @_;
783
784 foreach $key (sort (keys %$hash)) {
785 print $key . "\n";
786 print $hash->{$key} . "\n";
787 }
788}
789
790
791&main(@ARGV);
792
793
794sub get_language_codes
795{
796 %languagecodes = (
797 'abkhazian', 'ab',
798 'afar', 'aa',
799 'afrikaans', 'af',
800 'albanian', 'sq',
801 'amharic', 'am',
802 'arabic', 'ar',
803 'armenian', 'hy',
804 'assamese', 'as',
805 'aymara', 'ay',
806 'azerbaijani', 'az',
807 'bashkir', 'ba',
808 'basque', 'eu',
809 'bengali', 'bn',
810 'bangla', 'bn',
811 'bhutani', 'dz',
812 'bihari', 'bh',
813 'bislama', 'bi',
814 'breton', 'br',
815 'bulgarian', 'bg',
816 'burmese', 'my',
817 'byelorussian', 'be',
818 'belarusian', 'be',
819 'cambodian', 'km',
820 'catalan', 'ca',
821 'chinese', 'zh',
822 'corsican', 'co',
823 'croatian', 'hr',
824 'czech', 'cs',
825 'danish', 'da',
826 'dutch', 'nl',
827 'english', 'en',
828 'esperanto', 'eo',
829 'estonian', 'et',
830 'faeroese', 'fo',
831 'farsi', 'fa',
832 'fiji', 'fj',
833 'finnish', 'fi',
834 'french', 'fr',
835 'frisian', 'fy',
836 'galician', 'gl',
837 'gaelic (scottish)', 'gd',
838 'gaelic (manx)', 'gv',
839 'georgian', 'ka',
840 'german', 'de',
841 'greek', 'el',
842 'greenlandic', 'kl',
843 'guarani', 'gn',
844 'gujarati', 'gu',
845 'hausa', 'ha',
846 'hebrew', 'iw',
847 'hindi', 'hi',
848 'hungarian', 'hu',
849 'icelandic', 'is',
850 'indonesian', 'id', # Should be 'in' for backward compatibility
851 'interlingua', 'ia',
852 'interlingue', 'ie',
853 'inuktitut', 'iu',
854 'inupiak', 'ik',
855 'irish', 'ga',
856 'italian', 'it',
857 'japanese', 'ja',
858 'javanese', 'jv',
859 'kannada', 'kn',
860 'kashmiri', 'ks',
861 'kazakh', 'kk',
862 'kinyarwanda', 'rw',
863 'ruanda', 'rw',
864 'kirghiz', 'ky',
865 'kirundi', 'rn',
866 'rundi', 'rn',
867 'korean', 'ko',
868 'kurdish', 'ku',
869 'laothian', 'lo',
870 'latin', 'la',
871 'latvian', 'lv',
872 'lettish', 'lv',
873 'limburgish', 'li',
874 'limburger', 'li',
875 'lingala', 'ln',
876 'lithuanian', 'lt',
877 'macedonian', 'mk',
878 'malagasy', 'mg',
879 'malay', 'ms',
880 'malayalam', 'ml',
881 'maltese', 'mt',
882 'maori', 'mi',
883 'marathi', 'mr',
884 'moldavian', 'mo',
885 'mongolian', 'mn',
886 'nauru', 'na',
887 'nepali', 'ne',
888 'norwegian', 'no',
889 'occitan', 'oc',
890 'oriya', 'or',
891 'oromo', 'om',
892 'afan', 'om',
893 'galla', 'om',
894 'pashto', 'ps',
895 'pushto', 'ps',
896 'polish', 'pl',
897 'portuguese', 'pt',
898 'punjabi', 'pa',
899 'quechua', 'qu',
900 'rhaeto-romance', 'rm',
901 'romanian', 'ro',
902 'russian', 'ru',
903 'samoan', 'sm',
904 'sangro', 'sg',
905 'sanskrit', 'sa',
906 'serbian', 'sr',
907 'serbo-croatian', 'sh',
908 'sesotho', 'st',
909 'setswana', 'tn',
910 'shona', 'sn',
911 'sindhi', 'sd',
912 'sinhalese', 'si',
913 'siswati', 'ss',
914 'slovak', 'sk',
915 'slovenian', 'sl',
916 'somali', 'so',
917 'spanish', 'es',
918 'sundanese', 'su',
919 'swahili', 'sw',
920 'kiswahili', 'sw',
921 'swedish', 'sv',
922 'tagalog', 'tl',
923 'tajik', 'tg',
924 'tamil', 'ta',
925 'tatar', 'tt',
926 'telugu', 'te',
927 'thai', 'th',
928 'tibetan', 'bo',
929 'tigrinya', 'ti',
930 'tonga', 'to',
931 'tsonga', 'ts',
932 'turkish', 'tr',
933 'turkmen', 'tk',
934 'twi', 'tw',
935 'uighur', 'ug',
936 'ukrainian', 'uk',
937 'urdu', 'ur',
938 'uzbek', 'uz',
939 'vietnamese', 'vi',
940 'volapÃŒk', 'vo',
941 'welsh', 'cy',
942 'wolof', 'wo',
943 'xhosa', 'xh',
944 'yiddish', 'ji',
945 'yoruba', 'yo',
946 'zulu', 'zu'
947 );
948
949 return (\%languagecodes);
950}
Note: See TracBrowser for help on using the repository browser.