bin/ttxgettext

   1 #! /usr/bin/perl -w
   2
   3 use strict;
   4 use Getopt::Std;
   5
   6 use vars qw($opt_p);
   7
   8 my $messages = {};
   9 my @msgids = ();
  10
  11 my $domain = shift @ARGV;
  12
  13 sub escape {
  14         my $text = shift;
  15         $text =~ s/\\/\\\\/g;
  16         $text =~ s/"/\\"/g;
  17         $text =~ s/\n/\\n/g;
  18         $text =~ s/\t/\\t/g;
  19         return $text;
  20 }
  21
  22 sub countNewline {
  23         my $text = shift;
  24         return ($text =~ s/\n//g);
  25 }
  26
  27 sub processFile {
  28         my $file = shift;
  29         my $prefix = shift;
  30         my ($text, $lineno, $comment, $nextlineno, $msgid);
  31         my (@messages) = ();
  32         my (%msgids) = ();
  33         my $repl = '';
  34
  35         open(IN, "< $file") || die "Unable to open $file\n";
  36         local ($/) = undef;
  37         $text = <IN>;
  38         close(IN);
  39
  40         if ($prefix =~ s/=(.*)//) {
  41                 $repl = $1;
  42         }
  43         $file =~ s{^$prefix}{$repl}o unless $prefix eq '__';
  44         #  Remove comments if they contain <gettext> or </gettext>
  45         $text =~ s/^[ \t]*#.*<\/?gettext\b//mg;
  46         $lineno = 1;
  47         while ($text =~ m{\G(.*?)(<gettext\b(?:\s+domain="([^"]+)")?[^>]*>)(.*?)</gettext>}gs) { # " -- to fix vim syntax hilighting :)
  48                 $msgid = escape($4);
  49                 $lineno += countNewline ($1.$2);
  50                 $nextlineno = countNewline ($4);;
  51                 my $dom = ($3) ? $3 : 'templates';
  52                 if ($domain ne $dom) {
  53                    $lineno += $nextlineno;
  54                    next;  # wrong domain
  55                 }
  56                 $comment = '';
  57                 if ($1 =~ m/(((^|\n)[ \t]*#.*)+)\n?[^\n]*$/) {
  58                         $comment = $1;
  59                         $comment =~ s/^\s+#\s*//;
  60                         $comment =~ s/\n[ \t]*#\s*/\n/g;
  61                 }
  62                 push (@msgids, $msgid);
  63                 if (defined ($messages->{$msgid})) {
  64                         print STDERR "wmlxgettext: Warning: msgid multiple defined:\n\t".
  65                                 $msgid."\n";
  66                 } else {
  67                         $messages->{$msgid} = [];
  68                 }
  69                 push (@{$messages->{$msgid}}, $comment, $file, $lineno);
  70                 $lineno += $nextlineno;
  71         }
  72 }
  73
  74 $opt_p = '__';
  75 getopt('p');
  76
  77 foreach (@ARGV) {
  78         processFile($_, $opt_p);
  79 }
  80
  81 print "msgid \"\"\nmsgstr \"\"\n".
  82         "\"Content-Type: text/plain; charset=ASCII\\n\"\n".
  83         "\"Content-Transfer-Encoding: 8bit\\n\"\n\n";
  84
  85 foreach my $msgid (@msgids) {
  86         next unless $messages->{$msgid};
  87         while (@{$messages->{$msgid}}) {
  88                 $_ = shift(@{$messages->{$msgid}});
  89                 s/\n/\n#. /g;
  90                 print "#. ".$_."\n" if $_;
  91                 print "#: ".shift(@{$messages->{$msgid}}).":".
  92                             shift(@{$messages->{$msgid}})."\n";
  93         }
  94         print "msgid \"$msgid\"\nmsgstr \"\"\n\n";
  95         undef $messages->{$msgid};
  96 }