source: git/lib/extract-msgs.pl @ 5c11105

RELEASE/1.2debug-cidebug-ci-sanitisersstereowalls-data
Last change on this file since 5c11105 was 5c11105, checked in by Olly Betts <olly@…>, 9 years ago

lib/extract-msgs.pl: Whitespace tweak.

  • Property mode set to 100755
File size: 5.0 KB
Line 
1#!/usr/bin/perl -w
2require 5.008;
3use bytes;
4use strict;
5use POSIX;
6use Locale::PO;
7
8sub pot_creation_date {
9    return strftime "%Y-%m-%d %H:%M:%S +0000", gmtime();
10}
11
12use integer;
13
14my (%msgs, @uses, %comment, %loc);
15my $translator_comment;
16while (<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";
25                }
26            }
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            }
33        }
34        $comment =~ s/\n+$//;
35        if (defined $translator_comment) {
36            print STDERR "$ARGV:$.: Ignored TRANSLATORS comment: $translator_comment\n";
37        }
38        $translator_comment = $comment;
39        last if !defined $_;
40    }
41
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";
50            }
51        } else {
52            $msgs{$msgno} = $msg;
53        }
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            }
60            $comment{$msgno} = $translator_comment;
61            undef $translator_comment;
62        }
63        push @{$uses[$msgno]}, "$ARGV:$.";
64    }
65} continue {
66    # Reset $. for each input file.
67    close ARGV if eof;
68}
69
70my $num_list = Locale::PO->load_file_asarray("survex.pot");
71my $first = 1;
72foreach my $po_entry (@{$num_list}) {
73    my $msgno = '';
74    my $ref = $po_entry->reference;
75    if (defined $ref && $ref =~ /^n:(\d+)$/m) {
76        $msgno = $1;
77    }
78    if ($first) {
79        $first = 0;
80        if ($po_entry->msgid eq '""') {
81            chomp(my $header = $po_entry->dump);
82            print $header;
83            next;
84        }
85        print << "END";
86# Survex translation template.
87# Copyright (C) YEAR COPYRIGHT HOLDERS
88# This file is distributed under the same licence as Survex.
89#
90msgid ""
91msgstr ""
92"Project-Id-Version: survex\\n"
93"Report-Msgid-Bugs-To: olly\@survex.com\\n"
94"POT-Creation-Date: ${\(pot_creation_date)}\\n"
95"PO-Revision-Date: YEAR-MO-DA HO:MI:SE +ZONE\\n"
96"Language-Team: LANGUAGE <LL\@li.org>\\n"
97"MIME-Version: 1.0\\n"
98"Content-Type: text/plain; charset=utf-8\\n"
99"Content-Transfer-Encoding: 8bit\\n"
100END
101    }
102    my $msg;
103    if (exists $msgs{$msgno}) {
104        $msg = $msgs{$msgno};
105        delete $msgs{$msgno};
106    } else {
107        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;
108        $msg = $po_entry->dequote($po_entry->msgid);
109    }
110    if (exists $comment{$msgno}) {
111        my $new = $comment{$msgno};
112        my $old = $po_entry->automatic;
113        $po_entry->automatic($new);
114        if (defined $old) {
115            $old =~ s/\s+/ /g;
116            $new =~ s/\s+/ /g;
117            if ($old ne $new) {
118                print STDERR "Comment for message #$msgno changed:\n";
119                print STDERR "../lib/survex.pot:", $po_entry->loaded_line_number, ": [$old]\n";
120                print STDERR "${$uses[$msgno]}[0]: [$new]\n";
121            }
122        }
123    }
124    if (defined $po_entry->automatic) {
125        if (!exists $comment{$msgno}) {
126            my $fake_err = ": Comment for message #$msgno not in source code\n";
127            if ($msgno ne '' && exists($uses[$msgno])) {
128                print STDERR join($fake_err, "../lib/survex.pot:".$po_entry->loaded_line_number, @{$uses[$msgno]}), $fake_err if exists($uses[$msgno]);
129                my $x = $po_entry->automatic;
130                $x =~ s/\n/\n     * /g;
131                print STDERR "    /* $x */\n";
132            } else {
133                # Currently unused message.
134                # print STDERR $fake_err;
135                # my $x = $po_entry->automatic;
136                # $x =~ s/\n/\n     * /g;
137                # print STDERR "    /* $x */\n";
138            }
139        }
140        my $automatic = "\n" . $po_entry->automatic;
141        $automatic =~ s/\n/\n#. /g;
142        while ($automatic =~ s/\n#. \n/\n#.\n/g) { }
143        print $automatic;
144    }
145    if ($msgno =~ /^\d+$/) {
146        for (@{$uses[$msgno]}) {
147            print "\n#: ", $_;
148        }
149        print "\n#: n:$msgno";
150    }
151    print "\n#, c-format" if $msg =~ /\%[a-z0-9]/;
152    if ($msg =~ s/(?:^|[^\\])"/\\"/g) {
153        print STDERR "Escaping unescaped \" in message number $msgno\n";
154    }
155    print "\n";
156    print "#~ " if $po_entry->obsolete;
157    print "msgid \"$msg\"\n";
158    print "#~ " if $po_entry->obsolete;
159    print "msgstr \"\"\n";
160}
161
162for my $msgno (sort keys %msgs) {
163    next if ($msgno == 0 || $msgno >= 1000);
164    print STDERR "New message number $msgno\n";
165    for (@{$uses[$msgno]}) {
166        print "\n#: ", $_;
167    }
168    my $msg = $msgs{$msgno};
169    print "\n#: n:$msgno";
170    print "\n#, c-format" if $msg =~ /\%[a-z0-9]/;
171    if ($msg =~ s/(?:^|[^\\])"/\\"/g) {
172        print STDERR "Escaping unescaped \" in message number $msgno\n";
173    }
174    print "\nmsgid \"$msg\"\n";
175    print "msgstr \"\"\n";
176}
Note: See TracBrowser for help on using the repository browser.