lib/extract-msgs.pl

   1 #!/usr/bin/perl -w
   2 require 5.008;
   3 use bytes;
   4 use strict;
   5 use POSIX;
   6 use Locale::PO;
   7
   8 sub pot_creation_date {
   9     return strftime "%Y-%m-%d %H:%M:%S +0000", gmtime();
  10 }
  11
  12 use integer;
  13
  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";
  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             } else {
  60                 $comment{$msgno} = $translator_comment;
  61             }
  62             undef $translator_comment;
  63         }
  64         push @{$uses[$msgno]}, "$ARGV:$.";
  65     }
  66 } continue {
  67     # Reset $. for each input file.
  68     close ARGV if eof;
  69 }
  70
  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";
  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 ""
  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"
 101 END
 102     }
 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);
 110     }
 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";
 122             }
 123         }
 124     }
 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";
 139             }
 140         }
 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         }
 150         print "\n#: n:$msgno";
 151     }
 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";
 155     }
 156     print "\n";
 157     print "#~ " if $po_entry->obsolete;
 158     print "msgid \"$msg\"\n";
 159     print "#~ " if $po_entry->obsolete;
 160     print "msgstr \"\"\n";
 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};
 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";
 174     }
 175     print "\nmsgid \"$msg\"\n";
 176     print "msgstr \"\"\n";
 177 }