diff options
Diffstat (limited to 'markup/pod-samples/pod/live-manual/tools/bin/po-lint.pl')
| -rwxr-xr-x | markup/pod-samples/pod/live-manual/tools/bin/po-lint.pl | 173 |
1 files changed, 173 insertions, 0 deletions
diff --git a/markup/pod-samples/pod/live-manual/tools/bin/po-lint.pl b/markup/pod-samples/pod/live-manual/tools/bin/po-lint.pl new file mode 100755 index 0000000..7503e77 --- /dev/null +++ b/markup/pod-samples/pod/live-manual/tools/bin/po-lint.pl @@ -0,0 +1,173 @@ +#!/usr/bin/env perl +# +# po-lint - structural checks on sisu markup translations +# +# A translator working in a .po file is editing markup, not only prose, and +# the ways that goes wrong are few and specific. Each rule here was measured +# against live-manual's nine languages before being included: the errors +# fired twice over 10,134 entries, and both hits were real defects. +# +# usage: po-lint.pl ../po4a/po/*/*.po +# po-lint.pl (defaults to ../po4a/po/*/*.po) +# +# exit 0 no errors (warnings do not fail) +# exit 1 at least one error +# +# ERRORS, which change the document's structure and so its object numbering: +# +# empty-after-trim a msgstr that is whitespace only. sisu reads a +# whitespace-only line as blank, so the paragraph ceases +# to exist and every object number after it shifts. Leave +# the msgstr empty instead: untranslated falls back to +# the source text, and the object survives. This is the +# defect that cost ja two objects from ocn 818 onward. +# heading-mismatch heading markup on one side and not the other. A +# paragraph translated as "2~ Something" becomes a +# heading, and the document grows a section the source +# does not have. This is the pl defect at ocn 312. +# blank-line a blank line added or removed inside a msgstr, which +# splits one object into two or joins two into one. +# yaml-key a document header entry whose yaml keys differ from the +# source. The header is configuration: translate the +# values, never the keys. po4a's text module cannot tell +# a header from prose and will offer the keys for +# translation, so this one is easy to trip. +# +# WARNINGS, which change what the text says or links to but not its shape: +# +# var a ${...} substitution differs. These are filled in by +# the build; a translated variable name is never filled. +# anchor a {text}#anchor target differs. Translate the text, +# never the anchor, or the link goes nowhere. +# markup-mono #{...}# count differs +# markup-bold *{...}* count differs +# markup-ital /{...}/ count differs +# +# Entries marked fuzzy are skipped: fuzzy already means "not used, needs +# review", and po4a will not put one in the output. Checking them reports +# faults nobody is relying on. +# +use strict; +use warnings; +use utf8; +binmode(STDOUT, ":encoding(UTF-8)"); +binmode(STDERR, ":encoding(UTF-8)"); + +my @files = @ARGV ? @ARGV : glob("../po4a/po/*/*.po"); +unless (@files) { die "po-lint: no .po files given and none at ../po4a/po/*/*.po\n" } + +my %ERR = map { $_ => 1 } + qw(empty-after-trim heading-mismatch blank-line yaml-key); + +my (%count, @hits, $entries, $skipped); + +for my $file (@files) { + open my $fh, "<:encoding(UTF-8)", $file or do { warn "po-lint: $file: $!\n"; next }; + my (@id, @str, $mode, $fuzzy, $line, @ents); + my $flush = sub { + push @ents, { line => $line, id => join("", @id), str => join("", @str), fuzzy => $fuzzy } + if $mode; + @id = (); @str = (); $mode = ""; $fuzzy = 0; + }; + while (my $l = <$fh>) { + chomp $l; + if ($l =~ /^#,.*\bfuzzy\b/) { $fuzzy = 1 } + elsif ($l =~ /^#/) { } + elsif ($l =~ /^msgid\s+"(.*)"$/) { @id = ($1); @str = (); $mode = "id"; $line = $. } + elsif ($l =~ /^msgstr\s+"(.*)"$/) { @str = ($1); $mode = "str" } + elsif ($l =~ /^"(.*)"$/ && $mode) { $mode eq "id" ? push @id, $1 : push @str, $1 } + elsif ($l =~ /^\s*$/) { $flush->() } + } + $flush->(); + close $fh; + + for my $e (@ents) { + my ($a, $b) = (unesc($e->{id}), unesc($e->{str})); + next if $a eq "" or $b eq ""; # untranslated, or the po header + if ($e->{fuzzy}) { $skipped++; next } + $entries++; + my @found; + + push @found, ["empty-after-trim", "msgstr is whitespace only; leave it empty to fall back"] + if $b =~ /^\s*$/; + + my $ah = ($a =~ /^:?[0-9A-D]~/) ? 1 : 0; + my $bh = ($b =~ /^:?[0-9A-D]~/) ? 1 : 0; + push @found, ["heading-mismatch", $ah ? "source is a heading, translation is not" + : "translation is a heading, source is not"] + if $ah != $bh; + + push @found, ["blank-line", "blank lines within the entry differ, splitting or joining objects"] + if cnt($a, qr/\n\n/) != cnt($b, qr/\n\n/); + + # ↓ only in a master file's catalogue. A document header lives in the + # master, .ssm or .sst, and nowhere else, so restricting by file is + # exact where guessing from shape is not: the style guide has prose + # reading "produces: *{foo}* or !{foo}!", which any shape test takes + # for a yaml key. That gave twenty false positives and no true ones. + if ($file =~ /\.(?:ssm|sst)\.po$/) { + if (my @ka = yaml_keys($a)) { + my @kb = yaml_keys($b); + push @found, ["yaml-key", "header keys differ: [@ka] against [@kb]"] + if join("|", @ka) ne join("|", @kb); + } + } + + push @found, ["var", "\${} substitutions differ"] + if setof($a, qr/(\$\{[a-z_]+\})/) ne setof($b, qr/(\$\{[a-z_]+\})/); + + push @found, ["anchor", "link anchors differ"] + if anchors($a) ne anchors($b); + + for my $m (["mono", qr/#\{/], ["bold", qr/\*\{/], ["ital", qr/\/\{/]) { + push @found, ["markup-$m->[0]", "$m->[0] markup count differs"] + if cnt($a, $m->[1]) != cnt($b, $m->[1]); + } + + for my $f (@found) { + $count{$f->[0]}++; + push @hits, sprintf("%-16s %-7s %s:%d\n %s\n source: %.60s", + $f->[0], ($ERR{$f->[0]} ? "ERROR" : "warning"), $file, $e->{line}, $f->[1], oneline($a)); + } + } +} + +print "$_\n" for @hits; +print "\n"; +printf "checked %d translated entries, %d fuzzy skipped\n", $entries // 0, $skipped // 0; +my $errors = 0; +for my $k (sort keys %count) { + printf " %-16s %-7s %d\n", $k, ($ERR{$k} ? "ERROR" : "warning"), $count{$k}; + $errors += $count{$k} if $ERR{$k}; +} +print " (clean)\n" unless %count; +exit($errors ? 1 : 0); + +sub unesc { + my $s = shift; + $s =~ s/\\n/\n/g; $s =~ s/\\t/\t/g; $s =~ s/\\"/"/g; $s =~ s/\\\\/\\/g; + return $s; +} +sub cnt { my ($t, $re) = @_; my $c = 0; $c++ while $t =~ /$re/g; return $c } +sub setof { my ($t, $re) = @_; my @m = ($t =~ /$re/g); return join "|", sort @m } +sub oneline { my $s = shift; $s =~ s/\n/ /g; return $s } +sub anchors { + my @a = ($_[0] =~ /\}#([A-Za-z0-9_.-]+)/g); + s/[.,;:!?]+$// for @a; # a full stop after a link is prose + return join "|", sort @a; +} +# ↓ the yaml keys of a document header entry, empty for anything that is not +# one. A header entry is a line, or block of lines, of "key:" or " key:"; +# prose does not look like that, and a heading never does. +sub yaml_keys { + my @lines = split /\n/, $_[0]; + my @keys; + for my $l (@lines) { + return () if $l =~ /^:?[0-9A-D]~/; # a heading, not a header + next if $l =~ /^\s*$/; + if ($l =~ /^(\s*)([a-z][a-z0-9_]*):(?:\s|$)/) { push @keys, "$1$2" } + elsif ($l =~ /^\s*#/) { next } # a comment in the header + else { return () } # a line that is not a key: prose + } + return @keys; +} |