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