source: git/lib/makemsgs.pl @ adaa778

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

Initial revision

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

  • Property mode set to 100755
File size: 3.0 KB
Line 
1#!/usr/bin/perl -w
2require 5.004;
3use strict;
4
5use integer;
6
7# Magic identifier (12 bytes)
8my $magic = "Svx\n\Msg\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 ($lang, $msgno, $dummy, $msg) = /^([-\w]+):\s*(\d+)\s+("?)(.*)\3/;
43
44   unless (defined $lang) {
45      chomp;
46      print STDERR "Warning: Bad line: \"$_\"\n";
47      next;
48   }
49
50   if ($msg =~ /[\0-\x1f\x7f-\xff]/) {
51      print STDERR "Warning: literal character in message $msgno\n";
52   }
53
54   ${$msgs{$lang}}[$msgno] = string_to_utf8($msg);
55}
56
57my $lang;
58my @langs = sort keys %msgs;
59
60my $num_msgs = -1;
61foreach $lang (@langs) {
62   my $aref = $msgs{$lang};
63   $num_msgs = scalar @$aref if scalar @$aref > $num_msgs;
64}
65
66foreach $lang (@langs) {
67   open OUT, ">$lang.msg" or die $!;
68   
69   my $aref = $msgs{$lang};
70 
71   my $parentaref;
72   my $mainlang = $lang;
73   $parentaref = $msgs{$mainlang} if $mainlang =~ s/-.*$//;
74
75   print OUT $magic or die $!;
76   print OUT pack("CCn", $major, $minor, $num_msgs) or die $!;
77
78   my $buff = '';
79
80   my $n;
81   for $n (0 .. $num_msgs - 1) {
82      my $msg = $$aref[$n];
83      if (!defined $msg) {
84         $msg = $$parentaref[$n] if defined $parentaref;
85         if (!defined $msg) {
86            $msg = ${$msgs{'en'}}[$n];
87            if (defined $msg && $msg ne '') {
88               print STDERR "Warning: message $n not in language $lang\n";
89            } else {
90               $msg = '';
91            }
92         }
93      }
94      $buff .= $msg . "\0";
95   }
96   
97   print OUT pack('N',length($buff)), $buff or die $!;
98   close OUT or die $!;
99}
100
101sub string_to_utf8 {
102   my $s = shift;
103   $s =~ s/[\x80-\xff]/char_to_utf8(ord$1)/eg;
104   $s =~ s/\&(#\d+|#x[a-f0-9]+|[a-z0-9]+);?/decode_entity($1)/eig;
105   return $s;
106}
107
108sub decode_entity {
109   my $ent = shift;
110   return char_to_utf8($1) if $ent =~ /^#(\d+)$/;
111   return char_to_utf8(hex($1)) if $ent =~ /^#x([a-f0-9]+)$/;
112   return char_to_utf8($ent{$ent}) if exists $ent{$ent};
113   $ent = "\&$ent;";
114   print STDERR "Warning: entity \"$ent\" unknown\n";
115   return $ent;
116}
117
118sub char_to_utf8 {
119   my $unicode = shift;
120   # ASCII is easy, and the most common case
121   return chr($unicode) if $unicode < 0x80;
122
123   my $result = '';
124   my $n = 0x20;
125   while (1) {
126      $result = chr(0x80 | ($unicode & 0x3f)) . $result;
127      $unicode >>= 6;
128      last if $unicode < $n;
129      $n >>= 1;
130   }
131   $result = chr((0x100 - $n*2) | $unicode) . $result;
132   return $result;
133}
Note: See TracBrowser for help on using the repository browser.