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

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

configure.in,lib/Makefile.am,lib/po-to-msg.pl: Fix .msg file
generation to work when srcdir != builddir. Drop the "dontextract"
mechanism which automatically generates headers to allows building a
version with translations for the messages for errors in loading the
messages file, as it doesn't seem worth the effort to get it working
again. It's easy to write such a header by hand if you really want
to do this.

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

  • Property mode set to 100755
File size: 7.3 KB
RevLine 
[d86459c]1#!/usr/bin/perl -w
2require 5.008;
3use bytes;
4use strict;
5use Locale::PO;
6
7use integer;
8
9# Magic identifier (12 bytes)
10my $magic = "Svx\nMsg\r\n\xfe\xff\0";
11# Designed to be corrupted by ASCII ftp, top bit stripping (or
12# being used for parity).  Contains a zero byte so more likely
13# to be flagged as data (e.g. by perl's "-B" test).
14
[c584ed2]15my $srcdir = $0;
16$srcdir =~ s!/[^/]+$!!;
17
[d86459c]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] = '©';
33
34# my %uses = ();
35
[c584ed2]36my $num_list = Locale::PO->load_file_asarray("$srcdir/codes.po");
[d86459c]37my $curmsg = -1;
38foreach my $po_entry (@{$num_list}) {
39    my $msgno = $po_entry->dequote($po_entry->msgstr);
40    next if $msgno !~ /^\d+$/;
41    if ($msgno < $curmsg) {
42        print STDERR "Warning: message number jumps back from $curmsg to $msgno\n";
43    }
44    my $key = $po_entry->msgid;
45    my $msg = c_unescape($po_entry->dequote($key));
[c584ed2]46    if (${$msgs{'en'}}[$msgno]) {
47        print STDERR "Warning: already had message $msgno for language 'en'\n";
[d86459c]48    }
[c584ed2]49    ${$msgs{'en'}}[$msgno] = $msg;
[d86459c]50}
51
[c584ed2]52for my $po_file (@ARGV) {
53    my $language = $po_file;
[d86459c]54    $language =~ s/\.po$//;
55
[c584ed2]56    my $po_hash = Locale::PO->load_file_ashash("$srcdir/$po_file");
[d86459c]57
58    foreach my $po_entry (@{$num_list}) {
59        my $msgno = $po_entry->dequote($po_entry->msgstr);
60        next if $msgno !~ /^\d+$/;
61        my $key = $po_entry->msgid;
62        my $ent = $$po_hash{$key};
63        if (defined $ent) {
64            my $msg = c_unescape($po_entry->dequote($ent->msgstr));
65            next if $msg eq '';
[c584ed2]66            if (${$msgs{$language}}[$msgno]) {
67                print STDERR "Warning: already had message $msgno for language $language\n";
[d86459c]68            }
[c584ed2]69            ${$msgs{$language}}[$msgno] = $msg;
[d86459c]70        }
71    }
72
73#       local $_;
[c584ed2]74#       open FINDUSES, "grep -no '*/$msgno\\>' \Q$srcdir\E/../src/*.cc \Q$srcdir\E../src/*.c \Q$srcdir\E/../src/*.h|" or die $!;
[d86459c]75#       while (<FINDUSES>) {
76#          push @{$uses{$msgno}}, $1 if /^([^:]*:\d+):/;
77#       }
78#       close FINDUSES;
79
80}
81
82my $lang;
83my @langs = sort grep ! /_\*$/, keys %msgs;
84
85my $num_msgs = -1;
86foreach $lang (@langs) {
87   my $aref = $msgs{$lang};
88   $num_msgs = scalar @$aref if scalar @$aref > $num_msgs;
89   unlink "$lang.todo";
90}
91
92foreach $lang (@langs) {
93   my $fnm = $lang;
94   $fnm =~ s/(_.*)$/\U$1/;
95   open OUT, ">$fnm.msg" or die $!;
96
97   my $aref = $msgs{$lang};
98
99   my $parentaref;
100   my $mainlang = $lang;
101   $parentaref = $msgs{$mainlang} if $mainlang =~ s/_.*$//;
102
103   print OUT $magic or die $!;
104   print OUT pack("CCn", $major, $minor, $num_msgs) or die $!;
105
106   my $buff = '';
107   my $missing = 0;
108   my $retranslate = 0;
109
110   for my $n (0 .. $num_msgs - 1) {
111      my $warned = 0;
112      my $msg = $$aref[$n];
113      if (!defined $msg) {
114         $msg = $$parentaref[$n] if defined $parentaref;
115         if (!defined $msg) {
116            $msg = ${$msgs{'en'}}[$n];
117            # don't report if we have a parent (as the omission will be
118            # reported there)
119            if (defined $msg && $msg ne '' && !defined $parentaref) {
120               ++$missing;
121               $warned = 1;
122            } else {
123               $msg = '' if !defined $msg;
124            }
125         }
126      } else {
127         if ($lang ne 'en') {
128             sanity_check("Message $n in language $lang", $msg, ${$msgs{'en'}}[$n]);
129         }
130      }
131      $buff .= $msg . "\0";
132   }
133
134   print OUT pack('N',length($buff)), $buff or die $!;
135   close OUT or die $!;
136
137   if ($missing || $retranslate) {
138       print STDERR "Warning: ";
139       if ($missing) {
140           print STDERR "$lang: $missing missing message(s)";
141           if ($retranslate) {
142               print STDERR " and $retranslate requiring retranslation";
143           }
144       } else {
145           print STDERR "$lang: $retranslate message(s) requiring retranslation";
146       }
147       print STDERR "\n";
148   }
149}
150
151sub sanity_check {
152   my ($where, $msg, $orig) = @_;
153   # check printf-like specifiers match
154   # allow valid printf specifiers, or %<any letter> to support strftime
155   # and other printf-like formats.
156   my @pcent_m = grep /\%/, split /(%(?:[-#0 +'I]*(?:[0-9]*|\*|\*m\$)(?:\.[0-9]*)?(?:hh|ll|[hlLqjzt])?[diouxXeEfFgGaAcsCSpn]|[a-zA-Z]))/, $msg;
157   my @pcent_o = grep /\%/, split /(%(?:[-#0 +'I]*(?:[0-9]*|\*|\*m\$)(?:\.[0-9]*)?(?:hh|ll|[hlLqjzt])?[diouxXeEfFgGaAcsCSpn]|[a-zA-Z]))/, $orig;
158   while (scalar @pcent_m || scalar @pcent_o) {
159       if (!scalar @pcent_m) {
160           print STDERR "Warning: $where misses out \%spec $pcent_o[0]\n";
161       } elsif (!scalar @pcent_o) {
162           print STDERR "Warning: $where has extra \%spec $pcent_m[0]\n";
163       } elsif ($pcent_m[0] ne $pcent_o[0]) {
164           print STDERR "Warning: $where has \%spec $pcent_m[0] instead of $pcent_o[0]\n";
165       }
166       pop @pcent_m;
167       pop @pcent_o;
168   }
169
170   # Check for missing (or added) ellipses (...)
171   if ($msg =~ /\.\.\./ && $orig !~ /\.\.\./) {
172       print STDERR "Warning: $where has ellipses but original doesn't\n";
173   } elsif ($msg !~ /\.\.\./ && $orig =~ /\.\.\./) {
174       print STDERR "Warning: $where is missing ellipses\n";
175   }
176
177   # Check for missing (or added) menu shortcut (@)
178   if ($msg =~ /\@[A-Za-z]/ && $orig !~ /\@[A-Za-z]/) {
179       print STDERR "Warning: $where has menu shortcut but original doesn't\n";
180   } elsif ($msg !~ /\@[A-Za-z]/ && $orig =~ /\@[A-Za-z]/) {
181       print STDERR "Warning: $where is missing menu shortcut\n";
182   }
183
184   # Check for missing (or added) menu shortcut (&)
185   if ($msg =~ /\&[A-Za-z]/ && $orig !~ /\&[A-Za-z]/) {
186       print STDERR "Warning: $where has menu shortcut but original doesn't\n";
187   } elsif ($msg !~ /\&[A-Za-z]/ && $orig =~ /\&[A-Za-z]/) {
188       print STDERR "Warning: $where is missing menu shortcut\n";
189   }
190
191   # Check for missing (or added) menu accelerator "##"
192   if ($msg =~ /\#\#/ && $orig !~ /\#\#/) {
193       print STDERR "Warning: $where has menu accelerator but original doesn't\n";
194   } elsif ($msg !~ /\#\#/ && $orig =~ /\#\#/) {
195       print STDERR "Warning: $where is missing menu accelerator\n";
196   } elsif ($orig =~ /\#\#(.*)/) {
197       my $acc_o = $1;
198       my ($acc_m) = $msg =~ /\#\#(.*)/;
199       if ($acc_o ne $acc_m) {
200           print STDERR "Warning: $where has menu accelerator $acc_m instead of $acc_o\n";
201       }
202   }
203
204   # Check for missing (or added) menu accelerator "\t"
205   if ($msg =~ /\t/ && $orig !~ /\t/) {
206       print STDERR "Warning: $where has menu accelerator but original doesn't\n";
207   } elsif ($msg !~ /\t/ && $orig =~ /\t/) {
208       print STDERR "Warning: $where is missing menu accelerator\n";
209   } elsif ($orig =~ /\t(.*)/) {
210       my $acc_o = $1;
211       my ($acc_m) = $msg =~ /\t(.*)/;
212       if ($acc_o ne $acc_m) {
213           print STDERR "Warning: $where has menu accelerator $acc_m instead of $acc_o\n";
214       }
215   }
216}
217
218sub c_unescape {
219   my $str = shift @_;
220   $str =~ s/\\(x..|0|[0-7][0-7][0-7]|.)/&c_unescape_char($1)/ge;
221   return $str;
222}
223
224sub c_unescape_char {
225    my $ch = shift @_;
226    if ($ch eq '0' || $ch eq 'x00' || $ch eq '000') {
227        print STDERR "Nul byte in translation! (\\$ch)\n";
228        exit(1);
229    }
230    return $ch if $ch eq '"' || $ch eq '\\';
231    return "\n" if $ch eq "n";
232    return "\t" if $ch eq "t";
233    return "\r" if $ch eq "r";
234    return "\f" if $ch eq "f";
235    return chr(hex(substr($ch,1))) if $ch =~ /^x../;
236    return chr(oct($ch)) if $ch =~ /^[0-7][0-7][0-7]/;
237    print STDERR "Unknown C-escape in translation! (\\$ch)\n";
238    exit(1);
239}
Note: See TracBrowser for help on using the repository browser.