"Fossies" - the Fresh Open Source Software Archive

Member "OpenSP-1.5.2/msggen.pl" (23 Dec 2005, 8649 Bytes) of package /linux/misc/old/OpenSP-1.5.2.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "msggen.pl" see the Fossies "Dox" file reference documentation.

    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