1 | #!/usr/bin/perl -w |
---|
2 | require 5.008; |
---|
3 | use bytes; |
---|
4 | use strict; |
---|
5 | use POSIX; |
---|
6 | use Locale::PO; |
---|
7 | |
---|
8 | my $pot_creation_date = strftime "%Y-%m-%d %H:%M:%S +0000", gmtime(); |
---|
9 | |
---|
10 | use integer; |
---|
11 | |
---|
12 | my (%msgs, @uses, %comment); |
---|
13 | my $translator_comment; |
---|
14 | while (<ARGV>) { |
---|
15 | if (m!(/[/*])\s*(TRANSLATORS:.*?)\s*\z!) { |
---|
16 | my ($comment_type, $comment) = ($1, $2); |
---|
17 | if ($comment_type eq '/*') { |
---|
18 | while ($comment !~ s!\s*\*/\z!! && defined($_ = <ARGV>)) { |
---|
19 | if (m!^\s*\*?\s*(.*?)\s*\z!) { |
---|
20 | # */ on a line by itself results in '/' for $1. |
---|
21 | last if $1 eq '/'; |
---|
22 | $comment .= "\n$1"; |
---|
23 | } |
---|
24 | } |
---|
25 | } else { |
---|
26 | # // comment - see if there are further // comments immediately |
---|
27 | # following. |
---|
28 | while (defined($_ = <ARGV>) && m!//\s*(.*?)\s*\z!) { |
---|
29 | $comment .= "\n$1"; |
---|
30 | } |
---|
31 | } |
---|
32 | $comment =~ s/\n+$//; |
---|
33 | if (defined $translator_comment) { |
---|
34 | print STDERR "Ignored TRANSLATORS comment: $translator_comment\n"; |
---|
35 | } |
---|
36 | $translator_comment = $comment; |
---|
37 | last if !defined $_; |
---|
38 | } |
---|
39 | |
---|
40 | while (m!/\*(.*?)\*/(\d+)\b!g) { |
---|
41 | my ($msg, $msgno) = ($1, $2); |
---|
42 | # Handle there being a comment before the comment with the message in. |
---|
43 | $msg =~ s!.*/\*!!; |
---|
44 | if (exists $msgs{$msgno}) { |
---|
45 | if ($msgs{$msgno} ne $msg) { |
---|
46 | print STDERR "Mismatch for message number $msgno:\n"; |
---|
47 | print STDERR "$msgs{$msgno}\n$msg\n"; |
---|
48 | } |
---|
49 | } else { |
---|
50 | $msgs{$msgno} = $msg; |
---|
51 | } |
---|
52 | if (defined $translator_comment) { |
---|
53 | if (exists $comment{$msgno} && $comment{$msgno} ne $translator_comment) { |
---|
54 | print STDERR "Different TRANSLATOR comments for message #$msgno\n"; |
---|
55 | } |
---|
56 | $comment{$msgno} = $translator_comment; |
---|
57 | undef $translator_comment; |
---|
58 | } |
---|
59 | push @{$uses[$msgno]}, "$ARGV:$."; |
---|
60 | } |
---|
61 | } continue { |
---|
62 | # Reset $. for each input file. |
---|
63 | close ARGV if eof; |
---|
64 | } |
---|
65 | |
---|
66 | print << "END"; |
---|
67 | # Survex translation template. |
---|
68 | # Copyright (C) YEAR COPYRIGHT HOLDERS |
---|
69 | # This file is distributed under the same licence as Survex. |
---|
70 | # |
---|
71 | msgid "" |
---|
72 | msgstr "" |
---|
73 | "Project-Id-Version: survex\\n" |
---|
74 | "Report-Msgid-Bugs-To: olly\@survex.com\\n" |
---|
75 | "POT-Creation-Date: $pot_creation_date\\n" |
---|
76 | "PO-Revision-Date: YEAR-MO-DA HO:MI:SE +ZONE\\n" |
---|
77 | "Language-Team: LANGUAGE <LL\@li.org>\\n" |
---|
78 | "MIME-Version: 1.0\\n" |
---|
79 | "Content-Type: text/plain; charset=utf-8\\n" |
---|
80 | "Content-Transfer-Encoding: 8bit\\n" |
---|
81 | END |
---|
82 | |
---|
83 | my $num_list = Locale::PO->load_file_asarray("survex.pot"); |
---|
84 | my $first = 1; |
---|
85 | foreach my $po_entry (@{$num_list}) { |
---|
86 | my $msgno = ''; |
---|
87 | my $ref = $po_entry->reference; |
---|
88 | if (defined $ref && $ref =~ /^n:(\d+)$/m) { |
---|
89 | $msgno = $1; |
---|
90 | } |
---|
91 | if ($first) { |
---|
92 | $first = 0; |
---|
93 | next if ($po_entry->msgid eq '""'); |
---|
94 | } |
---|
95 | my $msg; |
---|
96 | if (exists $msgs{$msgno}) { |
---|
97 | $msg = $msgs{$msgno}; |
---|
98 | delete $msgs{$msgno}; |
---|
99 | } else { |
---|
100 | print STDERR "Message number $msgno is in survex.pot but not found in source - preserving\n" unless $po_entry->obsolete; |
---|
101 | $msg = $po_entry->dequote($po_entry->msgid); |
---|
102 | } |
---|
103 | if (exists $comment{$msgno}) { |
---|
104 | my $new = $comment{$msgno}; |
---|
105 | my $old = $po_entry->automatic; |
---|
106 | $po_entry->automatic($new); |
---|
107 | if (defined $old) { |
---|
108 | $old =~ s/\s+/ /g; |
---|
109 | $new =~ s/\s+/ /g; |
---|
110 | if ($old ne $new) { |
---|
111 | print STDERR "Comment for message #$msgno changed from\n[$old]\nto\n[$new]\n"; |
---|
112 | } |
---|
113 | } |
---|
114 | } |
---|
115 | if (defined $po_entry->automatic) { |
---|
116 | if (!exists $comment{$msgno}) { |
---|
117 | my $fake_err = ": Comment for message #$msgno not in source code\n"; |
---|
118 | if ($msgno ne '' && exists($uses[$msgno])) { |
---|
119 | print STDERR join($fake_err, @{$uses[$msgno]}), $fake_err if exists($uses[$msgno]); |
---|
120 | } else { |
---|
121 | print STDERR $fake_err; |
---|
122 | } |
---|
123 | my $x = $po_entry->automatic; |
---|
124 | $x =~ s/\n/\n * /g; |
---|
125 | print STDERR " /* $x */\n"; |
---|
126 | } |
---|
127 | my $automatic = "\n" . $po_entry->automatic; |
---|
128 | $automatic =~ s/\n/\n#. /g; |
---|
129 | while ($automatic =~ s/\n#. \n/\n#.\n/g) { } |
---|
130 | print $automatic; |
---|
131 | } |
---|
132 | if ($msgno =~ /^\d+$/) { |
---|
133 | for (@{$uses[$msgno]}) { |
---|
134 | print "\n#: ", $_; |
---|
135 | } |
---|
136 | print "\n#: n:$msgno"; |
---|
137 | } |
---|
138 | print "\n#, c-format" if $msg =~ /\%[a-z0-9]/; |
---|
139 | if ($msg =~ s/(?:^|[^\\])"/\\"/g) { |
---|
140 | print STDERR "Escaping unescaped \" in message number $msgno\n"; |
---|
141 | } |
---|
142 | print "\n"; |
---|
143 | print "#~ " if $po_entry->obsolete; |
---|
144 | print "msgid \"$msg\"\n"; |
---|
145 | print "#~ " if $po_entry->obsolete; |
---|
146 | print "msgstr \"\"\n"; |
---|
147 | } |
---|
148 | |
---|
149 | for my $msgno (sort keys %msgs) { |
---|
150 | next if ($msgno == 0 || $msgno >= 1000); |
---|
151 | print STDERR "New message number $msgno\n"; |
---|
152 | for (@{$uses[$msgno]}) { |
---|
153 | print "\n#: ", $_; |
---|
154 | } |
---|
155 | my $msg = $msgs{$msgno}; |
---|
156 | print "\n#: n:$msgno"; |
---|
157 | print "\n#, c-format" if $msg =~ /\%[a-z0-9]/; |
---|
158 | if ($msg =~ s/(?:^|[^\\])"/\\"/g) { |
---|
159 | print STDERR "Escaping unescaped \" in message number $msgno\n"; |
---|
160 | } |
---|
161 | print "\nmsgid \"$msg\"\n"; |
---|
162 | print "msgstr \"\"\n"; |
---|
163 | } |
---|