]> git.deb.at Git - deb/packages.git/blob - bin/ttxgettext
Update .pot files and merge to .po files
[deb/packages.git] / 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 }