source: git/lib/po-to-msg.pl @ a26bab0

RELEASE/1.2debug-cidebug-ci-sanitisersstereowalls-data
Last change on this file since a26bab0 was d86459c, checked in by Olly Betts <olly@…>, 13 years ago

lib/,src/mainfrm.cc,src/mainfrm.h: We now use .po and .pot files as
the master format for storing translations in (rather than
messages.txt), and then translate these into Survex's .msg format.

git-svn-id: file:///home/survex-svn/survex/trunk@3595 4b37db11-9a0c-4f06-9ece-9ab7cdaee568

  • Property mode set to 100755
File size: 9.5 KB
Line 
1#!/usr/bin/perl -w
2require 5.008;
3use bytes;
4use strict;
5use Locale::PO;
6
7use integer;
8
9# messages >= this value are written to a header file
10my $dontextract_threshold = 1000;
11
12# Magic identifier (12 bytes)
13my $magic = "Svx\nMsg\r\n\xfe\xff\0";
14# Designed to be corrupted by ASCII ftp, top bit stripping (or
15# being used for parity).  Contains a zero byte so more likely
16# to be flagged as data (e.g. by perl's "-B" test).
17
18my $major = 0;
19my $minor = 8;
20
21# File format (multi-byte numbers in network order (bigendian)):
22# 12 bytes: Magic identifier
23# 1 byte:   File format major version number (0)
24# 1 byte:   File format minor version number (8)
25# 2 bytes:  Number of messages (N)
26# 4 bytes:  Offset from XXXX to end of file
27# XXXX:
28# N*:
29# <message> NUL
30
31my %msgs = ();
32${$msgs{'en'}}[0] = '©';
33my %dontextract = ();
34
35# my %uses = ();
36
37my $num_list = Locale::PO->load_file_asarray("codes.po");
38my $curmsg = -1;
39foreach my $po_entry (@{$num_list}) {
40    my $msgno = $po_entry->dequote($po_entry->msgstr);
41    next if $msgno !~ /^\d+$/;
42    if ($msgno < $curmsg) {
43        print STDERR "Warning: message number jumps back from $curmsg to $msgno\n";
44    }
45    my $key = $po_entry->msgid;
46    my $msg = c_unescape($po_entry->dequote($key));
47    if ($msgno >= $dontextract_threshold) {
48        if (${$dontextract{'en'}}[$msgno - $dontextract_threshold]) {
49            print STDERR "Warning: already had message $msgno for language 'en'\n";
50        }
51        ${$dontextract{'en'}}[$msgno - $dontextract_threshold] = $msg;
52    } else {
53        if (${$msgs{'en'}}[$msgno]) {
54            print STDERR "Warning: already had message $msgno for language 'en'\n";
55        }
56        ${$msgs{'en'}}[$msgno] = $msg;
57    }
58}
59
60for my $language (@ARGV) {
61    $language =~ s/\.po$//;
62
63    my $po_hash = Locale::PO->load_file_ashash("$language.po");
64
65    foreach my $po_entry (@{$num_list}) {
66        my $msgno = $po_entry->dequote($po_entry->msgstr);
67        next if $msgno !~ /^\d+$/;
68        my $key = $po_entry->msgid;
69        my $ent = $$po_hash{$key};
70        if (defined $ent) {
71            my $msg = c_unescape($po_entry->dequote($ent->msgstr));
72            next if $msg eq '';
73            if ($msgno >= $dontextract_threshold) {
74                if (${$dontextract{$language}}[$msgno - $dontextract_threshold]) {
75                    print STDERR "Warning: already had message $msgno for language $language\n";
76                }
77                ${$dontextract{$language}}[$msgno - $dontextract_threshold] = $msg;
78            } else {
79                if (${$msgs{$language}}[$msgno]) {
80                    print STDERR "Warning: already had message $msgno for language $language\n";
81                }
82                ${$msgs{$language}}[$msgno] = $msg;
83            }
84        }
85    }
86
87#       local $_;
88#       open FINDUSES, "grep -no '*/$msgno\\>' ../src/*.cc ../src/*.c ../src/*.h|" or die $!;
89#       while (<FINDUSES>) {
90#          push @{$uses{$msgno}}, $1 if /^([^:]*:\d+):/;
91#       }
92#       close FINDUSES;
93
94}
95
96my $lang;
97my @langs = sort grep ! /_\*$/, keys %msgs;
98
99my $num_msgs = -1;
100foreach $lang (@langs) {
101   my $aref = $msgs{$lang};
102   $num_msgs = scalar @$aref if scalar @$aref > $num_msgs;
103   unlink "$lang.todo";
104}
105
106foreach $lang (@langs) {
107   my $fnm = $lang;
108   $fnm =~ s/(_.*)$/\U$1/;
109   open OUT, ">$fnm.msg" or die $!;
110
111   my $aref = $msgs{$lang};
112
113   my $parentaref;
114   my $mainlang = $lang;
115   $parentaref = $msgs{$mainlang} if $mainlang =~ s/_.*$//;
116
117   print OUT $magic or die $!;
118   print OUT pack("CCn", $major, $minor, $num_msgs) or die $!;
119
120   my $buff = '';
121   my $missing = 0;
122   my $retranslate = 0;
123
124   for my $n (0 .. $num_msgs - 1) {
125      my $warned = 0;
126      my $msg = $$aref[$n];
127      if (!defined $msg) {
128         $msg = $$parentaref[$n] if defined $parentaref;
129         if (!defined $msg) {
130            $msg = ${$msgs{'en'}}[$n];
131            # don't report if we have a parent (as the omission will be
132            # reported there)
133            if (defined $msg && $msg ne '' && !defined $parentaref) {
134               ++$missing;
135               $warned = 1;
136            } else {
137               $msg = '' if !defined $msg;
138            }
139         }
140      } else {
141         if ($lang ne 'en') {
142             sanity_check("Message $n in language $lang", $msg, ${$msgs{'en'}}[$n]);
143         }
144      }
145      $buff .= $msg . "\0";
146   }
147
148   print OUT pack('N',length($buff)), $buff or die $!;
149   close OUT or die $!;
150
151   if ($missing || $retranslate) {
152       print STDERR "Warning: ";
153       if ($missing) {
154           print STDERR "$lang: $missing missing message(s)";
155           if ($retranslate) {
156               print STDERR " and $retranslate requiring retranslation";
157           }
158       } else {
159           print STDERR "$lang: $retranslate message(s) requiring retranslation";
160       }
161       print STDERR "\n";
162   }
163}
164
165my $num_dontextract = -1;
166foreach $lang (@langs) {
167   my $aref = $dontextract{$lang};
168   if (defined(@$aref)) {
169       $num_dontextract = scalar @$aref if scalar @$aref > $num_dontextract;
170   }
171}
172
173if (0) { # disable for now until this is sorted in the po based framework
174foreach $lang (@langs) {
175   my $fnm = $lang;
176   $fnm =~ s/(_.*)$/\U$1/;
177   open OUT, ">$fnm.h" or die $!;
178   print OUT "#define N_DONTEXTRACTMSGS ", $num_dontextract, "\n";
179   print OUT "static unsigned char dontextractmsgs[] =";
180
181   my $missing = 0;
182   for my $n (0 .. $num_dontextract - 1) {
183      print OUT "\n";
184
185      my $aref = $dontextract{$lang};
186
187      my $parentaref;
188      my $mainlang = $lang;
189      $parentaref = $dontextract{$mainlang} if $mainlang =~ s/_.*$//;
190
191      my $msg = $$aref[$n];
192      if (!defined $msg) {
193         $msg = $$parentaref[$n] if defined $parentaref;
194         if (!defined $msg) {
195            $msg = ${$dontextract{'en'}}[$n];
196            # don't report if we have a parent (as the omission will be reported there)
197            if (defined $msg && $msg ne '' && !defined $parentaref) {
198               ++$missing;
199            } else {
200               $msg = '';
201            }
202         }
203      } else {
204         if ($lang ne 'en') {
205             sanity_check("Message $n in language $lang", $msg, $$aref[$n]);
206         }
207      }
208      $msg =~ s/\\/\\\\/g;
209      $msg =~ s/"/\\"/g;
210      $msg =~ s/\t/\\t/g;
211      $msg =~ s/\n/\\n/g;
212      $msg =~ s/\r/\\r/g;
213      if ($msg =~ /^ / || $msg =~ / $/) {
214         $msg =~ s/\\"/\\\\\\"/g;
215         $msg = '\\"'.$msg.'\\"';
216      }
217      print OUT "   /*", $dontextract_threshold + $n, "*/ \"$msg\\0\"";
218   }
219   print OUT ";\n";
220   close OUT or die $!;
221
222   if ($missing) {
223       print STDERR "Warning: $lang: $missing missing \"don't extract\" message(s)\n";
224   }
225}
226}
227
228sub sanity_check {
229   my ($where, $msg, $orig) = @_;
230   # check printf-like specifiers match
231   # allow valid printf specifiers, or %<any letter> to support strftime
232   # and other printf-like formats.
233   my @pcent_m = grep /\%/, split /(%(?:[-#0 +'I]*(?:[0-9]*|\*|\*m\$)(?:\.[0-9]*)?(?:hh|ll|[hlLqjzt])?[diouxXeEfFgGaAcsCSpn]|[a-zA-Z]))/, $msg;
234   my @pcent_o = grep /\%/, split /(%(?:[-#0 +'I]*(?:[0-9]*|\*|\*m\$)(?:\.[0-9]*)?(?:hh|ll|[hlLqjzt])?[diouxXeEfFgGaAcsCSpn]|[a-zA-Z]))/, $orig;
235   while (scalar @pcent_m || scalar @pcent_o) {
236       if (!scalar @pcent_m) {
237           print STDERR "Warning: $where misses out \%spec $pcent_o[0]\n";
238       } elsif (!scalar @pcent_o) {
239           print STDERR "Warning: $where has extra \%spec $pcent_m[0]\n";
240       } elsif ($pcent_m[0] ne $pcent_o[0]) {
241           print STDERR "Warning: $where has \%spec $pcent_m[0] instead of $pcent_o[0]\n";
242       }
243       pop @pcent_m;
244       pop @pcent_o;
245   }
246
247   # Check for missing (or added) ellipses (...)
248   if ($msg =~ /\.\.\./ && $orig !~ /\.\.\./) {
249       print STDERR "Warning: $where has ellipses but original doesn't\n";
250   } elsif ($msg !~ /\.\.\./ && $orig =~ /\.\.\./) {
251       print STDERR "Warning: $where is missing ellipses\n";
252   }
253
254   # Check for missing (or added) menu shortcut (@)
255   if ($msg =~ /\@[A-Za-z]/ && $orig !~ /\@[A-Za-z]/) {
256       print STDERR "Warning: $where has menu shortcut but original doesn't\n";
257   } elsif ($msg !~ /\@[A-Za-z]/ && $orig =~ /\@[A-Za-z]/) {
258       print STDERR "Warning: $where is missing menu shortcut\n";
259   }
260
261   # Check for missing (or added) menu shortcut (&)
262   if ($msg =~ /\&[A-Za-z]/ && $orig !~ /\&[A-Za-z]/) {
263       print STDERR "Warning: $where has menu shortcut but original doesn't\n";
264   } elsif ($msg !~ /\&[A-Za-z]/ && $orig =~ /\&[A-Za-z]/) {
265       print STDERR "Warning: $where is missing menu shortcut\n";
266   }
267
268   # Check for missing (or added) menu accelerator "##"
269   if ($msg =~ /\#\#/ && $orig !~ /\#\#/) {
270       print STDERR "Warning: $where has menu accelerator but original doesn't\n";
271   } elsif ($msg !~ /\#\#/ && $orig =~ /\#\#/) {
272       print STDERR "Warning: $where is missing menu accelerator\n";
273   } elsif ($orig =~ /\#\#(.*)/) {
274       my $acc_o = $1;
275       my ($acc_m) = $msg =~ /\#\#(.*)/;
276       if ($acc_o ne $acc_m) {
277           print STDERR "Warning: $where has menu accelerator $acc_m instead of $acc_o\n";
278       }
279   }
280
281   # Check for missing (or added) menu accelerator "\t"
282   if ($msg =~ /\t/ && $orig !~ /\t/) {
283       print STDERR "Warning: $where has menu accelerator but original doesn't\n";
284   } elsif ($msg !~ /\t/ && $orig =~ /\t/) {
285       print STDERR "Warning: $where is missing menu accelerator\n";
286   } elsif ($orig =~ /\t(.*)/) {
287       my $acc_o = $1;
288       my ($acc_m) = $msg =~ /\t(.*)/;
289       if ($acc_o ne $acc_m) {
290           print STDERR "Warning: $where has menu accelerator $acc_m instead of $acc_o\n";
291       }
292   }
293}
294
295sub c_unescape {
296   my $str = shift @_;
297   $str =~ s/\\(x..|0|[0-7][0-7][0-7]|.)/&c_unescape_char($1)/ge;
298   return $str;
299}
300
301sub c_unescape_char {
302    my $ch = shift @_;
303    if ($ch eq '0' || $ch eq 'x00' || $ch eq '000') {
304        print STDERR "Nul byte in translation! (\\$ch)\n";
305        exit(1);
306    }
307    return $ch if $ch eq '"' || $ch eq '\\';
308    return "\n" if $ch eq "n";
309    return "\t" if $ch eq "t";
310    return "\r" if $ch eq "r";
311    return "\f" if $ch eq "f";
312    return chr(hex(substr($ch,1))) if $ch =~ /^x../;
313    return chr(oct($ch)) if $ch =~ /^[0-7][0-7][0-7]/;
314    print STDERR "Unknown C-escape in translation! (\\$ch)\n";
315    exit(1);
316}
Note: See TracBrowser for help on using the repository browser.