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

Last change on this file since 3632 was 3632, checked in by sjboddie, 21 years ago

Added langaction

  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 18.1 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
35use parsargv;
36use util;
37use Cwd;
38use File::Basename;
39use GDBM_File;
40use CGI;
41
42sub main
43{
44 #gets the name of the language that is being translated from base language
45 my $file = shift(@_);
46
47 my $baselanguage = shift(@_);
48
49 #checks that argument was supplied
50 if (!$file) {
51 die "You didn't supply the name of the language file! Aborting...\n";
52 }
53 $file = "port" if ($file =~ m/portuguese/);
54 $file = "indo" if ($file =~ m/indonesian/);
55
56 #saves the directory path to the database files
57 my $gdbmdir = "$ENV{'GSDLHOME'}/tmp/lang/gdbmfiles/";
58 #creates the directory if it doesn't exist
59 if (!-e $gdbmdir) {
60 my $store_umask = umask(0000);
61 if (! mkdir($gdbmdir, 0777)) {
62 umask($store_umask);
63 die "Couldn't create directory $gdbmdir\n";
64 }
65 umask($store_umask);
66 }
67 #saves the directory path to the macro files
68 my $macrodir = "$ENV{'GSDLHOME'}/macros/";
69
70 # always do this update because english.dm changes often
71 #hashes the macro file into form of macroname{macrotext}
72 my ($englhash) = &parse_macrofile($macrodir.$baselanguage.".dm");
73 my ($engl2hash) = &parse_macrofile($macrodir.$baselanguage."2.dm");
74 $englhash = &combine_hashes($englhash,$engl2hash);
75
76 &file_to_db($baselanguage, $englhash);
77
78 my ($base) = &dateannotation($baselanguage);
79 my ($base2) = &dateannotation($baselanguage."2");
80 $base = &combine_hashes($base,$base2);
81
82 # language macro-filename and database-filename
83 my $macrofile = $macrodir.$file.".dm";
84 my $dbfile = $gdbmdir.$file.".db";
85
86 if (! -e $macrofile) {
87
88 @packages = ("Global", "about", "document", "query", "preferences", "browse", "help",
89 "home", "homehelp", "extlink", "authen", "collector", "docs", "usersedituser",
90 "usersdeleteuser", "bsummary", "status", "users", "gsdl", "userschangepasswd",
91 "userschangepasswdok");
92
93 open MCROFILE, ">$macrofile" or die "MURGH\n";
94
95 foreach $packg (@packages) {
96 print MCROFILE "package $packg\n";
97 print MCROFILE "# text macros\n";
98 print MCROFILE "# icons\n";
99 }
100
101 close MCROFILE;
102
103 $code = $& if($file =~ m/\w\w/);
104
105 open LANGFILE, "<$ENV{'GSDLHOME'}/tmp/lang/package_forms/languages.log" or die "MURGH\n";
106
107 while (<LANGFILE>) {
108 if ($_ eq $code){
109 $code = $& if($file =~ m/.\w\w/);
110 $code =~ s/\A.//;
111 }
112 }
113
114 close LANGFILE;
115
116 open LANGFILE, ">>$ENV{'GSDLHOME'}/tmp/lang/package_forms/languages.log" or die "MURGH\n";
117 print LANGFILE "\n$file";
118 $code = $& if($file =~ m/\w\w/);
119 print LANGFILE "\n$code";
120 close LANGFILE;
121 }
122
123 # if it doesn't have a database file then create one afresh
124 my ($langhash) = &parse_macrofile($macrofile);
125 $macrofile = $macrodir.$file."2.dm";
126 my ($langhash2) = &parse_macrofile($macrofile);
127 $langhash = &combine_hashes($langhash, $langhash2);
128
129 &file_to_db($file, $langhash);
130
131 my $foreign = &dateannotation($file);
132 my $foreign2 = &dateannotation($file . "2");
133 $foreign = &combine_hashes($foreign, $foreign2);
134
135 #finds the differences between the english database (base language)
136 #and the supplied languages database and hashes these differences
137 #in the form macroname{macrotext}
138 my $diffhash = &db_db_diffs($gdbmdir.$baselanguage.".db", $dbfile, $base, $foreign, $baselanguage);
139 #generates HTML code to display user interface on webpage with what needs translation
140 #returns an array of CGI data
141
142 $file = "indonesian" if ($file =~ m/indo/);
143 $file = "portuguese" if ($file =~ m/port/);
144
145 my @queries = &generate_pages($diffhash, $file, $baselanguage);
146
147}
148
149sub combine_hashes {
150
151 my ($hash1, $hash2) = @_;
152 my %combined = ();
153
154 foreach $key (keys %$hash1) {
155 $combined{$key} = $hash1->{$key};
156 }
157 foreach $key (keys %$hash2) {
158 $combined{$key} = $hash2->{$key};
159 }
160
161 return (\%combined);
162
163}
164
165sub parse_macrofile
166{
167 #saves the path of the macro file
168 my $filename = shift(@_);
169 #initialises some local variables
170 my $currpackage;
171 my %macros = ();
172 my @date = localtime(time);
173
174 #opens macro file or kills program
175 open(IN, "<$filename") or return;
176 #reads in contents of macro file, line by line
177 while (<IN>) {
178 # find out the current package that macros belong to
179 if (s/^package //) {
180 $currpackage = $_;
181 chomp($currpackage);
182 }
183 #if line contains a macro name
184 elsif (/^(_\w+_)/) {
185 # gets the name of the macro ($1 contains text matched by corresponding
186 #set of parentheses in the last matched pattern within the dynamic scope
187 #which here matches (_\w+_) )
188 my $macroname = $1;
189 #saves the day/month/year
190 my $macrotext = $date[3]. "/" . $date[4] . "/" . $date[5] ."\n";
191 # key to the hash and the database
192 my $key = $currpackage . "::" . $macroname;
193 # get the first line of the macro
194 $_ =~ s/^_\w+_ *//;
195 # while there is still text of the macro to go...
196 while ($_ !~ /.*\}/) {
197 # ... adds it to the macrotext variable
198 $macrotext .= $_;
199 $_ = <IN>;
200 }
201 $macrotext .= $_;
202 #hashes the macroname and the macrotext
203 $macros{$key} = $macrotext;
204 }
205 #line in format ## "sometext" ## macro ## macroname ##
206 elsif (/^\#\# .*/) {
207 my $macroname = $_;
208 #saves the day/month/year
209 my $macrotext = $date[3]. "/" . $date[4] . "/" . $date[5] ."\n";
210
211 unless ($macroname =~ m/^\#\# .*\#\#/) {
212
213 $macroname = $_;
214 chomp($macroname);
215 $_ = <IN>;
216 $macroname .= $_;
217
218 }
219
220 my @names = split(/\s*\#\#\s*/, $macroname);
221
222 $macrotext .= $macroname;
223 $_ = <IN>;
224
225 $macroname = $names[(scalar @names) - 1];
226
227 my $key = $currpackage . "::" . $macroname; # key to the hash and the database
228
229 while ($_ !~ /^\s+/) {
230 $macrotext .= $_;
231 $_ = <IN>;
232 }
233
234 $macros{$key} = $macrotext;
235 }
236
237 }
238 close IN;
239
240 return (\%macros);
241}
242
243sub dateannotation {
244
245 $language = shift(@_);
246 my %macrodated = ();
247
248 $file = qx/cd $ENV{'GSDLHOME'}\/macros;cvs annotate $language.dm/;
249 @file = split(/\n/,$file);
250
251 for ($p = 0; $p < scalar(@file); $p++) {
252
253 $line = $file[$p];
254 chomp($line);
255 $line =~ s/.*\(.*\):\s//;
256 $date = $&;
257
258 $date = $& if($date =~ m/\d\d-\w\w\w-\d\d/);
259
260 if ($line =~ m/\#\# .*/) {
261
262 unless ($line =~ m/\A\#\# .*\#\#/) {
263 $line = $file[++$p];
264 chomp($line);
265 $line =~ s/.*\(.*\):\s//;
266 }
267 my @icon = split(/\s*\#\#\s*/, $line);
268
269 $macro = $icon[(scalar @icon) - 1];
270
271 $macrodated{$macro} = $date;
272
273 while ($line =~ m/\s+/) {
274 $line = $file[++$p];
275 chomp($line);
276 $line =~ s/.*\(.*\):\s//;
277 }
278 }
279 elsif ($line =~ m/\A(_\w+_)/) {
280 $line = $&;
281 $macrodated{$line} = $date;
282 }
283 }
284
285 return (\%macrodated);
286}
287
288
289#######################
290# DATABASE OPERATIONS #
291#######################
292
293# At the moment this routine is used to update english.db
294# file when there are change in english.dm macro file; it
295# has been made generic so that other database files can be
296# updated if the need arises in the future.
297sub file_to_db
298{
299 my ($filename, $filehash) = @_;
300
301 my $database = "$ENV{'GSDLHOME'}/tmp/lang/gdbmfiles/$filename.db";
302 my %dbhash = ();
303
304
305 if (-e $database) {
306
307 tie(%dbhash, 'GDBM_File', $database, 1, 0640) or die "$!";
308
309 foreach $filekey (sort(keys(%$filehash))) {
310 if (!($dbhash{$filekey})) {
311 $dbhash{$filekey} = $filehash->{$filekey};
312 }
313 else {
314 # strip off the dates from both entries...
315 my $filemacro = ($filehash->{$filekey});
316 my $dbmacro = ($dbhash{$filekey});
317 $filemacro =~ s/^.*//;
318 $dbmacro =~ s/^.*//;
319
320 if ($dbmacro ne $filemacro) {
321 #update the database to reflect the change...
322 $dbhash{$filekey} = $filehash->{$filekey};
323 }
324 }
325 }
326 }
327 else { # create the database file for the particular language file...
328 # tie the hash to the database
329 tie(%dbhash, "GDBM_File", $database, GDBM_WRCREAT, 0640);
330
331 %dbhash = %$filehash;
332 }
333
334 untie %dbhash;
335}
336
337# db_db_diffs => Takes two paramaters which are two database filenames, works out
338# the differences between the two, and returns them in %diffhash
339#
340# ARGUMENTS: $db_one is the database which contains all the values, e.g. english
341# $db_two is the database which is possibly missing some values
342#
343# PRE: $db_one and $db_two assumed to exist
344# POST: %differences holds entries that are in $db_one but not in $db_two
345sub db_db_diffs
346{
347 my ($db_one, $db_two, $basedates, $foreigndates, $baselanguage) = @_;
348
349 my %db1hash = ();
350 my %db2hash = ();
351 my %months = ("Jan",1,"Feb",2,"Mar",3,"Apr",4,"May",5,"Jun",6,
352 "Jul",7,"Aug",8,"Sep",9,"Oct",10,"Nov",11,"Dec",12);
353
354 # this hash holds the database entries that are in
355 # english.db but not in $filename.db
356 my %diffhash = ();
357
358 #ties the hash to database so when you read from hash it fetches from external
359 #database and when you set hash it writes to external database
360 tie(%db1hash, "GDBM_File", $db_one, GDBM_READER, 0640);
361 tie(%db2hash, "GDBM_File", $db_two, GDBM_READER, 0640);
362
363 #the key is the name of the macro
364 foreach $key (sort(keys(%db1hash))) {
365 #if the macro isn't there at all, then it's different
366 if (!$db2hash{$key}) {
367 $diffhash{$key} = [$db1hash{$key},"",""];
368 }
369 #else if the macro is in both, want to compare date stamps of date hashes HERE
370 #and if foreign date is older than base date want to add to diffhash aswell
371 else {
372 $macro = $key;
373 $macro =~ s/\A.*:://;
374 $bdate = $basedates->{$macro};
375 $fdate = $foreigndates->{$macro};
376 @bdate = split(/-/,$bdate);
377 @fdate = split(/-/,$fdate);
378 if ($bdate[2] >= $fdate[2]) {
379 if ($months{$bdate[1]} >= $months{$fdate[1]}) {
380 if ($bdate[0] > $fdate[0]) {
381 $foreigntext = $db2hash{$key};
382 $foreigntext =~ s/^.*\n//;
383 $foreigntext =~ s/.*\{//;
384 $foreigntext =~ s/\}\Z//;
385
386 $file = qx/cd $ENV{'GSDLHOME'}\/macros;cvs diff -D $fdate $baselanguage.dm/;
387 $file .= qx/cd $ENV{'GSDLHOME'}\/macros;cvs diff -D $fdate $baselanguage"2.dm"/;
388 @file = split(/\n/,$file);
389
390 $found = 1;
391 foreach $key (@file) {
392 if ($key =~ m/$macro/) {
393 if ($key =~ m/\A</) {
394 $key =~ s/\A<\s*(_\w+_)\s*\{//;
395 $key =~ s/\}\Z//;
396 print STDERR "KEY>>>>>||||| $key\n";
397 }
398 $found = 0;
399 }
400 }
401 print STDERR "NOTFOUND $macro\n" if ($found);
402
403 $diffhash{$key} = [$db1hash{$key}, $foreigntext,""];
404 }
405 }
406 }
407 }
408 }
409
410 untie %db1hash;
411 untie %db2hash;
412
413 return \%diffhash;
414}
415
416
417#############################################
418# WEB-FORM GENERATION AND ARGUMENT FETCHING #
419#############################################
420
421# generates web-form using the datahash you pass in;
422# it will be broken down into pages, 15 macros per page
423sub generate_pages
424{
425
426 my ($datahash) = shift(@_);
427 my $lang = shift(@_);
428 my $baselanguage = shift(@_);
429 my %pagehash = ();
430 my @query_pages = ();
431
432 # directory in which to put the generated html pages
433 my $dir = "$ENV{'GSDLHOME'}/tmp/lang/package_forms";
434
435 # creates directory if it doesn't already exist
436 if (!-e $dir) {
437 my $store_umask = umask(0000);
438 if (! mkdir($dir, 0777)) {
439 umask($store_umask);
440 die "Couldn't create directory $dir\n";
441 }
442 umask($store_umask);
443 }
444
445 @pageno = ();
446 $pageno = 1;
447 $keysperpage = 0;
448 $limit = 15;
449
450 # goes through hash of differences between base language and translation
451 foreach $key (sort(keys(%$datahash))) {
452 #in the hash of HTML pages, add this key to the current page and initialise it
453 #with it's value in the datahash
454 $pagehash->{$pageno}->{$key} = $datahash->{$key};
455 $keysperpage++;
456
457 $limit = 7 if($key =~ m/collector::_text.*/);
458 $limit = 7 if(!($key =~ m/_.*\_/g));
459 $limit = 7 if($key =~ m/help::_text.*/);
460 $limit = 3 if($key =~ m/home::.*/);
461 $limit = 3 if($key =~ m/gsdl::.*/);
462 $limit = 1 if($key =~ m/help::_(.*)texthelp.*/);
463 $limit = $keysperpage if ($limit <= $keysperpage);
464
465 #if have enough keys to generate a page with
466 if ($keysperpage == $limit) {
467 #resets key counting variable
468 $keysperpage = 0;
469 $limit = 15;
470 #opens a file to write the HTML code to for current page
471 open HTMLFILE, ">$dir/$pageno.lang";
472
473 #passes hash of keys for current page and filehandle, returns CGI data
474 my $query = &generate_form($pagehash->{$pageno}, \*HTMLFILE, $lang, $baselanguage);
475 close HTMLFILE;
476
477 #push the page number onto the array of pages
478 push(@pageno, $pageno);
479 #increment the current page
480 $pageno++;
481 }
482 }
483
484 #if you exit the loop with keys still to write
485 if ($keysperpage != 0) {
486
487 #writes out the remaining keys, same format as above
488 open HTMLFILE, ">$dir/$pageno.lang";
489 my $query = &generate_form($pagehash->{$pageno}, \*HTMLFILE, $lang, $baselanguage);
490 close HTMLFILE;
491 push(@pageno, $pageno);
492 }
493
494 #writes each page number to a file
495 open PAGELOG, ">$ENV{'GSDLHOME'}/tmp/lang/package_forms/pageno.log" or die("MURGH\n");
496 foreach $page (@pageno) {
497 print PAGELOG $page, "\n";
498 }
499 close PAGELOG;
500
501 #write thankyou page for language translator once translation is complete
502 open THANKYOU, ">$ENV{'GSDLHOME'}/tmp/lang/package_forms/thankyou.lang" or die("MURGH\n");
503 print THANKYOU "<center>Thankyou for completing the $lang translation<p></center>\n";
504 close THANKYOU;
505
506 #returns CGI data
507 return @queries;
508}
509
510sub generate_form
511{
512 my $formhash = shift(@_);
513 my $fh = shift(@_);
514 my $language = shift(@_);
515 my $baselanguage = shift(@_);
516 # common gateway interface for writing the stuff to the web
517 my $query = new CGI;
518 my $keynamecount = 1;
519
520 print $fh ("<center>\n",
521 "If an<font color=\"FF0000\"> UPDATED! </font>tag is present a translation already exists,<br>\n",
522 "however it's macro has since been updated.<br>\n",
523 "Please ensure that the current translation provided in the input field is correct.<br>\n",
524 $query->hidden(-name=>"hiddenlanguage",-default=>"$language"),
525 $query->hidden(-name=>"baselanguage",-default=>"$baselanguage"),
526 "<p><table border=\"5\" cellpadding=\"10\">\n",
527 "<tr><td><strong>BASE LANGUAGE FILE<br>",
528 "________________________________</strong></td>\n",
529 "<td><strong>TRANSLATED LANGUAGE<br>",
530 "________________________________</strong></td></tr>\n");
531
532
533 foreach $key (sort(keys(%$formhash))) {
534
535 my $text = $formhash->{$key}[0];
536
537 # whole lot of formatting on strings
538 # escape all the '_' with '\' so that Greenstone doesn't substitute
539 # the macro names for the contents of the macro itself
540 my $keyname = $key;
541
542 $keyname =~ s/_/\\_/g;
543 # strip off the date
544 $text =~ s/.*//;
545 $text =~ s/(\[l=.*\])//;
546 # tells you the date the english file was last updated...
547 #$date = $&;
548
549 print STDERR "$text\n";
550
551
552 # must take care of image macros single and multiple line ones
553 $text =~ s/(\<br\>\#\#.*\#\#\s*\<br\>).*/$1/g;
554
555 # format the text for displaying in the browser
556 $text =~ s/[\{\}]//g unless($text =~ m/\#\# /);
557 $text =~ s/(\A\n)//;
558 $text =~ s/(\n\Z)//;
559 $text =~ s/\n/\<br\>/g;
560
561 $text =~ s/</\&lt;/g;
562 $text =~ s/>/\&gt;/g;
563 $text =~ s/\b_([A-Za-z0-9:]+)_\b/ \b\\_$1\\_ \b/g;
564
565 $keynamecount = 1;
566
567 my $default = $formhash->{$key}[1];
568 my $updated = "";
569 $updated = "<font color=\"FF0000\"> UPDATED! </font><br>" if ($default =~ m/\S+/);
570
571 # so that when it is an image only get the text to translate not coding stuff aswell
572 if ($text =~ m/\#\# (^|.)*/) {
573 if ($& =~ m/".*"/) {
574 print $fh ("<tr><td> $updated $&</td><td>",
575 $query->hidden(-name=>"$keyname" . "$keynamecount",-default=>"$`"));
576 $keynamecount++;
577 print $fh ($query->textfield(-name=>"$keyname" . "$keynamecount",
578 -default=>"$default",
579 -size=>50));
580 $keynamecount++;
581 print $fh ($query->hidden(-name=>"$keyname" . "$keynamecount",-default=>"$'"),
582 "</td></tr>\n");
583 }
584 }
585 elsif ($text =~ m/\S+/) {
586 $text =~ s/\s+/ /g;
587 $text =~ s/\&lt;br\&gt;/\&lt;br\&gt;\n/g;
588
589 my @words = split(/ /, $text);
590 my $words = scalar(@words);
591 my $rows = sprintf("%.0f", $words/5);
592 print $fh ("<tr><td> $updated $text </td><td>\n");
593 if ($rows > 1) {
594 print $fh ($query->textarea(-name=>"$keyname" . "$keynamecount",
595 -rows=>$rows * 2,
596 -default=>"$default",
597 -columns=>50),
598 "<br></td></tr>\n");
599 }
600 else {
601 print $fh ($query->textfield(-name=>"$keyname" . "$keynamecount",
602 -default=>"$default",
603 -size=>50),
604 "<br></td></tr>\n");
605 }
606 }
607 }
608 #finishes table and adds a SUBMIT CHANGES option on the end
609 print $fh ("</table>\n", "<br>",
610 "Please ensure your $language translation is correct before proceeding.<br>\n",
611 "Input fields may be left empty if necessary and only those field which<br>\n",
612 "contain a translation will be submitted to the macro file.<br>\n",
613 "Submitting this page will result in the next page being loaded automatically.<br><strong>\n",
614 $query->submit($pageno, 'SUBMIT TRANSLATION >>'),
615 "</strong>","</center>\n");
616
617 # adds the CGI area just written to the array of CGI areas
618 push (@queries, $query);
619
620 return $query;
621}
622
623&main(@ARGV);
624
Note: See TracBrowser for help on using the repository browser.