po/check-markup

   1 #! /usr/bin/perl -w
   2 # Try to detect markup errors in translations.
   3
   4 # Author: Peter Moulder <pmoulder@mail.csse.monash.edu.au>
   5 # Copyright (C) 2004 Monash University
   6 # License: GNU GPL v2 or (at your option) any later version.
   7
   8 # Initial egrep version:
   9 #mydir=`dirname "$0"`
  10 #egrep '<b>[^<>]*(>|<([^/]|/([^b"]|b[^>])))' "$mydir"/*.po
  11 # Somewhat simplified by use of negative lookahead in perl.
  12 # (The egrep version as written can't detect problems that span a line,
  13 # e.g. unterminated `<b>'.  One way of doing the s/"\n"//g thing would be with
  14 # tr and sed, but that requires a sed that allows arbitrary line lengths, which
  15 # many non-GNU seds don't.)
  16
  17 use strict;
  18
  19 my $com = qr/(?:\#[^\n]*\n)/;
  20 my $str = qr/(?:"(?:[^"\\]|\\.)*")/;
  21 my $attrsRE = qr/(?: +[^<>]*)?/;
  22 my $span_attr = qr/(?:\ +(?:font_(?:desc|family)|face|size|style|weight|variant|stretch|(?:fore|back)ground|underline|rise|strikethrough|fallback|lang)\=\\\"[^\\\"]*\\\")/;
  23
  24 my $rc = 0;
  25
  26 sub po_error ($) {
  27     my ($msg) = @_;
  28     my $name = $ARGV;
  29     $name =~ s,.*/,,;
  30     print "$name: $msg:\n$_";
  31     $rc = 1;
  32 }
  33
  34 # Returns true iff successful.
  35 sub check_str ($) {
  36     my ($str) = @_;
  37
  38     $str =~ s/\A"// or die "Bug: No leading `\"' in `$str'";
  39     $str =~ s/"\Z// or die "Bug: No trailing `\"' in `$str'";
  40
  41     if ($str =~ /\AProject-Id-Version:.*POT-Creation-Date/
  42         or $str =~ /\A<[^<>]*>\Z/) {
  43         # Not a Pango string.
  44         return 1;
  45     }
  46
  47     my $is_xml = 0;
  48
  49     # Remove valid sequences.
  50     while ($str =~ s{<([bisu]|big|su[bp]|small|tt|span)(${attrsRE})>[^<>]*</\1>}{}) {
  51         $is_xml = 1;
  52         my ($tag, $attrs) = ($1, $2);
  53         if ($tag eq 'span') {
  54             $attrs =~ s/${span_attr}*//g;
  55             if ($attrs ne '') {
  56                 $attrs =~ s/\A *//;
  57                 $attrs =~ s/\\"/"/g;
  58                 po_error("Unexpected <span> attributes `$attrs'");
  59                 return 0;
  60             }
  61         } else {
  62             if ($attrs !~ /\A *\Z/) {
  63                 po_error("<$tag> can't have attributes in Pango");
  64                 return 0;
  65             }
  66         }
  67     }
  68
  69     # Check for attributes etc. in non-<span> element.
  70     if ($str =~ m{<([bisu]|big|su[bp]|small|tt)\b(?! *)>}) {
  71         po_error("Unexpected characters in <$1> tag");
  72         return 0;
  73     }
  74
  75     if ($str =~ m{<([bisu]|big|su[bp]|small|span|tt)${attrsRE}>}) {
  76         po_error("unclosed <$1>");
  77         return 0;
  78     }
  79
  80     if ($str =~ m{</\ *([bisu]|big|su[bp]|small|span|tt)\ *>}) {
  81         po_error("Unmatched closing </$1>");
  82         return 0;
  83     }
  84
  85     if (!$is_xml) {
  86         $str =~ s/<(?:defs|image|rect|svg)>//g;
  87         $str =~ s/<[ 01]//g;
  88         $str =~ s/\A>+//;
  89         $str =~ s/<+\Z//;
  90         $str =~ s/\([<>][01]\)//g;
  91         $str =~ s/ -> //g;
  92
  93         # Quoting.
  94         $str =~ s/\[[<>]\]//g;
  95         $str =~ s/\\"[<>]\\"//g;
  96         $str =~ s/\xe2\x80\x9e[<>]\xe2\x80\x9c//g;
  97         $str =~ s/\xc2\xab[<>]\xc2\xbb//;
  98     }
  99
 100     $str =~ s/\A[^<>]*//;
 101     $str =~ s/[^<>]*\Z//;
 102
 103     if ($str =~ /\A([<>])\Z/) {
 104         if ($is_xml) {
 105             po_error("Unescaped `$1'");
 106             return 0;
 107         } else {
 108             return 1;
 109         }
 110     }
 111
 112     if ($str ne '') {
 113         po_error("parsing error for `$str'");
 114         return 0;
 115     }
 116
 117     return 1;
 118 }
 119
 120 sub check_strs (@) {
 121     if ($#_ < 1) {
 122         die "check_strs: expecting >= 2 strings";
 123     }
 124     if ((($_[0] eq '""') && ($_[1] =~ /Project-Id-Version:.*POT-Creation-Date:/s))
 125         or ($_[0] eq '"> and < scale by:"')) {
 126         # Not a Pango string.
 127         return 1;
 128     }
 129     foreach my $str (@_) {
 130         $str eq '""' or check_str($str) or return 0;
 131     }
 132     return 1;
 133 }
 134
 135 $/ = '';
 136
 137 # Reference for the markup language:
 138 # http://developer.gnome.org/doc/API/2.0/pango/PangoMarkupFormat.html
 139 # (though not all translation strings will be pango markup strings).
 140 ENTRY: while(<>) {
 141         if (m{\A${com}*\Z}) {
 142             next ENTRY;
 143         }
 144
 145         s/"\n"//g;
 146
 147         if (!m{\A${com}*msgid[^\n]*\n${com}*msgstr[^\n]*\n${com}*\Z} &&
 148             !m{\A${com}*msgid[^\n]*\n${com}*msgid_plural[^\n]*\n${com}*(msgstr\[[^\n]*\n${com}*)+\Z}) {
 149             po_error('Not in msg format');
 150             next ENTRY;
 151         }
 152         if (!m{\A${com}*msgid ${str}\s*\n${com}*msgstr ${str}\s*\n${com}*\Z} &&
 153                !m{\A${com}*msgid ${str}\s*\n${com}*msgid_plural ${str}\s*\n${com}*(msgstr\[\d+\] ${str}\s*\n${com}*)+\Z}) {
 154             po_error('Mismatched quotes');
 155             next ENTRY;
 156         }
 157
 158         if (m{\n\#,\ fuzzy}) {
 159             # Fuzzy entries aren't used, so ignore them.
 160             # (This prevents warnings about mismatching <>/ pattern.)
 161             next ENTRY;
 162         }
 163
 164         if (m{\A${com}*msgid\ (${str})\n
 165               ${com}*msgstr\ (${str})\n
 166               ${com}*\Z}x) {
 167             check_strs($1, $2) or next ENTRY;
 168         }
 169         elsif (m{\A${com}*msgid\ (${str})\n
 170                  ${com}*msgid_plural\ (${str})\n
 171                  ((?:${com}*msgstr\[\d+\]\ ${str}\n${com}*)+)\Z}x) {
 172             my ($s1, $s2, $rest) = ($1, $2, $3);
 173             my @strs = ($s1, $s2);
 174             while ($rest =~ s/\A${com}*msgstr\[\d+\]\ (${str})\n${com}*//) {
 175                 push @strs, ($1);
 176             }
 177             $rest eq '' or die "BUG: unparsed plural entries `$rest'";
 178             check_strs(@strs) or next ENTRY;
 179         }
 180         elsif (m{$str[ \t]}) {
 181             po_error('Trailing whitespace');
 182             next ENTRY;
 183         } else {
 184             po_error("parse error; may be a bug in po/check-markup");
 185         }
 186 }
 187
 188 # Some makefiles (currently the top-level Makefile.am) expect this script to
 189 # exit 1 if any problems found.
 190 exit $rc;