msggen.pl

   1 #! /usr/bin/perl
   2 # Copyright (c) 1994 James Clark, 2000 Matthias Clasen
   3 # Copyright (c) 2000 Peter Nilsson
   4 # See the file COPYING for copying permission.
   5
   6 use POSIX;
   7
   8 # Package and version.
   9 $package = 'openjade';
  10 $version = '1.3.2';
  11 $package = $package; $version = $version; # be quiet, -w
  12
  13 $prog = $0;
  14 $prog =~ s@.*/@@;
  15
  16 $gen_c = 0;
  17
  18 undef $opt_l;
  19 undef $opt_p;
  20 undef $opt_t;
  21 do 'getopts.pl';
  22 &Getopts('l:p:t:');
  23 $module = $opt_l;
  24 $pot_file = $opt_p;
  25
  26 if (defined($opt_t)) {
  27   # don't try to read translations for English
  28   $opt_t =~ /.*en.*/ || &read_po_translations($opt_t);
  29 }
  30
  31 $num = 0;
  32
  33 foreach $def_file (@ARGV) {
  34
  35 @tag_used = ();
  36
  37 open(DEF, $def_file) || die "can't open \`$def_file': $!\n";
  38
  39 while (<DEF>) {
  40     chop;
  41     if (/^!cxx$/) {
  42         $gen_c = 1;
  43         next;
  44     }
  45     if (/^=/) {
  46         if (!defined($opt_p)) {
  47             $n = substr($_, 1);
  48             &error("= directive must increase message num") if ($n < $num);
  49             $num = $n;
  50         }
  51         next;
  52     }
  53     if (/^-/) {
  54         # a deleted message
  55         $num++;
  56         next;
  57     }
  58
  59     next if /^[         ]*#/;
  60     next if /^[         ]*$/;
  61     @field = split('\+', $_, 5);
  62     &error("too few fields") if $#field < 3;
  63     if ($#field == 4 && $field[4] =~ /^%J/) {
  64         $field[3] .= '+';
  65         $field[3] .= substr($field[4], 2);
  66         $#field = 3;
  67     }
  68     if ($field[0] eq "") {
  69         $type[$num] = "";
  70         $argc = 0;
  71     }
  72     else {
  73         $field[0] =~ /^[IWQXE][0-9]$/ || &error("invalid first field");;
  74         $type[$num] = substr($field[0], 0, 1);
  75         $argc = int(substr($field[0], 1, 1));
  76     }
  77     $nargs[$num] = $argc;
  78     $field[1] =~ /^[a-zA-Z_][a-zA-Z0-9_]+$/ || &error("invalid tag");
  79     $tag[$num] = $field[1];
  80     &error("duplicate tag $field[1]")
  81       if (!defined($opt_p) && defined($tag_used{$field[1]}));
  82     $tag_used{$field[1]} = 1;
  83     $field[2] =~ /^((ISO(\/IEC)? [0-9]+:[0-9]+ )?(([A-Z]?[0-9]+(\.[0-9]+)*(p[0-9]+)?)|(\[[0-9]+(\.[0-9]*)?\]))( (ISO(\/IEC)? [0-9]+:[0-9]+ )?(([A-Z]?[0-9]+(\.[0-9]+)*(p[0-9]+)?)|(\[[0-9]+(\.[0-9]*)?\])))*)?$/
  84         || &error("invalid clauses field");
  85     # push @clauses, $field[2];
  86     $clauses[$num] = $field[2];
  87     if ($argc == 0) {
  88         if ($field[0] ne "") {
  89             $field[3] =~ /^([^%]|%%)*$/ || &error("invalid character after %");
  90         }
  91     }
  92     else {
  93         $field[3] =~ /^([^%]|%[%1-$argc])*$/ || &error("invalid character after %");
  94     }
  95     $auxloc[$num] = ($#field == 4 ? "L" : "");
  96     $message[$num] = $field[3];
  97     $num++;
  98     if ($#field == 4) {
  99         $message2[$num] = $field[4];
 100         $num++;
 101     }
 102 }
 103
 104 close(DEF);
 105
 106 if (!defined($opt_p)) {
 107
 108 $file_base = $ARGV[0];
 109 $file_base =~ s/\.[^.]*$//;
 110
 111 $class = $file_base;
 112 $class =~ s|.*[\\/]||;
 113
 114 # this is needed on Windows NT
 115 chmod 0666, "$file_base.h";
 116 unlink("$file_base.h");
 117 open(OUT, ">$file_base.h");
 118 chmod 0444, "$file_base.h";
 119 select(OUT);
 120
 121 print <<END;
 122 // This file was automatically generated from $def_file by $prog.
 123 END
 124 print <<END if $gen_c;
 125 #ifndef ${class}_INCLUDED
 126 #define ${class}_INCLUDED 1
 127
 128 #ifdef __GNUG__
 129 #pragma interface
 130 #endif
 131 END
 132
 133 print <<END;
 134 #include <OpenSP/Message.h>
 135
 136 #ifdef SP_NAMESPACE
 137 namespace SP_NAMESPACE {
 138 #endif
 139
 140 struct $class {
 141 END
 142
 143 foreach $i (0 .. $#message) {
 144     if (defined($message[$i])) {
 145         print "  // $i\n";
 146         print "  static const Message";
 147         if ($type[$i] eq "") {
 148             print "Fragment";
 149         }
 150         else {
 151             print "Type$nargs[$i]$auxloc[$i]";
 152         }
 153         print " $tag[$i];\n";
 154     }
 155 }
 156 print "};\n";
 157
 158
 159 print <<END if $gen_c;
 160
 161 #ifdef SP_NAMESPACE
 162 }
 163 #endif
 164
 165 #endif /* not ${class}_INCLUDED */
 166 END
 167
 168 if ($gen_c) {
 169     close(OUT);
 170     # this is needed on Windows NT
 171     chmod 0666, "$file_base.cxx";
 172     unlink("$file_base.cxx");
 173     open(OUT, ">$file_base.cxx");
 174     chmod 0444, "$file_base.cxx";
 175     select(OUT);
 176
 177     print <<END;
 178 // This file was automatically generated from $def_file by $prog.
 179
 180 #ifdef __GNUG__
 181 #pragma implementation
 182 #endif
 183
 184 #include "stylelib.h"
 185 #include "$class.h"
 186
 187 #ifdef SP_NAMESPACE
 188 namespace SP_NAMESPACE {
 189 #endif
 190
 191 END
 192 }
 193
 194 if (defined($opt_l)) {
 195     print "extern MessageModule $module;\n\n";
 196 }
 197
 198 foreach $i (0 .. $#message) {
 199     if (defined($message[$i])) {
 200         if ($type[$i] eq "") {
 201             print "const MessageFragment ${class}::$tag[$i](\n";
 202         }
 203         else {
 204             print "const MessageType$nargs[$i]$auxloc[$i] ${class}::$tag[$i](\n";
 205             print "MessageType::";
 206             if ($type[$i] eq 'I') {
 207                 print 'info';
 208             }
 209             elsif ($type[$i] eq 'W') {
 210                 print 'warning';
 211             }
 212             elsif ($type[$i] eq 'Q') {
 213                 print 'quantityError';
 214             }
 215             elsif ($type[$i] eq 'X') {
 216                 print 'idrefError';
 217             }
 218             else {
 219                 print 'error';
 220             }
 221             print ",\n";
 222         }
 223         if (defined($opt_l)) {
 224             print "&$module,\n";
 225         } else {
 226             print "0,\n";
 227         }
 228         print "$i\n";
 229         print "#ifndef SP_NO_MESSAGE_TEXT\n";
 230         $str = $message[$i];
 231         $str =~ s|\\|\\\\|g;
 232         $str =~ s|"|\\"|g;
 233         printf ",\"%s\"", $str;
 234         if ($clauses[$i]) {
 235           $str = $clauses[$i];
 236           $str =~ s|\\|\\\\|g;
 237           $str =~ s|"|\\"|g;
 238           printf "\n,\"%s\"", $str;
 239         }
 240         if ($auxloc[$i]) {
 241             if ($clauses[$i] eq "") {
 242               print "\n,0";
 243             }
 244             $str = $message2[$i + 1];
 245             $str =~ s|\\|\\\\|g;
 246             $str =~ s|"|\\"|g;
 247             printf "\n,\"%s\"", $str;
 248         }
 249         print "\n#endif\n";
 250         print ");\n";
 251     }
 252 }
 253 print <<END;
 254 #ifdef SP_NAMESPACE
 255 }
 256 #endif
 257 END
 258
 259 close(OUT);
 260
 261 # this is needed on Windows NT
 262 chmod 0666, "$file_base.rc";
 263 unlink("$file_base.rc");
 264 open(OUT, ">$file_base.rc");
 265 chmod 0444, "$file_base.rc";
 266 select(OUT);
 267
 268 print "STRINGTABLE\nBEGIN\n";
 269
 270 foreach $i (0 .. $#message) {
 271     if (defined($message[$i])) {
 272         $str = $message[$i];
 273         if ($translation{$str}) {
 274             $str = $translation{$str};
 275         }
 276         $str =~ s/"/""/g;
 277         printf "  %d, \"%s\"\n", $i, $str;
 278     }
 279     elsif (defined($message2[$i])) {
 280         $str = $message2[$i];
 281         $str =~ s/"/""/g;
 282         printf "  %d, \"%s\"\n", $i, $str;
 283     }
 284 }
 285
 286 print "END\n";
 287 close(OUT);
 288
 289 } # !opt_p
 290
 291 } # foreach def_file
 292
 293 if (defined($opt_p)) {
 294
 295   # this is needed for GNU gettext
 296   chmod 0666, "$pot_file";
 297   unlink("$pot_file");
 298   open(OUT, ">$pot_file");
 299   chmod 0444, "$pot_file";
 300   select(OUT);
 301
 302   $crdate = POSIX::strftime "%Y-%m-%d %H:%M+0000", gmtime;
 303   print <<END;
 304 # SOME DESCRIPTIVE TITLE.
 305 # Copyright (C) YEAR HOLDER
 306 # FIRST AUTHOR <EMAIL\@ADDRESS>, YEAR.
 307 #
 308 #, fuzzy
 309 msgid ""
 310 msgstr ""
 311 "Project-Id-Version: PACKAGE VERSION\\n"
 312 "POT-Creation-Date: $crdate\\n"
 313 "PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\\n"
 314 "Last-Translator: FULL NAME <EMAIL\@ADDRESS>\\n"
 315 "Language-Team: LANGUAGE <LL\@li.org>\\n"
 316 "MIME-Version:: 1.0\\n"
 317 "Content-Type: text/plain; charset=CHARSET\\n"
 318 "Content-Transfer-Encoding: ENCODING\\n"
 319
 320 END
 321
 322   foreach $i (0 .. $#message) {
 323     if (defined($message[$i]) && !defined($written{$message[$i]})) {
 324         next if $message[$i] eq "";
 325         $written{$message[$i]} = 1;
 326         $str = $message[$i];
 327         $str =~ s/"/\\"/g;
 328         printf "msgid \"%s\"\nmsgstr \"\"\n\n", $str;
 329     }
 330     elsif (defined($message2[$i]) && ! defined($written{$message2[$i]})) {
 331         $written{$message2[$i]} = 1;
 332         $str = $message2[$i];
 333         $str =~ s/"/\\"/g;
 334         printf "msgid \"%s\"\nmsgstr \"\"\n\n", $str;
 335     }
 336  }
 337 }
 338
 339 close(OUT);
 340
 341 sub error {
 342     die "$def_file:$.: $_[0]\n";
 343 }
 344
 345 # Read a PO file with message translations.
 346 # This doesn't accept every valid PO file, but it seems to work reasonably.
 347 sub read_po_translations {
 348     my $po_in = $_[0];
 349     open(PO_IN, "<$po_in") || die "Can't open file $po_in.";
 350     my $id = "";
 351     my $str = "";
 352     my $catching_string = 0;
 353
 354     while(<PO_IN>) {
 355         if (/^\s*msgid/) {
 356             if ($catching_string) {
 357                 &po_flush($id, $str);
 358                 $id = "";
 359                 $str = "";
 360             }
 361             $_ = $';
 362             $catching_string = 1;
 363         }
 364         elsif (/^\s*msgstr/) {
 365             die "No msgid." if !$catching_string or $id;
 366             $id = $str;
 367             $str = "";
 368             $_ = $';
 369         }
 370
 371         if ($catching_string) {
 372             my $in_string = 0;
 373             s/\s*//;
 374             while ($_) {
 375                 if (s/^\"//) {
 376                     $in_string = !$in_string;
 377                 }
 378                 if ($in_string) {
 379                     if (s/^[^\"\\]+//) {
 380                         $str .= $&;
 381                     }
 382                     elsif (s/^\\([ntbrf\\\"])//) {
 383                         $str .= "\n" if $1 eq "n";
 384                         $str .= "\t" if $1 eq "t";
 385                         $str .= "\b" if $1 eq "b";
 386                         $str .= "\r" if $1 eq "r";
 387                         $str .= "\f" if $1 eq "f";
 388                         $str .= "\\" if $1 eq "\\";
 389                         $str .= "\"" if $1 eq "\"";
 390                     }
 391                     elsif (s/\\([0-9]+)//) {
 392                         $str .= chr(oct($1));
 393                     }
 394                     elsif (s/\\[xX]([0-9a-fA-F]+)//) {
 395                         $str .= chr(hex($1));
 396                     }
 397                     else {
 398                         die "Invalid control sequence." if /^\\/;
 399                     }
 400                 }
 401                 else {
 402                     s/\s*//;
 403                     last if /^[^"]/;
 404                 }
 405             }
 406         }
 407     }
 408     if ($catching_string) {
 409         &po_flush($id, $str);
 410
 411     }
 412 }
 413
 414 sub po_flush {
 415     my $id = $_[0];
 416     my $str = $_[1];
 417     # We use a translation only if $id is non-empty (we don't include the
 418     # PO file header) and if $str is non-empty (the message is translated).
 419     if ($id && $str) {
 420         $translation{$id} = $str;
 421     }
 422     $id = "";
 423     $str = "";
 424 }
 425
 426