source: git/lib/extract-msgs.pl @ a7d4233

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

lib/extract-msgs.pl: Report file:line for issues we spot.

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