i18n-scan.pl 2.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128
  1. #!/usr/bin/perl
  2. use strict;
  3. use warnings;
  4. use Text::Balanced qw(extract_bracketed extract_delimited extract_tagged);
  5. @ARGV >= 1 || die "Usage: $0 <source direcory>\n";
  6. my %stringtable;
  7. sub dec_lua_str
  8. {
  9. my $s = shift;
  10. $s =~ s/[\s\n]+/ /g;
  11. $s =~ s/\\n/\n/g;
  12. $s =~ s/\\t/\t/g;
  13. $s =~ s/\\(.)/$1/g;
  14. $s =~ s/^ //;
  15. $s =~ s/ $//;
  16. return $s;
  17. }
  18. sub dec_tpl_str
  19. {
  20. my $s = shift;
  21. $s =~ s/-$//;
  22. $s =~ s/[\s\n]+/ /g;
  23. $s =~ s/^ //;
  24. $s =~ s/ $//;
  25. $s =~ s/\\/\\\\/g;
  26. return $s;
  27. }
  28. if( open F, "find @ARGV -type f '(' -name '*.html' -o -name '*.lua' ')' |" )
  29. {
  30. while( defined( my $file = readline F ) )
  31. {
  32. chomp $file;
  33. if( open S, "< $file" )
  34. {
  35. local $/ = undef;
  36. my $raw = <S>;
  37. close S;
  38. my $text = $raw;
  39. while( $text =~ s/ ^ .*? (?:translate|translatef|i18n|_) [\n\s]* \( /(/sgx )
  40. {
  41. ( my $code, $text ) = extract_bracketed($text, q{('")});
  42. $code =~ s/\\\n/ /g;
  43. $code =~ s/^\([\n\s]*//;
  44. $code =~ s/[\n\s]*\)$//;
  45. my $res = "";
  46. my $sub = "";
  47. if( $code =~ /^['"]/ )
  48. {
  49. while( defined $sub )
  50. {
  51. ( $sub, $code ) = extract_delimited($code, q{'"}, q{\s*(?:\.\.\s*)?});
  52. if( defined $sub && length($sub) > 2 )
  53. {
  54. $res .= substr $sub, 1, length($sub) - 2;
  55. }
  56. else
  57. {
  58. undef $sub;
  59. }
  60. }
  61. }
  62. elsif( $code =~ /^(\[=*\[)/ )
  63. {
  64. my $stag = quotemeta $1;
  65. my $etag = $stag;
  66. $etag =~ s/\[/]/g;
  67. ( $res ) = extract_tagged($code, $stag, $etag);
  68. $res =~ s/^$stag//;
  69. $res =~ s/$etag$//;
  70. }
  71. $res = dec_lua_str($res);
  72. $stringtable{$res}++ if $res;
  73. }
  74. $text = $raw;
  75. while( $text =~ s/ ^ .*? <% -? [:_] /<%/sgx )
  76. {
  77. ( my $code, $text ) = extract_tagged($text, '<%', '%>');
  78. if( defined $code )
  79. {
  80. $code = dec_tpl_str(substr $code, 2, length($code) - 4);
  81. $stringtable{$code}++;
  82. }
  83. }
  84. }
  85. }
  86. close F;
  87. }
  88. if( open C, "| msgcat -" )
  89. {
  90. printf C "msgid \"\"\nmsgstr \"Content-Type: text/plain; charset=UTF-8\"\n\n";
  91. foreach my $key ( sort keys %stringtable )
  92. {
  93. if( length $key )
  94. {
  95. $key =~ s/"/\\"/g;
  96. printf C "msgid \"%s\"\nmsgstr \"\"\n\n", $key;
  97. }
  98. }
  99. close C;
  100. }