5 use Text::Balanced qw(extract_bracketed extract_delimited extract_tagged);
8 POSIX::setlocale(POSIX::LC_ALL, "C");
10 @ARGV >= 1 || die "Usage: $0 <source directory>\n";
39 if( open F, "find @ARGV -type f '(' -name '*.htm' -o -name '*.lua' -o -name '*.js' ')' | sort |" )
41 while( defined( my $file = readline F ) )
45 if( open S, "< $file" )
55 while( $text =~ s/ ^ (.*?) (?:translate|translatef|i18n|_) ([\n\s]*) \( /(/sgx )
57 my ($prefix, $suffix) = ($1, $2);
59 ( my $code, $text ) = extract_bracketed($text, q{('")});
61 $line += () = $prefix =~ /\n/g;
63 my $position = "$file:$line";
65 $line += () = $suffix =~ /\n/g;
66 $line += () = $code =~ /\n/g;
69 $code =~ s/^\([\n\s]*//;
70 $code =~ s/[\n\s]*\)$//;
75 if( $code =~ /^['"]/ )
79 ( $sub, $code ) = extract_delimited($code, q{'"}, q{\s*(?:\.\.\s*)?});
81 if( defined $sub && length($sub) > 2 )
83 $res .= substr $sub, 1, length($sub) - 2;
91 elsif( $code =~ /^(\[=*\[)/ )
93 my $stag = quotemeta $1;
97 ( $res ) = extract_tagged($code, $stag, $etag);
103 $res = dec_lua_str($res);
106 $stringtable{$res} ||= [ ];
107 push @{$stringtable{$res}}, $position;
115 while( $text =~ s/ ^ (.*?) <% -? [:_] /<%/sgx )
117 $line += () = $1 =~ /\n/g;
119 ( my $code, $text ) = extract_tagged($text, '<%', '%>');
123 my $position = "$file:$line";
125 $line += () = $code =~ /\n/g;
127 $code = dec_tpl_str(substr $code, 2, length($code) - 4);
129 $stringtable{$code} ||= [];
130 push @{$stringtable{$code}}, $position;
140 if( open C, "| msgcat -" )
142 printf C "msgid \"\"\nmsgstr \"Content-Type: text/plain; charset=UTF-8\"\n\n";
144 foreach my $key ( sort keys %stringtable )
148 my @positions = @{$stringtable{$key}};
155 printf C "#: %s\nmsgid \"%s\"\nmsgstr \"\"\n\n",
156 join(' ', @positions), $key;