Code

Other patch by Johan to comment out a warning. Thanks Johan!
[inkscape.git] / po / check-markup
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 ($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 '&#123;' or '&#x40;' 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 '&#123;' or '&#x40;' 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 '&#123;' or '&#x40;' 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) {
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) {
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;
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;
150 $/ = '';
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         }
160         s/"\n"//g;
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         }
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         }
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         }
203 # Some makefiles (currently the top-level Makefile.am) expect this script to
204 # exit 1 if any problems found.
205 exit $rc;