use strict;
use warnings;
-use Text::Balanced qw(extract_codeblock);
+use IPC::Open2;
+use POSIX;
-@ARGV == 1 || die "Usage: $0 <source direcory>\n";
+$ENV{'LC_ALL'} = 'C';
+POSIX::setlocale(POSIX::LC_ALL, 'C');
+@ARGV >= 1 || die "Usage: $0 <source directory>\n";
-sub _parse
-{
- my ( $code ) = @_;
- my ( $k, $v );
-
- if( $code =~ s/^<%:-?\s*(.+)\s*%>/$1/s )
- {
- my ( $key, @text ) = split /[\n\s]+/, $code;
- $k = $key;
- $v = join ' ', @text;
+my %keywords = (
+ '.js' => [ '_:1', '_:1,2c', 'N_:2,3', 'N_:2,3,4c' ],
+ '.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' ],
+ '.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' ],
+ '.json' => [ '_:1', '_:1,2c' ]
+);
+
+sub xgettext($@) {
+ my $path = shift;
+ my @keywords = @_;
+ my ($ext) = $path =~ m!(\.\w+)$!;
+ my @cmd = qw(xgettext --from-code=UTF-8 --no-wrap);
+
+ if ($ext eq '.htm' || $ext eq '.lua') {
+ push @cmd, '--language=Lua';
}
- elsif( $code =~ s/^\(\s*(.+)\s*\)/$1/s )
- {
- if( $code =~ /^(?:"(\w+)"|'(\w+)')\s*,\s*(?:"(.+?)"|'(.+?)')/s )
- {
- $k = $1 || $2;
- $v = $3 || $4 || '';
- $v =~ s/\s+/ /sg;
+ elsif ($ext eq '.js' || $ext eq '.json') {
+ push @cmd, '--language=JavaScript';
+ }
+
+ push @cmd, map { "--keyword=$_" } (@{$keywords{$ext}}, @keywords);
+ push @cmd, '-o', '-';
+
+ return @cmd;
+}
+
+sub whitespace_collapse($) {
+ my $s = shift;
+ my %r = ('n' => ' ', 't' => ' ');
+
+ # Translate \t and \n to plain spaces, leave all other escape
+ # sequences alone. Finally replace all consecutive spaces by
+ # single ones and trim leading and trailing space.
+ $s =~ s/\\(.)/$r{$1} || "\\$1"/eg;
+ $s =~ s/ {2,}/ /g;
+ $s =~ s/^ //;
+ $s =~ s/ $//;
+
+ return $s;
+}
+
+sub postprocess_pot($$) {
+ my ($path, $source) = @_;
+ my (@res, $msgid);
+ my $skip = 1;
+
+ $source =~ s/^#: (.+?)\n/join("\n", map { "#: $path:$_" } $1 =~ m!:(\d+)!g) . "\n"/emg;
+
+ my @lines = split /\n/, $source;
+
+ # Remove all header lines up to the first location comment
+ while (@lines > 0 && $lines[0] !~ m!^#: !) {
+ shift @lines;
+ }
+
+ while (@lines > 0) {
+ my $line = shift @lines;
+
+ # Concat multiline msgids and collapse whitespaces
+ if ($line =~ m!^(msg\w+) "(.*)"$!) {
+ my $kw = $1;
+ my $kv = $2;
+
+ while (@lines > 0 && $lines[0] =~ m!^"(.*)"$!) {
+ $kv .= ' '. $1;
+ shift @lines;
+ }
+
+ $kv = whitespace_collapse($kv);
+
+ # Filter invalid empty msgids by popping all lines in @res
+ # leading to this point and skip all subsequent lines in
+ # @lines belonging to this faulty id.
+ if ($kw ne 'msgstr' && $kv eq '') {
+ while (@res > 0 && $res[-1] !~ m!^$!) {
+ pop @res;
+ }
+
+ while (@lines > 0 && $lines[0] =~ m!^(?:msg\w+ )?"(.*)"$!) {
+ shift @lines;
+ }
+
+ next;
+ }
+
+ push @res, sprintf '%s "%s"', $kw, $kv;
}
- elsif( $code =~ /^(?:"(\w+)"|'(\w+)')/ )
- {
- $k = $1 || $2;
- $v = '';
+
+ # Ignore any flags added by xgettext
+ elsif ($line =~ m!^#, !) {
+ next;
}
- else
- {
- return ();
+
+ # Pass through other lines unmodified
+ else {
+ push @res, $line;
}
}
- else
- {
- return ();
- }
- $v =~ s/\\"/"/g;
- $v =~ s/"/\\"/g;
-
- return ( $k, $v );
+ return @res ? join("\n", '', @res, '') : '';
+}
+
+sub uniq(@) {
+ my %h = map { $_, 1 } @_;
+ return sort keys %h;
}
+sub preprocess_htm($$) {
+ my ($path, $source) = @_;
+ my $sub = {
+ '=' => '(%s)',
+ '_' => 'translate([==[%s]==])',
+ ':' => 'translate([==[%s]==])',
+ '+' => 'include([==[%s]==])',
+ '#' => '--[==[%s]==]',
+ '' => '%s'
+ };
-if( open F, "find $ARGV[0] -type f -name '*.htm' -or -name '*.lua' |" )
+ # Translate the .htm source into a valid Lua source using bracket quotes
+ # to avoid the need for complex escaping.
+ $source =~ s!<%-?([=_:+#]?)(.*?)-?%>!
+ my $t = $1;
+ my $s = $2;
+
+ # Split translation expressions on first non-escaped pipe.
+ if ($t eq ':' || $t eq '_') {
+ $s =~ s/^((?:[^\|\\]|\\.)*)\|(.*)$/$1]==],[==[$2/;
+ }
+
+ sprintf "]==]; $sub->{$t}; [==[", $s
+ !sge;
+
+ # Discover expressions like "lng.translate(...)" or "luci.i18n.translate(...)"
+ # and return them as extra keyword so that xgettext recognizes such expressions
+ # as translate(...) calls.
+ my @extra_function_keywords =
+ map { ("$_:1", "$_:1,2c") }
+ uniq($source =~ m!((?:\w+\.)+translatef?)[ \t\n]*\(!g);
+
+ return ("[==[$source]==]", @extra_function_keywords);
+}
+
+sub preprocess_lua($$) {
+ my ($path, $source) = @_;
+
+ # Discover expressions like "lng.translate(...)" or "luci.i18n.translate(...)"
+ # and return them as extra keyword so that xgettext recognizes such expressions
+ # as translate(...) calls.
+ my @extra_function_keywords =
+ map { ("$_:1", "$_:1,2c") }
+ uniq($source =~ m!((?:\w+\.)+translatef?)[ \t\n]*\(!g);
+
+ return ($source, @extra_function_keywords);
+}
+
+sub preprocess_json($$) {
+ my ($path, $source) = @_;
+ my ($file) = $path =~ m!([^/]+)$!;
+
+ $source =~ s/("(?:title|description)")\s*:\s*("(?:[^"\\]|\\.)*")/$1: _($2)/sg;
+
+ return ($source);
+}
+
+
+my ($msguniq_in, $msguniq_out);
+my $msguniq_pid = open2($msguniq_out, $msguniq_in, 'msguniq', '-s');
+
+print $msguniq_in "msgid \"\"\nmsgstr \"Content-Type: text/plain; charset=UTF-8\"\n";
+
+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' ')' |")
{
- while( defined( my $file = readline F ) )
+ while (defined( my $file = readline F))
{
chomp $file;
- if( open S, "< $file" )
+ if (open S, '<', $file)
{
- my $text = '';
- $text .= $_ foreach( readline S );
-
- while(
- $text =~ s/
- ^ .*?
- (?:
- (?: translate f? | i18n )
- [\s\n]* ( \( )
- |
- ( \<%: -? )
- )
- /$1 || $2/segx
- ) {
- my $code;
-
- ( $code, $text ) = extract_codeblock( $text, '', '^', '()' );
- if( ! $code ) {
- ( $code, $text ) = extract_codeblock( $text, '', '^', '<>' );
- }
+ local $/ = undef;
+ my $source = <S>;
+ my @extra_function_keywords;
- if( ! $code ) {
- # Corner case:
- $text =~ s/(#[^\n]*)%>/$1\n%>/;
- ( $code, $text ) = extract_codeblock( $text, '<>', '^' );
- if( ! $code ) {
- last;
- }
- }
+ if ($file =~ m!\.htm$!)
+ {
+ ($source, @extra_function_keywords) = preprocess_htm($file, $source);
+ }
+ elsif ($file =~ m!\.lua$!)
+ {
+ ($source, @extra_function_keywords) = preprocess_lua($file, $source);
+ }
+ elsif ($file =~ m!\.json$!)
+ {
+ ($source, @extra_function_keywords) = preprocess_json($file, $source);
+ }
- my ( $k, $v ) = _parse( $code );
- if( $k && defined($v) )
- {
- if( $v )
- {
- printf "#. %s\n", $v || $k;
- }
+ my ($xgettext_in, $xgettext_out);
+ my $pid = open2($xgettext_out, $xgettext_in, xgettext($file, @extra_function_keywords), '-');
- printf "msgid \"%s\"\nmsgstr \"%s\"\n\n",
- $k, $v;
- }
- }
+ print $xgettext_in $source;
+ close $xgettext_in;
- close S;
+ my $pot = readline $xgettext_out;
+ close $xgettext_out;
+
+ waitpid $pid, 0;
+
+ print $msguniq_in postprocess_pot($file, $pot);
}
}
close F;
}
+
+close $msguniq_in;
+
+my @pot = <$msguniq_out>;
+
+close $msguniq_out;
+waitpid $msguniq_pid, 0;
+
+while (@pot > 0) {
+ my $line = shift @pot;
+
+ # Reorder the location comments in a detemrinistic way to
+ # reduce SCM noise when frequently updating templates.
+ if ($line =~ m!^#: !) {
+ my @locs = ($line);
+
+ while (@pot > 0 && $pot[0] =~ m!^#: !) {
+ push @locs, shift @pot;
+ }
+
+ print
+ map { join(':', @$_) . "\n" }
+ sort { ($a->[0] cmp $b->[0]) || ($a->[1] <=> $b->[1]) }
+ map { [ /^(.+):(\d+)$/ ] }
+ @locs
+ ;
+
+ next;
+ }
+
+ print $line;
+}