1 #! /usr/bin/perl -w
2 # Try to detect markup errors in translations.
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.
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.)
17 use strict;
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)\=\\\"[^\\\"]*\\\")/;
24 my $rc = 0;
26 sub po_error ($) {
27 my ($msg) = @_;
28 my $name = $ARGV;
29 $name =~ s,.*/,,;
30 print "$name: $msg:\n$_";
31 $rc = 1;
32 }
34 # Returns true iff successful.
35 sub check_str ($$) {
36 my ($certainly_pango_str, $str) = @_;
38 $str =~ s/\A"// or die "Bug: No leading `\"' in `$str'";
39 $str =~ s/"\Z// or die "Bug: No trailing `\"' in `$str'";
41 if ($str =~ /\AProject-Id-Version:.*POT-Creation-Date/
42 or $str =~ /\A<[^<>]*>\Z/) {
43 # Not a Pango string.
44 return 1;
45 }
47 my $is_xml = 0;
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 }
69 if (($str =~ m{&#[^0-9]+;}) or ($str =~ m{&#x[^0-9a-fA-F]+;})) {
70 po_error("Entity declaration error (must look like '{' or '@' and be in ASCII)");
71 return 0;
72 }
74 if (($str =~ m{&#[^0-9]+}) or ($str =~ m{&#x[^0-9a-fA-F]+})) {
75 po_error("Entity declaration error 2 (must look like '{' or '@' and be in ASCII)");
76 return 0;
77 }
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 '{' or '@' and be in ASCII)");
81 return 0;
82 }
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 }
90 if ($str =~ m{<([bisu]|big|su[bp]|small|span|tt)${attrsRE}>}) {
91 po_error("unclosed <$1>");
92 return 0;
93 }
95 if ($str =~ m{</\ *([bisu]|big|su[bp]|small|span|tt)\ *>}) {
96 po_error("Unmatched closing </$1>");
97 return 0;
98 }
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;
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 }
115 $str =~ s/\A[^<>]*//;
116 $str =~ s/[^<>]*\Z//;
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 }
127 if ($str ne '') {
128 po_error("parsing error for `$str'");
129 return 0;
130 }
132 return 1;
133 }
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 }
153 $/ = '';
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 }
163 # Concatenate multi-line string literals.
164 s/"\n\s*"//g;
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 }
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 }
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 }
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 }
252 # Some makefiles (currently the top-level Makefile.am) expect this script to
253 # exit 1 if any problems found.
254 exit $rc;
257 # vi: set autoindent shiftwidth=4 tabstop=8 encoding=utf-8 softtabstop=4 filetype=perl :