source: git/lib/makemsgs.pl @ 44d079a

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

"Un page" -> "Une page"

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

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