5 use Text::Balanced qw(extract_tagged gen_delimited_pat);
8 POSIX::setlocale(POSIX::LC_ALL, "C");
10 @ARGV >= 1 || die "Usage: $0 <source directory>\n";
38 if( open F, "find @ARGV -type f '(' -name '*.htm' -o -name '*.lua' -o -name '*.js' ')' | sort |" )
40 while( defined( my $file = readline F ) )
44 if( open S, "< $file" )
53 while ($text =~ s/ ^ (.*?) (?:translate|translatef|i18n|_) ([\n\s]*) \( //sgx)
55 my ($prefix, $suffix) = ($1, $2);
60 $line += () = $prefix =~ /\n/g;
62 my $position = "$file:$line";
64 $line += () = $suffix =~ /\n/g;
70 if ($text =~ /^ ([\n\s]*(?:\.\.[\n\s]*)?) (\[=*\[) /sx)
73 my $stag = quotemeta $2;
74 (my $etag = $stag) =~ y/[/]/;
76 ($sub, $text) = extract_tagged($text, $stag, $etag, q{\s*(?:\.\.\s*)?});
78 $line += () = $ws =~ /\n/g;
80 if (defined($sub) && length($sub)) {
81 $line += () = $sub =~ /\n/g;
88 elsif ($text =~ /^ ([\n\s]*(?:\.\.[\n\s]*)?) (['"]) /sx)
92 my $re = gen_delimited_pat($quote, '\\');
94 if ($text =~ m/\G\s*(?:\.\.\s*)?($re)/gcs)
97 $text = substr $text, pos $text;
100 $line += () = $ws =~ /\n/g;
102 if (defined($sub) && length($sub)) {
103 $line += () = $sub =~ /\n/g;
114 $res = dec_lua_str($res);
117 $stringtable{$res} ||= [ ];
118 push @{$stringtable{$res}}, $position;
127 while( $text =~ s/ ^ (.*?) <% -? [:_] /<%/sgx )
129 $line += () = $1 =~ /\n/g;
131 ( my $code, $text ) = extract_tagged($text, '<%', '%>');
135 my $position = "$file:$line";
137 $line += () = $code =~ /\n/g;
139 $code = dec_tpl_str(substr $code, 2, length($code) - 4);
141 $stringtable{$code} ||= [];
142 push @{$stringtable{$code}}, $position;
152 if( open C, "| msgcat -" )
154 printf C "msgid \"\"\nmsgstr \"Content-Type: text/plain; charset=UTF-8\"\n\n";
156 foreach my $key ( sort keys %stringtable )
160 my @positions = @{$stringtable{$key}};
167 printf C "#: %s\nmsgid \"%s\"\nmsgstr \"\"\n\n",
168 join(' ', @positions), $key;