source: git/lib/makemsgs.pl @ 79c5f17

RELEASE/1.0RELEASE/1.1RELEASE/1.2debug-cidebug-ci-sanitisersstereowalls-data
Last change on this file since 79c5f17 was 79c5f17, checked in by Olly Betts <olly@…>, 22 years ago

Sorted out to put messages requiring retranslating into the .todo files.

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

  • Property mode set to 100755
File size: 5.9 KB
Line 
1#!/usr/bin/perl -w
2require 5.004;
3use strict;
4
5use integer;
6
7# messages >= this value are written to a header file
8my $dontextract_threshold = 1000;
9
10# Magic identifier (12 bytes)
11my $magic = "Svx\nMsg\r\n\xfe\xff\0";
12# Designed to be corrupted by ASCII ftp, top bit stripping (or
13# being used for parity).  Contains a zero byte so more likely
14# to be flagged as data (e.g. by perl's "-B" test).
15
16my $major = 0;
17my $minor = 8;
18
19# File format (multi-byte numbers in network order (bigendian)):
20# 12 bytes: Magic identifier
21# 1 byte:   File format major version number (0)
22# 1 byte:   File format minor version number (8)
23# 2 bytes:  Number of messages (N)
24# 4 bytes:  Offset from XXXX to end of file
25# XXXX:
26# N*:
27# <message> NUL
28
29my %ent = ();
30
31open ENT, "named-entities.txt" or die $!;
32while (<ENT>) {
33   my ($e, $v) = /^(\w+),(\d+)/;
34   $ent{$e} = $v;
35}
36close ENT;
37
38my %msgs = ();
39my %dontextract = ();
40
41my %raw = ();
42my $raw = '';
43my $raw_comments = '';
44my $curmsg = -1;
45
46while (<>) {
47   if (/^\s*#/) {
48       $raw_comments .= $_;
49       next; # skip comments
50   }
51
52   # en:  0 0.81 the message
53   # en-us: 0 0.81 " the message "
54   my ($langs, $msgno, $dummy, $msg) = /^([-\w,]+):\s*(\d+)\s+("?)(.*)\3/;
55
56   if ($msgno != $curmsg) {
57       $raw{$curmsg} = $raw;
58       $raw = '';
59       $curmsg = $msgno;
60   }   
61
62   $raw .= $raw_comments . $_;
63   $raw_comments = '';
64
65   unless (defined $langs) {
66      chomp;
67      print STDERR "Warning: Bad line: \"$_\"\n";
68      next;
69   }
70
71   $langs =~ tr/-/_/;
72
73   if ($msg =~ /[\0-\x1f\x7f-\xff]/) {
74      print STDERR "Warning: literal character in message $msgno\n";
75   }
76
77   my $utf8 = string_to_utf8($msg);
78   for (split /,/, $langs) {
79      if ($msgno >= $dontextract_threshold) {
80         ${$dontextract{$_}}[$msgno - $dontextract_threshold] = $utf8;
81      } else {
82         ${$msgs{$_}}[$msgno] = $utf8;
83      }
84   }
85}
86
87my $lang;
88my @langs = sort grep ! /_\*$/, keys %msgs;
89
90my $num_msgs = -1;
91foreach $lang (@langs) {
92   my $aref = $msgs{$lang};
93   $num_msgs = scalar @$aref if scalar @$aref > $num_msgs;
94}
95
96foreach $lang (@langs) {
97   my $fnm = $lang;
98   $fnm =~ s/(_.*)$/\U$1/;
99   open OUT, ">$fnm.msg" or die $!;
100   
101   my $aref = $msgs{$lang};
102 
103   my $parentaref;
104   my $mainlang = $lang;
105   $parentaref = $msgs{$mainlang} if $mainlang =~ s/_.*$//;
106
107   print OUT $magic or die $!;
108   print OUT pack("CCn", $major, $minor, $num_msgs) or die $!;
109
110   my $buff = '';
111
112   my $n;
113   for $n (0 .. $num_msgs - 1) {
114      my $warned = 0;
115      my $msg = $$aref[$n];
116      if (!defined $msg) {
117         $msg = $$parentaref[$n] if defined $parentaref;
118         if (!defined $msg) {
119            $msg = ${$msgs{'en'}}[$n];
120            # don't report if we have a parent (as the omission will be reported there)
121            if (defined $msg && $msg ne '' && !defined $parentaref) {
122               print STDERR "Warning: message $n not in language $lang\n";
123               open TODO, ">>$lang.todo" or die $!;
124               print TODO $raw{$n}, "\n";
125               close TODO;
126               $warned = 1;
127            } else {
128               $msg = '';
129            }
130         }
131      }
132      if ($raw{$n} =~ /^#\s*TRANSLATE\b[-\sa-z]*\b$lang\b/m) {
133         if ($warned) {
134            print STDERR "Warning: message $n missing and also marked for iretranslation for language $lang\n";
135         } else {
136            print STDERR "Warning: message $n needs retranslating for language $lang\n";
137            open TODO, ">>$lang.todo" or die $!;
138            print TODO $raw{$n}, "\n";
139            close TODO;
140         }
141      }
142      $buff .= $msg . "\0";
143   }
144   
145   print OUT pack('N',length($buff)), $buff or die $!;
146   close OUT or die $!;
147}
148
149my $num_dontextract = -1;
150foreach $lang (@langs) {
151   my $aref = $dontextract{$lang};
152   if (defined(@$aref)) {
153       $num_dontextract = scalar @$aref if scalar @$aref > $num_dontextract;
154   }
155}
156
157foreach $lang (@langs) {
158   my $fnm = $lang;
159   $fnm =~ s/(_.*)$/\U$1/;
160   open OUT, ">$fnm.h" or die $!;
161   print OUT "#define N_DONTEXTRACTMSGS ", $num_dontextract, "\n";
162   print OUT "static unsigned char dontextractmsgs[] =";
163
164   for my $n (0 .. $num_dontextract - 1) {
165      print OUT "\n";
166
167      my $aref = $dontextract{$lang};
168 
169      my $parentaref;
170      my $mainlang = $lang;
171      $parentaref = $dontextract{$mainlang} if $mainlang =~ s/_.*$//;
172
173      my $msg = $$aref[$n];
174      if (!defined $msg) {
175         $msg = $$parentaref[$n] if defined $parentaref;
176         if (!defined $msg) {
177            $msg = ${$dontextract{'en'}}[$n];
178            # don't report if we have a parent (as the omission will be reported there)
179            if (defined $msg && $msg ne '' && !defined $parentaref) {
180               print STDERR "Warning: message ", $dontextract_threshold + $n, " not in language $lang\n";
181               open TODO, ">>$lang.todo" or die $!;
182               print TODO $raw{$dontextract_threshold + $n}, "\n";
183               close TODO;
184            } else {
185               $msg = '';
186            }
187         }
188      }
189      $msg =~ s/\\/\\\\/g;
190      $msg =~ s/"/\\"/g;
191      $msg =~ s/\t/\\t/g;
192      $msg =~ s/\n/\\n/g;
193      $msg =~ s/\r/\\r/g;
194      if ($msg =~ /^ / || $msg =~ / $/) {
195         $msg =~ s/\\"/\\\\\\"/g;
196         $msg = '\\"'.$msg.'\\"';
197      }
198      print OUT "   /*", $dontextract_threshold + $n, "*/ \"$msg\\0\"";
199   }
200   print OUT ";\n";
201   close OUT or die $!;
202}
203
204#for (sort {$a<=>$b} keys %raw) {print "$_ = [$raw{$_}]\n";}
205
206sub string_to_utf8 {
207   my $s = shift;
208   $s =~ s/([\x80-\xff])/char_to_utf8(ord($1))/eg;
209   $s =~ s/\&(#\d+|#x[a-f0-9]+|[a-z0-9]+);?/decode_entity($1)/eig;
210   return $s;
211}
212
213sub decode_entity {
214   my $ent = shift;
215   return char_to_utf8($1) if $ent =~ /^#(\d+)$/;
216   return char_to_utf8(hex($1)) if $ent =~ /^#x([a-f0-9]+)$/;
217   return char_to_utf8($ent{$ent}) if exists $ent{$ent};
218   $ent = "\&$ent;";
219   print STDERR "Warning: entity \"$ent\" unknown\n";
220   return $ent;
221}
222
223sub char_to_utf8 {
224   my $unicode = shift;
225   # ASCII is easy, and the most common case
226   return chr($unicode) if $unicode < 0x80;
227
228   my $result = '';
229   my $n = 0x20;
230   while (1) {
231      $result = chr(0x80 | ($unicode & 0x3f)) . $result;
232      $unicode >>= 6;
233      last if $unicode < $n;
234      $n >>= 1;
235   }
236   $result = chr((0x100 - $n*2) | $unicode) . $result;
237   return $result;
238}
239
Note: See TracBrowser for help on using the repository browser.