source: git/lib/makemsgs.pl @ c0a9908

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

Renamed message files to be de_CH.msg rather than de-ch.msg to make
working with other i18n code easier.

aven: more translations, enabled i18n of wxWindows.

No longer trap SIGINT or SIGTERM - there's not much point really.

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

  • Property mode set to 100755
File size: 3.3 KB
Line 
1#!/usr/bin/perl -w
2require 5.004;
3use strict;
4
5use integer;
6
7# Magic identifier (12 bytes)
8my $magic = "Svx\nMsg\r\n\xfe\xff\0";
9# Designed to be corrupted by ASCII ftp, top bit stripping (or
10# being used for parity).  Contains a zero byte so more likely
11# to be flagged as data (e.g. by perl's "-B" test).
12
13my $major = 0;
14my $minor = 8;
15
16# File format (multi-byte numbers in network order (bigendian)):
17# 12 bytes: Magic identifier
18# 1 byte:   File format major version number (0)
19# 1 byte:   File format minor version number (8)
20# 2 bytes:  Number of messages (N)
21# 4 bytes:  Offset from XXXX to end of file
22# XXXX:
23# N*:
24# <message> NUL
25
26my %ent = ();
27
28open ENT, "named-entities.txt" or die $!;
29while (<ENT>) {
30   my ($e, $v) = /^(\w+),(\d+)/;
31   $ent{$e} = $v;
32}
33close ENT;
34
35my %msgs = ();
36
37while (<>) {
38   next if /^\s*#/; # skip comments
39   
40   # en:  0 0.81 the message
41   # en-us: 0 0.81 " the message "
42   my ($langs, $msgno, $dummy, $msg) = /^([-\w,]+):\s*(\d+)\s+("?)(.*)\3/;
43
44   unless (defined $langs) {
45      chomp;
46      print STDERR "Warning: Bad line: \"$_\"\n";
47      next;
48   }
49
50   $langs =~ tr/-/_/;
51
52   if ($msg =~ /[\0-\x1f\x7f-\xff]/) {
53      print STDERR "Warning: literal character in message $msgno\n";
54   }
55
56   my $utf8 = string_to_utf8($msg);
57   for (split /,/, $langs) {
58      ${$msgs{$_}}[$msgno] = $utf8;
59   }
60}
61
62my $lang;
63my @langs = sort grep ! /_\*$/, keys %msgs;
64
65my $num_msgs = -1;
66foreach $lang (@langs) {
67   my $aref = $msgs{$lang};
68   $num_msgs = scalar @$aref if scalar @$aref > $num_msgs;
69}
70
71foreach $lang (@langs) {
72   my $fnm = $lang;
73   $fnm =~ s/(_.*)$/\U$1/;
74   open OUT, ">$fnm.msg" or die $!;
75   
76   my $aref = $msgs{$lang};
77 
78   my $parentaref;
79   my $mainlang = $lang;
80   $parentaref = $msgs{$mainlang} if $mainlang =~ s/_.*$//;
81
82   print OUT $magic or die $!;
83   print OUT pack("CCn", $major, $minor, $num_msgs) or die $!;
84
85   my $buff = '';
86
87   my $n;
88   for $n (0 .. $num_msgs - 1) {
89      my $msg = $$aref[$n];
90      if (!defined $msg) {
91         $msg = $$parentaref[$n] if defined $parentaref;
92         if (!defined $msg) {
93            $msg = ${$msgs{'en'}}[$n];
94            if (defined $msg && $msg ne '') {
95               # don't report if we have a parent (as the omission will be reported there)
96               print STDERR "Warning: message $n not in language $lang\n" unless defined $parentaref;
97            } else {
98               $msg = '';
99            }
100         }
101      }
102      $buff .= $msg . "\0";
103   }
104   
105   print OUT pack('N',length($buff)), $buff or die $!;
106   close OUT or die $!;
107}
108
109sub string_to_utf8 {
110   my $s = shift;
111   $s =~ s/[\x80-\xff]/char_to_utf8(ord($1))/eg;
112   $s =~ s/\&(#\d+|#x[a-f0-9]+|[a-z0-9]+);?/decode_entity($1)/eig;
113   return $s;
114}
115
116sub decode_entity {
117   my $ent = shift;
118   return char_to_utf8($1) if $ent =~ /^#(\d+)$/;
119   return char_to_utf8(hex($1)) if $ent =~ /^#x([a-f0-9]+)$/;
120   return char_to_utf8($ent{$ent}) if exists $ent{$ent};
121   $ent = "\&$ent;";
122   print STDERR "Warning: entity \"$ent\" unknown\n";
123   return $ent;
124}
125
126sub char_to_utf8 {
127   my $unicode = shift;
128   # ASCII is easy, and the most common case
129   return chr($unicode) if $unicode < 0x80;
130
131   my $result = '';
132   my $n = 0x20;
133   while (1) {
134      $result = chr(0x80 | ($unicode & 0x3f)) . $result;
135      $unicode >>= 6;
136      last if $unicode < $n;
137      $n >>= 1;
138   }
139   $result = chr((0x100 - $n*2) | $unicode) . $result;
140   return $result;
141}
Note: See TracBrowser for help on using the repository browser.