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     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) {
 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) {
 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     if ($#_ < 1) {
 137         die "check_strs: expecting >= 2 strings";
 138     }
 139     if ((($_[0] eq '""') && ($_[1] =~ /Project-Id-Version:.*POT-Creation-Date:/s))
 140         or ($_[0] eq '"> and < scale by:"')) {
 141         # Not a Pango string.
 142         return 1;
 143     }
 144     foreach my $str (@_) {
 145         $str eq '""' or check_str($str) or return 0;
 146     }
 147     return 1;
 148 }
 149
 150 $/ = '';
 151
 152 # Reference for the markup language:
 153 # http://developer.gnome.org/doc/API/2.0/pango/PangoMarkupFormat.html
 154 # (though not all translation strings will be pango markup strings).
 155 ENTRY: while(<>) {
 156         if (m{\A${com}*\Z}) {
 157             next ENTRY;
 158         }
 159
 160         s/"\n"//g;
 161
 162         if (!m{\A${com}*msgid[^\n]*\n${com}*msgstr[^\n]*\n${com}*\Z} &&
 163             !m{\A${com}*msgid[^\n]*\n${com}*msgid_plural[^\n]*\n${com}*(msgstr\[[^\n]*\n${com}*)+\Z}) {
 164             po_error('Not in msg format');
 165             next ENTRY;
 166         }
 167         if (!m{\A${com}*msgid ${str}\s*\n${com}*msgstr ${str}\s*\n${com}*\Z} &&
 168                !m{\A${com}*msgid ${str}\s*\n${com}*msgid_plural ${str}\s*\n${com}*(msgstr\[\d+\] ${str}\s*\n${com}*)+\Z}) {
 169             po_error('Mismatched quotes');
 170             next ENTRY;
 171         }
 172
 173         if (m{\n\#,\ fuzzy}) {
 174             # Fuzzy entries aren't used, so ignore them.
 175             # (This prevents warnings about mismatching <>/ pattern.)
 176             next ENTRY;
 177         }
 178
 179         if (m{\A${com}*msgid\ (${str})\n
 180               ${com}*msgstr\ (${str})\n
 181               ${com}*\Z}x) {
 182             check_strs($1, $2) or next ENTRY;
 183         }
 184         elsif (m{\A${com}*msgid\ (${str})\n
 185                  ${com}*msgid_plural\ (${str})\n
 186                  ((?:${com}*msgstr\[\d+\]\ ${str}\n${com}*)+)\Z}x) {
 187             my ($s1, $s2, $rest) = ($1, $2, $3);
 188             my @strs = ($s1, $s2);
 189             while ($rest =~ s/\A${com}*msgstr\[\d+\]\ (${str})\n${com}*//) {
 190                 push @strs, ($1);
 191             }
 192             $rest eq '' or die "BUG: unparsed plural entries `$rest'";
 193             check_strs(@strs) or next ENTRY;
 194         }
 195         elsif (m{$str[ \t]}) {
 196             po_error('Trailing whitespace');
 197             next ENTRY;
 198         } else {
 199             po_error("parse error; may be a bug in po/check-markup");
 200         }
 201 }
 202
 203 # Some makefiles (currently the top-level Makefile.am) expect this script to
 204 # exit 1 if any problems found.
 205 exit $rc;