msggen.pl

   1 #! /usr/bin/perl
   2 # Copyright (c) 1994 James Clark
   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 = 'OpenSP';
  10 $version = '1.5.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]+)?( (ISO(\/IEC)? [0-9]+:[0-9]+ )?[A-Z]?[0-9]+(\.[0-9]+)*(p[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 "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 "splib.h"
 185 #include "$class.h"
 186
 187 #ifdef SP_NAMESPACE
 188 namespace SP_NAMESPACE {
 189 #endif
 190
 191 END
 192 }
 193
 194 # The declaration is already included through Message.h
 195 #
 196 # if (defined($opt_l)) {
 197 #     print "extern MessageModule $module;\n\n";
 198 # }
 199
 200 foreach $i (0 .. $#message) {
 201     if (defined($message[$i])) {
 202         if ($type[$i] eq "") {
 203             print "const MessageFragment ${class}::$tag[$i](\n";
 204         }
 205         else {
 206             print "const MessageType$nargs[$i]$auxloc[$i] ${class}::$tag[$i](\n";
 207             print "MessageType::";
 208             if ($type[$i] eq 'I') {
 209                 print 'info';
 210             }
 211             elsif ($type[$i] eq 'W') {
 212                 print 'warning';
 213             }
 214             elsif ($type[$i] eq 'Q') {
 215                 print 'quantityError';
 216             }
 217             elsif ($type[$i] eq 'X') {
 218                 print 'idrefError';
 219             }
 220             else {
 221                 print 'error';
 222             }
 223             print ",\n";
 224         }
 225         if (defined($opt_l)) {
 226             print "&$module,\n";
 227         } else {
 228             print "0,\n";
 229         }
 230         print "$i\n";
 231         print "#ifndef SP_NO_MESSAGE_TEXT\n";
 232         $str = $message[$i];
 233         $str =~ s|\\|\\\\|g;
 234         $str =~ s|"|\\"|g;
 235         printf ",\"%s\"", $str;
 236         if ($clauses[$i]) {
 237           $str = $clauses[$i];
 238           $str =~ s|\\|\\\\|g;
 239           $str =~ s|"|\\"|g;
 240           printf "\n,\"%s\"", $str;
 241         }
 242         if ($auxloc[$i]) {
 243             if ($clauses[$i] eq "") {
 244               print "\n,0";
 245             }
 246             $str = $message2[$i + 1];
 247             $str =~ s|\\|\\\\|g;
 248             $str =~ s|"|\\"|g;
 249             printf "\n,\"%s\"", $str;
 250         }
 251         print "\n#endif\n";
 252         print ");\n";
 253     }
 254 }
 255 print <<END;
 256 #ifdef SP_NAMESPACE
 257 }
 258 #endif
 259 END
 260
 261 close(OUT);
 262
 263 # this is needed on Windows NT
 264 chmod 0666, "$file_base.rc";
 265 unlink("$file_base.rc");
 266 open(OUT, ">$file_base.rc");
 267 chmod 0444, "$file_base.rc";
 268 select(OUT);
 269
 270 print "STRINGTABLE\nBEGIN\n";
 271
 272 foreach $i (0 .. $#message) {
 273     if (defined($message[$i])) {
 274         $str = $message[$i];
 275         if ($translation{$str}) {
 276             $str = $translation{$str};
 277         }
 278         $str =~ s/"/""/g;
 279         printf "  %d, \"%s\"\n", $i, $str;
 280     }
 281     elsif (defined($message2[$i])) {
 282         $str = $message2[$i];
 283         $str =~ s/"/""/g;
 284         printf "  %d, \"%s\"\n", $i, $str;
 285     }
 286 }
 287
 288 print "END\n";
 289 close(OUT);
 290
 291 } # !opt_p
 292
 293 } # foreach def_file
 294
 295 if (defined($opt_p)) {
 296
 297   # this is needed for GNU gettext
 298   chmod 0666, "$pot_file";
 299   unlink("$pot_file");
 300   open(OUT, ">$pot_file");
 301   chmod 0444, "$pot_file";
 302   select(OUT);
 303
 304   $crdate = POSIX::strftime "%Y-%m-%d %H:%M+0000", gmtime;
 305   print <<END;
 306 # SOME DESCRIPTIVE TITLE.
 307 # Copyright (C) YEAR HOLDER
 308 # FIRST AUTHOR <EMAIL\@ADDRESS>, YEAR.
 309 #
 310 #, fuzzy
 311 msgid ""
 312 msgstr ""
 313 "Project-Id-Version: PACKAGE VERSION\\n"
 314 "POT-Creation-Date: $crdate\\n"
 315 "PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\\n"
 316 "Last-Translator: FULL NAME <EMAIL\@ADDRESS>\\n"
 317 "Language-Team: LANGUAGE <LL\@li.org>\\n"
 318 "MIME-Version:: 1.0\\n"
 319 "Content-Type: text/plain; charset=CHARSET\\n"
 320 "Content-Transfer-Encoding: ENCODING\\n"
 321
 322 END
 323
 324   foreach $i (0 .. $#message) {
 325     if (defined($message[$i]) && !defined($written{$message[$i]})) {
 326         next if $message[$i] eq "";
 327         $written{$message[$i]} = 1;
 328         $str = $message[$i];
 329         $str =~ s/"/\\"/g;
 330         printf "msgid \"%s\"\nmsgstr \"\"\n\n", $str;
 331     }
 332     elsif (defined($message2[$i]) && ! defined($written{$message2[$i]})) {
 333         $written{$message2[$i]} = 1;
 334         $str = $message2[$i];
 335         $str =~ s/"/\\"/g;
 336         printf "msgid \"%s\"\nmsgstr \"\"\n\n", $str;
 337     }
 338  }
 339 }
 340
 341 close(OUT);
 342
 343 sub error {
 344     die "$def_file:$.: $_[0]\n";
 345 }
 346
 347 # Read a PO file with message translations.
 348 # This doesn't accept every valid PO file, but it seems to work reasonably.
 349 sub read_po_translations {
 350     my $po_in = $_[0];
 351     open(PO_IN, "<$po_in") || die "Can't open file $po_in.";
 352     my $id = "";
 353     my $str = "";
 354     my $catching_string = 0;
 355
 356     while(<PO_IN>) {
 357         if (/^\s*msgid/) {
 358             if ($catching_string) {
 359                 &po_flush($id, $str);
 360                 $id = "";
 361                 $str = "";
 362             }
 363             $_ = $';
 364             $catching_string = 1;
 365         }
 366         elsif (/^\s*msgstr/) {
 367             die "No msgid." if !$catching_string or $id;
 368             $id = $str;
 369             $str = "";
 370             $_ = $';
 371         }
 372
 373         if ($catching_string) {
 374             my $in_string = 0;
 375             s/\s*//;
 376             while ($_) {
 377                 if (s/^\"//) {
 378                     $in_string = !$in_string;
 379                 }
 380                 if ($in_string) {
 381                     if (s/^[^\"\\]+//) {
 382                         $str .= $&;
 383                     }
 384                     elsif (s/^\\([ntbrf\\\"])//) {
 385                         $str .= "\n" if $1 eq "n";
 386                         $str .= "\t" if $1 eq "t";
 387                         $str .= "\b" if $1 eq "b";
 388                         $str .= "\r" if $1 eq "r";
 389                         $str .= "\f" if $1 eq "f";
 390                         $str .= "\\" if $1 eq "\\";
 391                         $str .= "\"" if $1 eq "\"";
 392                     }
 393                     elsif (s/\\([0-9]+)//) {
 394                         $str .= chr(oct($1));
 395                     }
 396                     elsif (s/\\[xX]([0-9a-fA-F]+)//) {
 397                         $str .= chr(hex($1));
 398                     }
 399                     else {
 400                         die "Invalid control sequence." if /^\\/;
 401                     }
 402                 }
 403                 else {
 404                     s/\s*//;
 405                     last if /^[^"]/;
 406                 }
 407             }
 408         }
 409     }
 410     if ($catching_string) {
 411         &po_flush($id, $str);
 412
 413     }
 414 }
 415
 416 sub po_flush {
 417     my $id = $_[0];
 418     my $str = $_[1];
 419     # We use a translation only if $id is non-empty (we don't include the
 420     # PO file header) and if $str is non-empty (the message is translated).
 421     if ($id && $str) {
 422         $translation{$id} = $str;
 423     }
 424     $id = "";
 425     $str = "";
 426 }
 427
 428