[f63bd56] | 1 | #!/usr/bin/perl -w |
---|
| 2 | require 5.008; |
---|
| 3 | use bytes; |
---|
| 4 | use strict; |
---|
| 5 | use POSIX; |
---|
| 6 | use Locale::PO; |
---|
| 7 | |
---|
[9435c45] | 8 | sub pot_creation_date { |
---|
| 9 | return strftime "%Y-%m-%d %H:%M:%S +0000", gmtime(); |
---|
| 10 | } |
---|
[f63bd56] | 11 | |
---|
| 12 | use integer; |
---|
| 13 | |
---|
[1034916] | 14 | my (%msgs, @uses, %comment, %loc); |
---|
[461db8b] | 15 | my $translator_comment; |
---|
[f63bd56] | 16 | while (<ARGV>) { |
---|
[461db8b] | 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"; |
---|
| 25 | } |
---|
| 26 | } |
---|
[6ce6f88] | 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"; |
---|
| 32 | } |
---|
[461db8b] | 33 | } |
---|
[6ce6f88] | 34 | $comment =~ s/\n+$//; |
---|
[461db8b] | 35 | if (defined $translator_comment) { |
---|
[1034916] | 36 | print STDERR "$ARGV:$.: Ignored TRANSLATORS comment: $translator_comment\n"; |
---|
[461db8b] | 37 | } |
---|
| 38 | $translator_comment = $comment; |
---|
[5c11105] | 39 | last if !defined $_; |
---|
[461db8b] | 40 | } |
---|
| 41 | |
---|
[f63bd56] | 42 | while (m!/\*(.*?)\*/(\d+)\b!g) { |
---|
| 43 | my ($msg, $msgno) = ($1, $2); |
---|
[d33b67a] | 44 | # Handle there being a comment before the comment with the message in. |
---|
| 45 | $msg =~ s!.*/\*!!; |
---|
[f63bd56] | 46 | if (exists $msgs{$msgno}) { |
---|
| 47 | if ($msgs{$msgno} ne $msg) { |
---|
[1034916] | 48 | print STDERR "$ARGV:$.: Mismatch for message number $msgno:\n"; |
---|
[f63bd56] | 49 | print STDERR "$msgs{$msgno}\n$msg\n"; |
---|
| 50 | } |
---|
| 51 | } else { |
---|
| 52 | $msgs{$msgno} = $msg; |
---|
| 53 | } |
---|
[461db8b] | 54 | if (defined $translator_comment) { |
---|
| 55 | if (exists $comment{$msgno} && $comment{$msgno} ne $translator_comment) { |
---|
[f05af55] | 56 | print STDERR "Different TRANSLATOR comments for message #$msgno\n"; |
---|
[1034916] | 57 | print STDERR "${$uses[$msgno]}[0]: $comment{$msgno}\n"; |
---|
[e4e34b7] | 58 | print STDERR "$ARGV:$.: $translator_comment\n"; |
---|
[eae1b24] | 59 | } else { |
---|
| 60 | $comment{$msgno} = $translator_comment; |
---|
[461db8b] | 61 | } |
---|
| 62 | undef $translator_comment; |
---|
| 63 | } |
---|
[f63bd56] | 64 | push @{$uses[$msgno]}, "$ARGV:$."; |
---|
| 65 | } |
---|
| 66 | } continue { |
---|
| 67 | # Reset $. for each input file. |
---|
| 68 | close ARGV if eof; |
---|
| 69 | } |
---|
| 70 | |
---|
[9435c45] | 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; |
---|
| 78 | } |
---|
| 79 | if ($first) { |
---|
| 80 | $first = 0; |
---|
| 81 | if ($po_entry->msgid eq '""') { |
---|
| 82 | chomp(my $header = $po_entry->dump); |
---|
| 83 | print $header; |
---|
| 84 | next; |
---|
| 85 | } |
---|
| 86 | print << "END"; |
---|
[f63bd56] | 87 | # Survex translation template. |
---|
| 88 | # Copyright (C) YEAR COPYRIGHT HOLDERS |
---|
| 89 | # This file is distributed under the same licence as Survex. |
---|
| 90 | # |
---|
| 91 | msgid "" |
---|
| 92 | msgstr "" |
---|
[f8fa253] | 93 | "Project-Id-Version: survex\\n" |
---|
[f63bd56] | 94 | "Report-Msgid-Bugs-To: olly\@survex.com\\n" |
---|
[9435c45] | 95 | "POT-Creation-Date: ${\(pot_creation_date)}\\n" |
---|
[f63bd56] | 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" |
---|
| 101 | END |
---|
| 102 | } |
---|
| 103 | my $msg; |
---|
| 104 | if (exists $msgs{$msgno}) { |
---|
| 105 | $msg = $msgs{$msgno}; |
---|
| 106 | delete $msgs{$msgno}; |
---|
| 107 | } else { |
---|
[1034916] | 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; |
---|
[f63bd56] | 109 | $msg = $po_entry->dequote($po_entry->msgid); |
---|
| 110 | } |
---|
[461db8b] | 111 | if (exists $comment{$msgno}) { |
---|
[736f7df] | 112 | my $new = $comment{$msgno}; |
---|
| 113 | my $old = $po_entry->automatic; |
---|
| 114 | $po_entry->automatic($new); |
---|
[461db8b] | 115 | if (defined $old) { |
---|
| 116 | $old =~ s/\s+/ /g; |
---|
| 117 | $new =~ s/\s+/ /g; |
---|
| 118 | if ($old ne $new) { |
---|
[1034916] | 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"; |
---|
[461db8b] | 122 | } |
---|
| 123 | } |
---|
| 124 | } |
---|
[f63bd56] | 125 | if (defined $po_entry->automatic) { |
---|
[736f7df] | 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])) { |
---|
[1034916] | 129 | print STDERR join($fake_err, "../lib/survex.pot:".$po_entry->loaded_line_number, @{$uses[$msgno]}), $fake_err if exists($uses[$msgno]); |
---|
[ebe18a4] | 130 | my $x = $po_entry->automatic; |
---|
| 131 | $x =~ s/\n/\n * /g; |
---|
| 132 | print STDERR " /* $x */\n"; |
---|
[736f7df] | 133 | } else { |
---|
[ebe18a4] | 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"; |
---|
[736f7df] | 139 | } |
---|
| 140 | } |
---|
[f63bd56] | 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; |
---|
| 145 | } |
---|
| 146 | if ($msgno =~ /^\d+$/) { |
---|
| 147 | for (@{$uses[$msgno]}) { |
---|
| 148 | print "\n#: ", $_; |
---|
| 149 | } |
---|
[0dc5829] | 150 | print "\n#: n:$msgno"; |
---|
[f63bd56] | 151 | } |
---|
[2401307] | 152 | print "\n#, c-format" if $msg =~ /\%[a-z0-9.]/; |
---|
[f63bd56] | 153 | if ($msg =~ s/(?:^|[^\\])"/\\"/g) { |
---|
| 154 | print STDERR "Escaping unescaped \" in message number $msgno\n"; |
---|
| 155 | } |
---|
| 156 | print "\n"; |
---|
| 157 | print "#~ " if $po_entry->obsolete; |
---|
| 158 | print "msgid \"$msg\"\n"; |
---|
| 159 | print "#~ " if $po_entry->obsolete; |
---|
[0dc5829] | 160 | print "msgstr \"\"\n"; |
---|
[f63bd56] | 161 | } |
---|
| 162 | |
---|
| 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#: ", $_; |
---|
| 168 | } |
---|
| 169 | my $msg = $msgs{$msgno}; |
---|
[0dc5829] | 170 | print "\n#: n:$msgno"; |
---|
[2401307] | 171 | print "\n#, c-format" if $msg =~ /\%[a-z0-9.]/; |
---|
[f63bd56] | 172 | if ($msg =~ s/(?:^|[^\\])"/\\"/g) { |
---|
| 173 | print STDERR "Escaping unescaped \" in message number $msgno\n"; |
---|
| 174 | } |
---|
| 175 | print "\nmsgid \"$msg\"\n"; |
---|
[0dc5829] | 176 | print "msgstr \"\"\n"; |
---|
[f63bd56] | 177 | } |
---|