src/gettexttomsg.pl

   1 #!/usr/bin/perl -w
   2
   3 #  gettexttomsg.pl
   4 #
   5 #  Copyright (C) 2001,2002,2005,2011,2012,2014,2015 Olly Betts
   6 #
   7 #  This program is free software; you can redistribute it and/or modify
   8 #  it under the terms of the GNU General Public License as published by
   9 #  the Free Software Foundation; either version 2 of the License, or
  10 #  (at your option) any later version.
  11 #
  12 #  This program is distributed in the hope that it will be useful,
  13 #  but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 #  GNU General Public License for more details.
  16 #
  17 #  You should have received a copy of the GNU General Public License
  18 #  along with this program; if not, write to the Free Software
  19 #  Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
  20
  21 require 5.008;
  22 use strict;
  23
  24 my %revmsgs = ();
  25
  26 my $msgno;
  27 open MSG, "../lib/survex.pot" or die $!;
  28 while (<MSG>) {
  29     if (/^#: n:(\d+)$/) {
  30         $msgno = $1;
  31     } elsif (defined $msgno && /^msgid\s*"(.*)"/) {
  32         $revmsgs{$1} = $msgno;
  33         $msgno = undef;
  34     }
  35 }
  36 close MSG;
  37
  38 my $die = 0;
  39
  40 my $suppress_argc_argv_unused_warnings = 0;
  41 my @conditionals;
  42 my %macro;
  43 # Helper so we can just eval preprocessor expressions.
  44 sub pp_defined { exists $macro{$_[0]} // 0 }
  45
  46 sub pp_eval {
  47     local $_ = shift;
  48     # defined is a built-in function in Perl.
  49     s/\bdefined\b/pp_defined/g;
  50     no strict 'subs';
  51     no warnings;
  52     return eval($_);
  53 }
  54
  55 my $active = 1;
  56 while (<>) {
  57     if (m!^#\s*(\w+)\s*(.*?)\s*(?:/[/*].*)?$!) {
  58         my ($directive, $cond) = ($1, $2);
  59         if ($directive eq 'endif') {
  60             if (@conditionals == 0) {
  61                 die "$ARGV:$.: Unmatched #endif\n";
  62             }
  63             $active = pop @conditionals;
  64         } elsif ($directive eq 'else') {
  65             if (@conditionals == 0) {
  66                 die "$ARGV:$.: Unmatched #else\n";
  67             }
  68             $active = (!$active) && $conditionals[-1];
  69         } elsif ($directive eq 'ifdef') {
  70             push @conditionals, $active;
  71             $active &&= pp_defined($cond);
  72         } elsif ($directive eq 'ifndef') {
  73             push @conditionals, $active;
  74             $active &&= !pp_defined($cond);
  75         } elsif ($directive eq 'if') {
  76             push @conditionals, $active;
  77             $active &&= pp_eval($cond);
  78         } elsif ($active) {
  79             if ($directive eq 'define') {
  80                 $cond =~ /^(\w+)\s*(.*)/;
  81                 $macro{$1} = $2;
  82                 no warnings;
  83                 eval "sub $1 { q($2) }";
  84             } elsif ($directive eq 'undef') {
  85                 $cond =~ /^(\w+)/;
  86                 no warnings;
  87                 eval "sub $1 { 0 }";
  88             }
  89         }
  90         print;
  91         next;
  92     }
  93
  94     if (!$active) {
  95         print;
  96         next;
  97     }
  98
  99     if ($suppress_argc_argv_unused_warnings && /^{/) {
 100         $suppress_argc_argv_unused_warnings = 0;
 101         print "$_  (void)argc;\n  (void)argv;\n";
 102         next;
 103     }
 104
 105     if (/^_getopt_initialize\b/) {
 106         $suppress_argc_argv_unused_warnings = 1;
 107     } elsif (!/^\s*#/) {
 108         while (/\\\n$/) {
 109             $_ .= <>;
 110         }
 111         # very crude - doesn't know about comments, etc
 112         s!\b_\("(.*?)"\)!replacement($1)!gse;
 113     } elsif (/\s*#\s*define\s+_\(/) {
 114         $_ = "#include \"message.h\"\n";
 115     }
 116     print;
 117 }
 118
 119 if ($die) {
 120     die "Not all messages found!\n";
 121 }
 122
 123 sub replacement {
 124     my $msg = shift;
 125     $msg =~ s/\\\n//g;
 126     my $msgno = "";
 127     if (exists $revmsgs{$msg}) {
 128         $msgno = $revmsgs{$msg};
 129     } else {
 130         my $tmp = $msg;
 131         $tmp =~ s/`(.*?)'/“$1”/g;
 132         $tmp =~ s/(\w)'(\w)/$1’$2/g;
 133         if (exists $revmsgs{$tmp}) {
 134             $msg = $tmp;
 135             $msgno = $revmsgs{$msg};
 136         } else {
 137             if (!$die) {
 138                 print STDERR "Message(s) not found in message file:\n";
 139                 $die = 1;
 140             }
 141             print STDERR "'$msg'\n";
 142         }
 143     }
 144     return "msg(/*$msg*/$msgno)";
 145 }