build/i18n-scan.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5 use IPC::Open2;
   6 use POSIX;
   7
   8 $ENV{'LC_ALL'} = 'C';
   9 POSIX::setlocale(POSIX::LC_ALL, 'C');
  10
  11 @ARGV >= 1 || die "Usage: $0 <source directory>\n";
  12
  13
  14 my %keywords = (
  15         '.js' => [ '_:1', '_:1,2c', 'N_:2,3', 'N_:2,3,4c' ],
  16         '.lua' => [ '_:1', '_:1,2c', 'translate:1', 'translate:1,2c', 'translatef:1', 'N_:2,3', 'N_:2,3,4c', 'ntranslate:2,3', 'ntranslate:2,3,4c' ],
  17         '.htm' => [ '_:1', '_:1,2c', 'translate:1', 'translate:1,2c', 'translatef:1', 'N_:2,3', 'N_:2,3,4c', 'ntranslate:2,3', 'ntranslate:2,3,4c' ],
  18         '.json' => [ '_:1', '_:1,2c' ]
  19 );
  20
  21 sub xgettext($@) {
  22         my $path = shift;
  23         my @keywords = @_;
  24         my ($ext) = $path =~ m!(\.\w+)$!;
  25         my @cmd = qw(xgettext --from-code=UTF-8 --no-wrap);
  26
  27         if ($ext eq '.htm' || $ext eq '.lua') {
  28                 push @cmd, '--language=Lua';
  29         }
  30         elsif ($ext eq '.js' || $ext eq '.json') {
  31                 push @cmd, '--language=JavaScript';
  32         }
  33
  34         push @cmd, map { "--keyword=$_" } (@{$keywords{$ext}}, @keywords);
  35         push @cmd, '-o', '-';
  36
  37         return @cmd;
  38 }
  39
  40 sub whitespace_collapse($) {
  41         my $s = shift;
  42         my %r = ('n' => ' ', 't' => ' ');
  43
  44         # Translate \t and \n to plain spaces, leave all other escape
  45         # sequences alone. Finally replace all consecutive spaces by
  46         # single ones and trim leading and trailing space.
  47         $s =~ s/\\(.)/$r{$1} || "\\$1"/eg;
  48         $s =~ s/ {2,}/ /g;
  49         $s =~ s/^ //;
  50         $s =~ s/ $//;
  51
  52         return $s;
  53 }
  54
  55 sub postprocess_pot($$) {
  56         my ($path, $source) = @_;
  57         my (@res, $msgid);
  58         my $skip = 1;
  59
  60         $source =~ s/^#: (.+?)\n/join("\n", map { "#: $path:$_" } $1 =~ m!:(\d+)!g) . "\n"/emg;
  61
  62         my @lines = split /\n/, $source;
  63
  64         # Remove all header lines up to the first location comment
  65         while (@lines > 0 && $lines[0] !~ m!^#: !) {
  66                 shift @lines;
  67         }
  68
  69         while (@lines > 0) {
  70                 my $line = shift @lines;
  71
  72                 # Concat multiline msgids and collapse whitespaces
  73                 if ($line =~ m!^(msg\w+) "(.*)"$!) {
  74                         my $kw = $1;
  75                         my $kv = $2;
  76
  77                         while (@lines > 0 && $lines[0] =~ m!^"(.*)"$!) {
  78                                 $kv .= ' '. $1;
  79                                 shift @lines;
  80                         }
  81
  82                         $kv = whitespace_collapse($kv);
  83
  84                         # Filter invalid empty msgids by popping all lines in @res
  85                         # leading to this point and skip all subsequent lines in
  86                         # @lines belonging to this faulty id.
  87                         if ($kw ne 'msgstr' && $kv eq '') {
  88                                 while (@res > 0 && $res[-1] !~ m!^$!) {
  89                                         pop @res;
  90                                 }
  91
  92                                 while (@lines > 0 && $lines[0] =~ m!^(?:msg\w+ )?"(.*)"$!) {
  93                                         shift @lines;
  94                                 }
  95
  96                                 next;
  97                         }
  98
  99                         push @res, sprintf '%s "%s"', $kw, $kv;
 100                 }
 101
 102                 # Ignore any flags added by xgettext
 103                 elsif ($line =~ m!^#, !) {
 104                         next;
 105                 }
 106
 107                 # Pass through other lines unmodified
 108                 else {
 109                         push @res, $line;
 110                 }
 111         }
 112
 113         return @res ? join("\n", '', @res, '') : '';
 114 }
 115
 116 sub uniq(@) {
 117         my %h = map { $_, 1 } @_;
 118         return sort keys %h;
 119 }
 120
 121 sub preprocess_htm($$) {
 122         my ($path, $source) = @_;
 123         my $sub = {
 124                 '=' => '(%s)',
 125                 '_' => 'translate([==[%s]==])',
 126                 ':' => 'translate([==[%s]==])',
 127                 '+' => 'include([==[%s]==])',
 128                 '#' => '--[==[%s]==]',
 129                 ''  => '%s'
 130         };
 131
 132         # Translate the .htm source into a valid Lua source using bracket quotes
 133         # to avoid the need for complex escaping.
 134         $source =~ s!<%-?([=_:+#]?)(.*?)-?%>!
 135                 my $t = $1;
 136                 my $s = $2;
 137
 138                 # Split translation expressions on first non-escaped pipe.
 139                 if ($t eq ':' || $t eq '_') {
 140                         $s =~ s/^((?:[^\|\\]|\\.)*)\|(.*)$/$1]==],[==[$2/;
 141                 }
 142
 143                 sprintf "]==]; $sub->{$t}; [==[", $s
 144         !sge;
 145
 146         # Discover expressions like "lng.translate(...)" or "luci.i18n.translate(...)"
 147         # and return them as extra keyword so that xgettext recognizes such expressions
 148         # as translate(...) calls.
 149         my @extra_function_keywords =
 150                 map { ("$_:1", "$_:1,2c") }
 151                 uniq($source =~ m!((?:\w+\.)+translatef?)[ \t\n]*\(!g);
 152
 153         return ("[==[$source]==]", @extra_function_keywords);
 154 }
 155
 156 sub preprocess_lua($$) {
 157         my ($path, $source) = @_;
 158
 159         # Discover expressions like "lng.translate(...)" or "luci.i18n.translate(...)"
 160         # and return them as extra keyword so that xgettext recognizes such expressions
 161         # as translate(...) calls.
 162         my @extra_function_keywords =
 163                 map { ("$_:1", "$_:1,2c") }
 164                 uniq($source =~ m!((?:\w+\.)+translatef?)[ \t\n]*\(!g);
 165
 166         return ($source, @extra_function_keywords);
 167 }
 168
 169 sub preprocess_json($$) {
 170         my ($path, $source) = @_;
 171         my ($file) = $path =~ m!([^/]+)$!;
 172
 173         $source =~ s/("(?:title)")\s*:\s*("(?:[^"\\]|\\.)*")/$1: _($2)/sg;
 174
 175         return ($source);
 176 }
 177
 178
 179 my ($msguniq_in, $msguniq_out);
 180 my $msguniq_pid = open2($msguniq_out, $msguniq_in, 'msguniq', '-s');
 181
 182 print $msguniq_in "msgid \"\"\nmsgstr \"Content-Type: text/plain; charset=UTF-8\"\n";
 183
 184 if (open F, "find @ARGV -type f '(' -name '*.htm' -o -name '*.lua' -o -name '*.js' -o -path '*/menu.d/*.json' ')' |")
 185 {
 186         while (defined( my $file = readline F))
 187         {
 188                 chomp $file;
 189
 190                 if (open S, '<', $file)
 191                 {
 192                         local $/ = undef;
 193                         my $source = <S>;
 194                         my @extra_function_keywords;
 195
 196                         if ($file =~ m!\.htm$!)
 197                         {
 198                                 ($source, @extra_function_keywords) = preprocess_htm($file, $source);
 199                         }
 200                         elsif ($file =~ m!\.lua$!)
 201                         {
 202                                 ($source, @extra_function_keywords) = preprocess_lua($file, $source);
 203                         }
 204                         elsif ($file =~ m!\.json$!)
 205                         {
 206                                 ($source, @extra_function_keywords) = preprocess_json($file, $source);
 207                         }
 208
 209                         my ($xgettext_in, $xgettext_out);
 210                         my $pid = open2($xgettext_out, $xgettext_in, xgettext($file, @extra_function_keywords), '-');
 211
 212                         print $xgettext_in $source;
 213                         close $xgettext_in;
 214
 215                         my $pot = readline $xgettext_out;
 216                         close $xgettext_out;
 217
 218                         waitpid $pid, 0;
 219
 220                         print $msguniq_in postprocess_pot($file, $pot);
 221                 }
 222         }
 223
 224         close F;
 225 }
 226
 227 close $msguniq_in;
 228
 229 my @pot = <$msguniq_out>;
 230
 231 close $msguniq_out;
 232 waitpid $msguniq_pid, 0;
 233
 234 while (@pot > 0) {
 235         my $line = shift @pot;
 236
 237         # Reorder the location comments in a detemrinistic way to
 238         # reduce SCM noise when frequently updating templates.
 239         if ($line =~ m!^#: !) {
 240                 my @locs = ($line);
 241
 242                 while (@pot > 0 && $pot[0] =~ m!^#: !) {
 243                         push @locs, shift @pot;
 244                 }
 245
 246                 print
 247                         map { join(':', @$_) . "\n" }
 248                         sort { ($a->[0] cmp $b->[0]) || ($a->[1] <=> $b->[1]) }
 249                         map { [ /^(.+):(\d+)$/ ] }
 250                         @locs
 251                 ;
 252
 253                 next;
 254         }
 255
 256         print $line;
 257 }