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 ($certainly_pango_str, $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     if (($str =~ m{&#[^0-9]+;}) or ($str =~ m{&#x[^0-9a-fA-F]+;})) {
  70         po_error("Entity declaration error (must look like '&#123;' or '&#x40;' and be in ASCII)");
  71         return 0;
  72     }
  73
  74     if (($str =~ m{&#[^0-9]+}) or ($str =~ m{&#x[^0-9a-fA-F]+})) {
  75         po_error("Entity declaration error 2 (must look like '&#123;' or '&#x40;' and be in ASCII)");
  76         return 0;
  77     }
  78
  79     if (($str =~ m{&#(?![0-9]{2,4};)}) or ($str =~ m{&#x(?![0-9a-fA-F]{2,4};)})) {
  80         po_error("Entity declaration error 3 (must look like '&#123;' or '&#x40;' and be in ASCII)");
  81         return 0;
  82     }
  83
  84     # Check for attributes etc. in non-<span> element.
  85     if ($str =~ m{<([bisu]|big|su[bp]|small|tt)\b(?! *)>}) {
  86         po_error("Unexpected characters in <$1> tag");
  87         return 0;
  88     }
  89
  90     if ($str =~ m{<([bisu]|big|su[bp]|small|span|tt)${attrsRE}>}) {
  91         po_error("unclosed <$1>");
  92         return 0;
  93     }
  94
  95     if ($str =~ m{</\ *([bisu]|big|su[bp]|small|span|tt)\ *>}) {
  96         po_error("Unmatched closing </$1>");
  97         return 0;
  98     }
  99
 100     if (!$is_xml and !$certainly_pango_str) {
 101         $str =~ s/<(?:defs|image|rect|svg)>//g;
 102         $str =~ s/<[ 01]//g;
 103         $str =~ s/\A>+//;
 104         $str =~ s/<+\Z//;
 105         $str =~ s/\([<>][01]\)//g;
 106         $str =~ s/ -> //g;
 107
 108         # Quoting.
 109         $str =~ s/\[[<>]\]//g;
 110         $str =~ s/\\"[<>]\\"//g;
 111         $str =~ s/\xe2\x80\x9e[<>]\xe2\x80\x9c//g;
 112         $str =~ s/\xc2\xab[<>]\xc2\xbb//;
 113     }
 114
 115     $str =~ s/\A[^<>]*//;
 116     $str =~ s/[^<>]*\Z//;
 117
 118     if ($str =~ /\A([<>])\Z/) {
 119         if ($is_xml or $certainly_pango_str) {
 120             po_error("Unescaped `$1'");
 121             return 0;
 122         } else {
 123             return 1;
 124         }
 125     }
 126
 127     if ($str ne '') {
 128         po_error("parsing error for `$str'");
 129         return 0;
 130     }
 131
 132     return 1;
 133 }
 134
 135 sub check_strs ($@) {
 136     my $is_pango_str = shift(@_);
 137     if ($#_ < 1) {
 138         die "check_strs: expecting >= 2 strings";
 139     }
 140     if ((($_[0] eq '""') && ($_[1] =~ /Project-Id-Version:.*POT-Creation-Date:/s))
 141     or ($_[0] eq '"> and < scale by:"')
 142     or $is_pango_str == 0)
 143     {
 144         # Not a Pango string.
 145         return 1;
 146     }
 147     foreach my $str (@_) {
 148         $str eq '""' or check_str($is_pango_str - 1, $str) or return 0;
 149     }
 150     return 1;
 151 }
 152
 153 $/ = '';
 154
 155 # Reference for the markup language:
 156 # http://developer.gnome.org/doc/API/2.0/pango/PangoMarkupFormat.html
 157 # (though not all translation strings will be pango markup strings).
 158 ENTRY: while(<>) {
 159         if (m{\A${com}*\Z}) {
 160             next ENTRY;
 161         }
 162
 163         # Concatenate multi-line string literals.
 164         s/"\n\s*"//g;
 165
 166         if (!m{\A${com}*
 167                (?:msgctxt[^\n]*\n)?
 168                msgid[^\n]*\n
 169                ${com}*
 170                (?:
 171                    msgstr[^\n]*\n
 172                    ${com}*
 173                  | msgid_plural[^\n]*\n
 174                    ${com}*
 175                    (?:msgstr\[[^\n]*\n${com}*)+
 176                 )\Z}x)
 177         {
 178             po_error('Not in msg format');
 179             next ENTRY;
 180         }
 181         if (!m{
 182                 \A${com}*
 183                 (?:msgctxt\ ${str}\s*\n)?
 184                 msgid\ ${str}\s*\n
 185                 ${com}*
 186                 (?:
 187                     msgstr\ ${str}\s*\n
 188                     ${com}*
 189                   | msgid_plural\ ${str}\s*\n
 190                     ${com}*
 191                     (?:msgstr\[\d+\]\ ${str}\s*\n${com}*)+
 192                 )\Z}x)
 193         {
 194             po_error('Mismatched quotes');
 195             next ENTRY;
 196         }
 197
 198         if (m{\n\#(?:,\ [-a-z0-9]+)*,\ fuzzy}) {
 199             # Fuzzy entries aren't used, so ignore them.
 200             # (This prevents warnings about mismatching <>/ pattern.)
 201             next ENTRY;
 202         }
 203
 204         # 0 for known not pango format, 2 for known pango format.
 205         my $is_pango_format = 1;
 206         if (m{\n\#\.\ .*\bxgettext:(no-)?pango-format\s}) {
 207             $is_pango_format = ( defined($1) ? 0 : 2 );
 208         }
 209         if (m{\n\#(?:,\ [-a-z0-9+])*,\ (no-)?pango-format[,\n]}) {
 210             $is_pango_format = ( defined($1) ? 0 : 2 );
 211         }
 212         if (m{\n\#:\ \.\./share/extensions/[-a-zA-Z0-9_]+\.(?:inx|py)(?:\.h)?:}) {
 213             $is_pango_format = 0;
 214         }
 215
 216         if (m{\A
 217                 ${com}*
 218                 (?:msgctxt\ ${str}\s*\n)?
 219                 msgid\ (${str})\n
 220                 ${com}*
 221                 msgstr\ (${str})\n
 222                 ${com}*
 223               \Z}x)
 224         {
 225             check_strs($is_pango_format, $1, $2) or next ENTRY;
 226         }
 227         elsif (m{\A
 228                    ${com}*
 229                    (?:msgctxt\ ${str}\s*\n)?
 230                    msgid\ (${str})\n
 231                    ${com}*
 232                    msgid_plural\ (${str})\n
 233                    ((?:${com}*msgstr\[\d+\]\ ${str}\n${com}*)+)
 234                  \Z}x)
 235         {
 236             my ($s1, $s2, $rest) = ($1, $2, $3);
 237             my @strs = ($s1, $s2);
 238             while ($rest =~ s/\A${com}*msgstr\[\d+\]\ (${str})\n${com}*//) {
 239                 push @strs, ($1);
 240             }
 241             $rest eq '' or die "BUG: unparsed plural entries `$rest'";
 242             check_strs($is_pango_format, @strs) or next ENTRY;
 243         }
 244         elsif (m{$str[ \t]}) {
 245             po_error('Trailing whitespace');
 246             next ENTRY;
 247         } else {
 248             po_error("parse error; may be a bug in po/check-markup");
 249         }
 250 }
 251
 252 # Some makefiles (currently the top-level Makefile.am) expect this script to
 253 # exit 1 if any problems found.
 254 exit $rc;
 255
 256
 257 # vi: set autoindent shiftwidth=4 tabstop=8 encoding=utf-8 softtabstop=4 filetype=perl :