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