OSDN Git Service

luci-app-turboacc: fix typo
[immortalwrt/luci.git] / 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|description)")\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' -o -path '*/acl.d/*.json' -o -path '*/statistics/plugins/*.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 }