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

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

Changed main.cfg to be rewritten as world-writeable.

  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 28.3 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 @pages = ();
489 $pageno = 1;
490 $keysperpage = 0;
491 $limit = 15;
492
493 # goes through hash of differences between base language and translation
494 # sorted first by whether it is from the core or auxiliary macrofile then
495 # alphabetically by macroname
496 foreach $sourcekey (sort keys(%$needstranslating)) {
497 #nested hash. The pagehash contains a hash of all of the translation pages.
498 #Then each page is itself contains a hash of all the macros on that page, where
499 #each macro is associated with some macrotext and whether it was from the core
500 #or auxiliary macrofile
501 $pagehash->{$pageno}->{$sourcekey} = $needstranslating->{$sourcekey};
502 $keysperpage++;
503
504 # If have enough keys to generate a page with
505 if ($keysperpage == $limit) {
506 #opens a file to write the HTML code to for current page
507 my $transpagefile = util::filename_cat($translationdir, $pageno . ".lang");
508 open HTMLFILE, ">$transpagefile";
509
510 #passes hash of keys for current page and filehandle, returns CGI data
511 &generate_form($sourcelang, $targetlang, $targetcode,
512 $pagehash->{$pageno}, \*HTMLFILE);
513 close HTMLFILE;
514
515 #push the page number onto the array of pages
516 push(@pages, $pageno);
517 $pageno++;
518
519 #resets key counting variable
520 $keysperpage = 0;
521 $limit = 15;
522 }
523 }
524
525 # if you exit the loop with keys still to write
526 if ($keysperpage != 0) {
527 # writes out the remaining keys, same format as above
528 my $transpagefile = util::filename_cat($translationdir, $pageno . ".lang");
529 open HTMLFILE, ">$transpagefile";
530 &generate_form($sourcelang, $targetlang, $targetcode, $pagehash->{$pageno}, \*HTMLFILE);
531 close HTMLFILE;
532 push(@pages, $pageno);
533 }
534
535 # Write the number of pages to a file for use by the receptionist
536 my $numpagesfile = util::filename_cat($translationdir, "numpages.log");
537 open NUMPAGESLOG, ">$numpagesfile" or die "Error: Could not write $numpagesfile.\n";
538 print NUMPAGESLOG ($pageno - 1);
539 close NUMPAGESLOG;
540
541 # Write thankyou page for language translator once translation is complete
542 my $thankyoufile = util::filename_cat($translationdir, "thankyou.lang");
543 open THANKYOU, ">$thankyoufile" or die "Error: Could not write $thankyoufile.\n";
544 print THANKYOU ("<center> _textthanks_ $targetlang _texttrans_ ",
545 "<br> _textviewtranslation_ ",
546 "<a href=\"_gwcgi_?a=p&p=home&l=$targetcode\">_texthere_</a>.",
547 # "_textgetdmfiles_ ",
548 # "<a href=\"_httpprefix_/gsdl/macros/$targetlang" . ".dm\">_texthere_</a>",
549 # " &amp; ",
550 # "<a href=\"_httpprefix_/gsdl/macros/$targetlang" . "2.dm\">_texthere_</a>.",
551 "<p></center>\n");
552 close THANKYOU;
553}
554
555
556sub generate_form
557{
558 my $sourcelang = shift(@_);
559 my $targetlang = shift(@_);
560 my $targetcode = shift(@_);
561 my $formhash = shift(@_);
562 my $fh = shift(@_);
563
564 # common gateway interface for writing the stuff to the web
565 my $query = new CGI;
566 my $keynamecount;
567
568 $first = "true";
569 foreach $key (sort (keys(%$formhash))) {
570
571 my $text = $formhash->{$key}[0];
572 my $default = $formhash->{$key}[1];
573
574 # whole lot of formatting on strings
575 # escape all the '_' with '\' so that Greenstone doesn't substitute
576 # the macro names for the contents of the macro itself
577 my $keyname = $key;
578 $keyname =~ s/_/\\_/g;
579
580 $text =~ s/_/\\_/g;
581 $text =~ s/(\[l=.*\])//;
582 $default =~ s/_/\\_/g;
583 $default =~ s/(\[l=.*\] )//;
584
585 # must take care of image macros single and multiple line ones
586 $text =~ s/(\<br\>\#\#.*\#\#\s*\<br\>).*/$1/g;
587 $default =~ s/(\<br\>\#\#.*\#\#\s*\<br\>).*/$1/g;
588
589 # format the text for displaying in the browser
590 $text =~ s/[\{\}]//g unless($text =~ m/\#\# /);
591 $default =~ s/[\{\}]//g unless($text =~ m/\#\# /);
592
593 $text =~ s/(\A\n)//;
594 $text =~ s/(\n\Z)//;
595 $default =~ s/(\A\n)//;
596 $default =~ s/(\n\Z)//;
597
598 # $keynamecount = 1;
599
600 #tells whether is a core or auxiliary macro
601 my $priority = &core_or_auxiliary_macro($sourcelang, $keyname);
602
603 if ($first eq "true") {
604 print $fh ($query->hidden(-name=>"tlng",-default=>"$targetlang"),
605 $query->hidden(-name=>"bl",-default=>"$sourcelang"));
606
607 # If it is a core macro, table header displays core
608 if ($priority eq "1") {
609 print $fh "</center><img src=\"_httpimg_/core.gif\">";
610
611 #shows that have seen first macro of core type
612 $first = "been";
613 }
614
615 # If it is an auxiliary macro, table header displays auxiliary
616 if ($priority eq "2") {
617 print $fh "</center><img src=\"_httpimg_/auxiliary.gif\">";
618 $first = "false";
619 }
620
621 print $fh ("<table cellpadding=\"10\">\n<tr>",
622 "<td><strong><center>". uc ($sourcelang)."</center></strong></td>\n",
623 "<td><strong><center>". uc ($targetlang)."</center></strong></td>\n",
624 "</tr>\n");
625 }
626
627 # If this is the first auxiliary macro, but not the first macro, finish the
628 # current table and start a new auxiliary table underneath
629 if($priority eq "2" and $first eq "been") {
630 print $fh ("</table><br></center><img src=\"_httpimg_/auxiliary.gif\">",
631 "<table cellpadding=\"10\">\n<tr>",
632 "<td><strong><center>". uc ($sourcelang)."</strong></center></td>\n",
633 "<td><strong><center>". uc ($targetlang)."</strong></center></td>\n",
634 "</tr>\n");
635 $first = "false";
636 }
637
638 # so that when it is an image only get the text to translate not coding stuff aswell
639 if ($text =~ m/\#\# (^|.)*/) {
640 # print STDERR "\nIcon -- Key: $keyname\nText: $text\n"; # Default: $default\n";
641 if ($& =~ m/".*"/) {
642 #prints to the file two text fields, the left one contains the base language
643 #macro text, the right contains the translation language macro text if any exists
644 my $icontext = $&;
645 $icontext =~ s/"(.*)"/$1/;
646 # print "Text to translate: $icontext\n";
647
648 my $remainder = $text;
649 $remainder =~ s/^\#\# ([^\#]*)//;
650 # print "Remainder: $remainder\n";
651
652 $rows = 1;
653
654 my $textbox1;
655 if (1) {
656 $textbox1 = "<textarea name=\"whocaresh\" rows=\"$rows\" cols=\"50\" readonly=\"1\">";
657 $textbox1 .= "$icontext</textarea>\n";
658 }
659 else {
660 $textbox1 = $query->textfield(-name=>"whocares", -default=>"$icontext",
661 -size=>50, -readonly=>1);
662 }
663 print $fh ("<tr><td align=center>", $textbox1, "</td><td align=center>");
664 # $query->hidden(-name=>"$keyname" . "$keynamecount",-default=>"$`"));
665 # $keynamecount++;
666
667 my $textbox2;
668 if (1) {
669 $textbox2 = "<textarea name=\"$keyname\" rows=\"$rows\" cols=\"50\">";
670 $textbox2 .= "$default</textarea><br>\n";
671 }
672 else {
673 $textbox2 = $query->textfield(-name=>"$keyname", -default=>"$default",
674 -size=>50);
675 }
676 print $fh $textbox2;
677
678 print $fh $query->hidden(-name=>"$keyname" . "::icontext",
679 -default=>"$remainder");
680 print $fh "</td></tr>\n";
681
682 # $keynamecount++;
683 # print $fh ($query->hidden(-name=>"$keyname" . "$keynamecount",-default=>"$'"),
684 # "</td></tr>\n");
685 }
686 }
687 # Text macro
688 elsif ($text =~ m/\S+/) {
689 $text =~ s/\s+/ /g;
690
691 my @words = split(/ /, $text);
692 my $words = scalar(@words);
693 my $rows = sprintf("%.0f", $words/5);
694 print $fh ("<tr><td align=center>\n");
695 #determines how many rows of text are required to display the base language
696 #macro text then use this value to determine whether we should use a text area
697 #or a text field
698
699 # Experimenting with textfield and text area
700 # for now use exclusively textareas.
701
702 # if ($rows >= 0) {
703 if (1) {
704 $rows = 1 if ($rows < 1);
705
706 #prints to the file two text areas, the left one contains the base language
707 #macro text, the right contains the translation language macro text if any exists
708
709 $text =~ s/<p>/<p>\n/g;
710 $text =~ s/<br>/<br>\n/g;
711 $text =~ s/<\/td>/<\/td>\n/g;
712
713 print $fh ("<textarea name=\"whocaresh\" rows=\"$rows\" cols=\"50\" readonly=\"1\">",
714 "$text</textarea>\n",
715 "</td><td align=center>\n",
716 "<textarea name=\"$keyname\" rows=\"$rows\" cols=\"50\">",
717 "$default</textarea><br></td></tr>\n");
718 }
719 else {
720 #prints to the file two text fields, the left one contains the base language
721 #macro text, the right contains the translation language macro text if any exists
722 print $fh ($query->textfield(-name=>"whocares",
723 -default=>"$text",
724 -size=>50,
725 -readonly=>1),
726 "</td><td align=center>\n",
727 $query->textfield(-name=>"$keyname" . "$keynamecount",
728 -default=>"$default",
729 -size=>50),
730 "<br></td></tr>\n");
731 }
732 }
733 }
734
735 #finishes table and adds a SUBMIT CHANGES option on the end
736 print $fh ("</table><br><center>\n",
737 "<table><tr><td align=left width=\"50%\">",
738 $query->reset("RESET FORM"),
739 "</td><td align=right width=\"50%\">",
740 $query->submit($pageno, "_textsubmit_"),
741 "</td></tr><tr><td width=\"50%\"></td><td align=right width=\"50%\">",
742 "<br> _textsubmittext_ <br> _textviewtranslation_ ",
743 "<a href=\"_gwcgi_?a=p&p=home&l=$targetcode\">_texthere_</a>.",
744 # "_textgetdmfiles_ ",
745 # "<a href=\"_httpprefix_/gsdl/macros/$targetlang" . ".dm\">_texthere_</a>",
746 # " &amp; ",
747 # "<a href=\"_httpprefix_/gsdl/macros/$targetlang" . "2.dm\">_texthere_</a>.",
748 "</td></tr></table>");
749}
750
751
752sub source_or_target_macro
753{
754 my ($sourcelang, $targetlang, $key) = @_;
755
756 my $macrofile = $key;
757 $macrofile =~ s/^([^:]+)::(.*)/$1/;
758
759 if ($macrofile eq ($sourcelang . ".dm") || $macrofile eq ($sourcelang . "2.dm")) {
760 return "1"; # Source macro
761 }
762 else {
763 return "2"; # Target macro
764 }
765}
766
767
768sub core_or_auxiliary_macro
769{
770 my ($sourcelang, $sourcekey) = @_;
771
772 my $macrofile = $sourcekey;
773 $macrofile =~ s/^([^:]+)::(.*)/$1/;
774
775 if ($macrofile eq ($sourcelang . ".dm")) {
776 return "1"; # Core macro
777 }
778 if ($macrofile eq ($sourcelang . "2.dm")) {
779 return "2"; # Auxiliary macro
780 }
781}
782
783
784sub display_hash
785{
786 my ($hash) = @_;
787
788 foreach $key (sort (keys %$hash)) {
789 print $key . "\n";
790 print $hash->{$key} . "\n";
791 }
792}
793
794
795&main(@ARGV);
796
797
798sub get_language_codes
799{
800 %languagecodes = (
801 'abkhazian', 'ab',
802 'afar', 'aa',
803 'afrikaans', 'af',
804 'albanian', 'sq',
805 'amharic', 'am',
806 'arabic', 'ar',
807 'armenian', 'hy',
808 'assamese', 'as',
809 'aymara', 'ay',
810 'azerbaijani', 'az',
811 'bashkir', 'ba',
812 'basque', 'eu',
813 'bengali', 'bn',
814 'bangla', 'bn',
815 'bhutani', 'dz',
816 'bihari', 'bh',
817 'bislama', 'bi',
818 'breton', 'br',
819 'bulgarian', 'bg',
820 'burmese', 'my',
821 'byelorussian', 'be',
822 'belarusian', 'be',
823 'cambodian', 'km',
824 'catalan', 'ca',
825 'chinese', 'zh',
826 'corsican', 'co',
827 'croatian', 'hr',
828 'czech', 'cs',
829 'danish', 'da',
830 'dutch', 'nl',
831 'english', 'en',
832 'esperanto', 'eo',
833 'estonian', 'et',
834 'faeroese', 'fo',
835 'farsi', 'fa',
836 'fiji', 'fj',
837 'finnish', 'fi',
838 'french', 'fr',
839 'frisian', 'fy',
840 'galician', 'gl',
841 'gaelic (scottish)', 'gd',
842 'gaelic (manx)', 'gv',
843 'georgian', 'ka',
844 'german', 'de',
845 'greek', 'el',
846 'greenlandic', 'kl',
847 'guarani', 'gn',
848 'gujarati', 'gu',
849 'hausa', 'ha',
850 'hebrew', 'iw',
851 'hindi', 'hi',
852 'hungarian', 'hu',
853 'icelandic', 'is',
854 'indonesian', 'id', # Should be 'in' for backward compatibility
855 'interlingua', 'ia',
856 'interlingue', 'ie',
857 'inuktitut', 'iu',
858 'inupiak', 'ik',
859 'irish', 'ga',
860 'italian', 'it',
861 'japanese', 'ja',
862 'javanese', 'jv',
863 'kannada', 'kn',
864 'kashmiri', 'ks',
865 'kazakh', 'kk',
866 'kinyarwanda', 'rw',
867 'ruanda', 'rw',
868 'kirghiz', 'ky',
869 'kirundi', 'rn',
870 'rundi', 'rn',
871 'korean', 'ko',
872 'kurdish', 'ku',
873 'laothian', 'lo',
874 'latin', 'la',
875 'latvian', 'lv',
876 'lettish', 'lv',
877 'limburgish', 'li',
878 'limburger', 'li',
879 'lingala', 'ln',
880 'lithuanian', 'lt',
881 'macedonian', 'mk',
882 'malagasy', 'mg',
883 'malay', 'ms',
884 'malayalam', 'ml',
885 'maltese', 'mt',
886 'maori', 'mi',
887 'marathi', 'mr',
888 'moldavian', 'mo',
889 'mongolian', 'mn',
890 'nauru', 'na',
891 'nepali', 'ne',
892 'norwegian', 'no',
893 'occitan', 'oc',
894 'oriya', 'or',
895 'oromo', 'om',
896 'afan', 'om',
897 'galla', 'om',
898 'pashto', 'ps',
899 'pushto', 'ps',
900 'polish', 'pl',
901 'portuguese', 'pt',
902 'punjabi', 'pa',
903 'quechua', 'qu',
904 'rhaeto-romance', 'rm',
905 'romanian', 'ro',
906 'russian', 'ru',
907 'samoan', 'sm',
908 'sangro', 'sg',
909 'sanskrit', 'sa',
910 'serbian', 'sr',
911 'serbo-croatian', 'sh',
912 'sesotho', 'st',
913 'setswana', 'tn',
914 'shona', 'sn',
915 'sindhi', 'sd',
916 'sinhalese', 'si',
917 'siswati', 'ss',
918 'slovak', 'sk',
919 'slovenian', 'sl',
920 'somali', 'so',
921 'spanish', 'es',
922 'sundanese', 'su',
923 'swahili', 'sw',
924 'kiswahili', 'sw',
925 'swedish', 'sv',
926 'tagalog', 'tl',
927 'tajik', 'tg',
928 'tamil', 'ta',
929 'tatar', 'tt',
930 'telugu', 'te',
931 'thai', 'th',
932 'tibetan', 'bo',
933 'tigrinya', 'ti',
934 'tonga', 'to',
935 'tsonga', 'ts',
936 'turkish', 'tr',
937 'turkmen', 'tk',
938 'twi', 'tw',
939 'uighur', 'ug',
940 'ukrainian', 'uk',
941 'urdu', 'ur',
942 'uzbek', 'uz',
943 'vietnamese', 'vi',
944 'volapÃŒk', 'vo',
945 'welsh', 'cy',
946 'wolof', 'wo',
947 'xhosa', 'xh',
948 'yiddish', 'ji',
949 'yoruba', 'yo',
950 'zulu', 'zu'
951 );
952
953 return (\%languagecodes);
954}
Note: See TracBrowser for help on using the repository browser.