bin/ttxgettext

   1 #! /usr/bin/perl -w
   2
   3 # copied from webwml/english/po/wmlxgettext.pl and
   4 # adapted for Template Toolkit
   5 #  Copyright © 2002-2003  Denis Barbier <barbier@debian.org>
   6 #  Copyright © 2007 Frank Lichtenheld <frank@lichtenheld.de>
   7 #
   8 #  This program is free software; you can redistribute it and/or modify
   9 #  it under the terms of the GNU General Public License as published by
  10 #  the Free Software Foundation; either version 2 of the License, or
  11 #  (at your option) any later version.
  12 use strict;
  13 use Getopt::Std;
  14
  15 use vars qw($opt_p);
  16
  17 my $messages = {};
  18 my @msgids = ();
  19
  20 my $domain = shift @ARGV;
  21
  22 sub escape {
  23         my $text = shift;
  24         $text =~ s/\\/\\\\/g;
  25         $text =~ s/"/\\"/g;
  26         $text =~ s/\n/\\n/g;
  27         $text =~ s/\t/\\t/g;
  28         return $text;
  29 }
  30
  31 sub countNewline {
  32         my $text = shift;
  33         return ($text =~ s/\n//g);
  34 }
  35
  36 sub processFile {
  37         my $file = shift;
  38         my $prefix = shift;
  39         my ($text, $lineno, $comment, $nextlineno, $msgid);
  40         my (@messages) = ();
  41         my (%msgids) = ();
  42         my $repl = '';
  43
  44         open(IN, "< $file") || die "Unable to open $file\n";
  45         local ($/) = undef;
  46         $text = <IN>;
  47         close(IN);
  48
  49         if ($prefix =~ s/=(.*)//) {
  50                 $repl = $1;
  51         }
  52         $file =~ s{^$prefix}{$repl}o unless $prefix eq '__';
  53 #        #  Remove comments if they contain <gettext> or </gettext>
  54 #        $text =~ s/^[ \t]*#.*<\/?gettext\b//mg;
  55         $lineno = 1;
  56         while ($text =~ m{\G(.*?) # begin at end of previous match, $1=prefix
  57                               (\bg\(\s* # "g(" , $2=whole match
  58                                (["']) # " quoting, $3=quotes
  59                                  (.*?)\3 # string, $4=string
  60                                )}gxs) {
  61                 $msgid = escape($4);
  62                 $lineno += countNewline ($1.$2);
  63                 $nextlineno = countNewline ($4);;
  64                 my $dom = $domain;
  65 #                my $dom = ($3) ? $3 : 'templates';
  66 #                if ($domain ne $dom) {
  67 #                   $lineno += $nextlineno;
  68 #                   next;  # wrong domain
  69 #                }
  70                 $comment = '';
  71                 if ($1 =~ m/(((^|\n)\s*(\[%)?\s*#.*)+)\n?[^\n]*$/) {
  72                     $comment = $1;
  73                     $comment =~ s/\[%//g;
  74                     $comment =~ s/%\]//g;
  75                     $comment =~ s/^\s+#\s*//;
  76                     $comment =~ s/\n[ \t]*#\s*/\n/g;
  77                 }
  78                 push (@msgids, $msgid);
  79 #                if (defined ($messages->{$msgid})) {
  80 #                        print STDERR "ttxgettext: Warning: msgid multiple defined:\n\t".
  81 #                                $msgid."\n";
  82 #                } else {
  83 #                        $messages->{$msgid} = [];
  84 #                }
  85                 push (@{$messages->{$msgid}}, $comment, $file, $lineno);
  86                 $lineno += $nextlineno;
  87         }
  88 }
  89
  90 $opt_p = '__';
  91 getopt('p');
  92
  93 foreach (@ARGV) {
  94         processFile($_, $opt_p);
  95 }
  96
  97 print "msgid \"\"\nmsgstr \"\"\n".
  98         "\"Content-Type: text/plain; charset=UTF-8\\n\"\n".
  99         "\"Content-Transfer-Encoding: 8bit\\n\"\n\n";
 100
 101 foreach my $msgid (@msgids) {
 102         next unless $messages->{$msgid};
 103         while (@{$messages->{$msgid}}) {
 104                 $_ = shift(@{$messages->{$msgid}});
 105                 s/\n/\n#. /g;
 106                 print "#. ".$_."\n" if $_;
 107                 print "#: ".shift(@{$messages->{$msgid}}).":".
 108                             shift(@{$messages->{$msgid}})."\n";
 109         }
 110         print "msgid \"$msgid\"\nmsgstr \"\"\n\n";
 111         undef $messages->{$msgid};
 112 }