chiark / gitweb /
changelog: finalise 9.9
[dgit.git] / po4a / pairwise-pocheck
1 #!/usr/bin/tclsh
2 #
3 # We check each tranlated message against its original,
4 # making certain consistency checks.
5
6 # In theory this would be easy: we could read the .po file
7 # directly.  But the format of the .po file is not documented.
8 # Looking at the source code for the po parser in GNU gettext,
9 # the syntax is complicated with a wide variety of escapes.
10 #
11 # So I would prefer to reuse the gettext parser.  That means getting
12 # the output from gettext in some other format.  Most of the gettext
13 # utilities output in annoying formats.  The least annoying seems
14 # to be to use msgfmt to generate a tcl file (!)
15
16 # usage:
17 #   cd po4a
18 #   ./pairwise-potcheck [LANG]
19
20 proc badusage {} {
21     puts stderr "usage: ./pairwise-pocheck [LANG]"
22     exit 1
23 }
24
25 set lang *
26
27 set bad 0
28
29 proc bad {emsg} {
30     global po for_emsg bad
31     puts stderr "$po: $emsg $for_emsg"
32     incr bad
33 }
34
35 proc check_equal {desc script} {
36     upvar 1 m m
37     foreach is {id str} {
38         set m [uplevel 1 [list set msg$is]]
39         set m$is $m
40         set r$is [uplevel 1 $script]
41     }
42     if {![string compare $rid $rstr]} { return 0 }
43     bad "mismatch $rid != $rstr $desc"
44 }
45
46 # called directly by msgfmt output
47 namespace eval ::msgcat {
48     proc mcset {lang msgid msgstr} {
49         check_msg $msgid $msgstr
50     }
51 }
52
53 proc check_msg {msgid msgstr} {
54     global for_emsg
55     set for_emsg "msgid=[list $msgid] msgstr=[list $msgstr]"
56     check_equal "un-escaped non-pod < count (missing B or I?)" {
57         regexp -all {(?:^!(?!\b[IBCLEFSXZ]).)\<} $m
58     }
59 }
60
61 proc check {} {
62     # msgfmt --tcl wants to use a pretty much fixed filename:
63     # you get to specify part of it but it has to look like a
64     # locale.  But we can specify ya directory to use, so
65     # one directory per po it is!
66     global po
67     set vexdir ".$po.pwpc.tmp"
68     set vexleaf xx.msg
69     set vexfile $vexdir/$vexleaf
70     file mkdir $vexdir
71     file delete $vexfile
72     exec msgfmt -d$vexdir -lxx --tcl $po
73
74     # and then we execute it!
75     source $vexfile
76 }
77
78 proc parseargs {} {
79     global argv lang
80     switch -glob [llength $argv].$argv {
81         0. { }
82         1.-* { badusage }
83         1.* { set lang [lindex $argv 0] }
84         * { badusage }
85     }
86 }    
87
88 proc iterate {} {
89     global po lang
90     
91     foreach po [lsort [glob -nocomplain *.$lang.po]] {
92         check
93         puts "pairwise-pocheck $po ok."
94     }
95 }
96
97 proc report {} {
98     global bad
99     if {$bad} {
100         puts stderr "pairwise-pocheck: $bad errors"
101         exit 1
102     }
103 }
104
105 parseargs
106 iterate
107 report