build/i18n-scan.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5 use Text::Balanced qw(extract_codeblock);
   6
   7 @ARGV == 1 || die "Usage: $0 <source direcory>\n";
   8
   9
  10 sub _parse
  11 {
  12         my ( $code ) = @_;
  13         my ( $k, $v );
  14
  15         if( $code =~ s/^<%:-?\s*(.+)\s*%>/$1/s )
  16         {
  17                 my ( $key, @text ) = split /[\n\s]+/, $code;
  18
  19                 $k = $key;
  20                 $v = join ' ', @text;
  21         }
  22         elsif( $code =~ s/^\(\s*(.+)\s*\)/$1/s )
  23         {
  24                 if( $code =~ /^(?:"(\w+)"|'(\w+)')\s*,\s*(?:"(.+?)"|'(.+?)')/s )
  25                 {
  26                         $k = $1 || $2;
  27                         $v = $3 || $4 || '';
  28                         $v =~ s/\s+/ /sg;
  29                 }
  30                 elsif( $code =~ /^(?:"(\w+)"|'(\w+)')/ )
  31                 {
  32                         $k = $1 || $2;
  33                         $v = '';
  34                 }
  35                 else
  36                 {
  37                         return ();
  38                 }
  39         }
  40         else
  41         {
  42                 return ();
  43         }
  44
  45         $v =~ s/\\"/"/g;
  46         $v =~ s/"/\\"/g;
  47
  48         return ( $k, $v );
  49 }
  50
  51
  52 if( open F, "find $ARGV[0] -type f -name '*.htm' -or -name '*.lua' |" )
  53 {
  54         while( defined( my $file = readline F ) )
  55         {
  56                 chomp $file;
  57
  58                 if( open S, "< $file" )
  59                 {
  60                         my $text = '';
  61                         $text .= $_ foreach( readline S );
  62
  63                         while(
  64                                 $text =~ s/
  65                                         ^ .*?
  66                                         (?:
  67                                                 (?: translate f? | i18n )
  68                                                 [\s\n]* ( \( )
  69                                         |
  70                                                 ( \<%: -? )
  71                                         )
  72                                 /$1 || $2/segx
  73                         ) {
  74                                 my $code;
  75
  76                                 ( $code, $text ) = extract_codeblock( $text, '', '^', '()' );
  77                                 if( ! $code ) {
  78                                         ( $code, $text ) = extract_codeblock( $text, '', '^', '<>' );
  79                                 }
  80
  81                                 if( ! $code ) {
  82                                         # Corner case:
  83                                         $text =~ s/(#[^\n]*)%>/$1\n%>/;
  84                                         ( $code, $text ) = extract_codeblock( $text, '<>', '^' );
  85                                         if( ! $code ) {
  86                                                 last;
  87                                         }
  88                                 }
  89
  90                                 my ( $k, $v ) = _parse( $code );
  91                                 if( $k && defined($v) )
  92                                 {
  93                                         if( $v )
  94                                         {
  95                                                 printf "#. %s\n", $v || $k;
  96                                         }
  97
  98                                         printf "msgid \"%s\"\nmsgstr \"%s\"\n\n",
  99                                                 $k, $v;
 100                                 }
 101                         }
 102
 103                         close S;
 104                 }
 105         }
 106
 107         close F;
 108 }