apps/silcer/xml-i18n-extract.in

   1 #!@XML_I18N_TOOLS_PERL@ -w
   2 # -*- Mode: perl; indent-tabs-mode: nil; c-basic-offset: 4  -*-
   3
   4 #
   5 #  The XML Translation Extractor
   6 #
   7 #  Copyright (C) 2000 Free Software Foundation.
   8 #
   9 #  This library is free software; you can redistribute it and/or
  10 #  modify it under the terms of the GNU General Public License as
  11 #  published by the Free Software Foundation; either version 2 of the
  12 #  License, or (at your option) any later version.
  13 #
  14 #  This script is distributed in the hope that it will be useful,
  15 #  but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17 #  General Public License for more details.
  18 #
  19 #  You should have received a copy of the GNU General Public License
  20 #  along with this library; if not, write to the Free Software
  21 #  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  22 #
  23 #  Authors: Kenneth Christiansen <kenneth@gnu.org>
  24 #           Darin Adler <darin@eazel.com>
  25 #
  26
  27 ## Release information
  28 my $PROGRAM      = "xml-i18n-extract";
  29 my $PACKAGE      = "xml-i18n-tools";
  30 my $VERSION      = "0.9";
  31
  32 ## Script options - Enable by setting value to 1
  33 my $ENABLE_INI   = "1"; ## desktop and alike files
  34 my $ENABLE_KEYS  = "1"; ## mimetype descriptions
  35 my $ENABLE_GLADE = "1"; ## glade files
  36 my $ENABLE_XML   = "1"; ## generic xml files
  37
  38 ## Loaded modules
  39 use strict;
  40 use File::Basename;
  41 use Getopt::Long;
  42
  43 ## Scalars used by the option stuff
  44 my $TYPE_ARG    = "0";
  45 my $LOCAL_ARG   = "0";
  46 my $HELP_ARG    = "0";
  47 my $VERSION_ARG = "0";
  48 my $UPDATE_ARG  = "0";
  49 my $QUIET_ARG   = "0";
  50
  51 my $FILE;
  52 my $OUTFILE;
  53
  54 my $gettext_type = "";
  55 my $input;
  56 my %messages = ();
  57
  58 ## Always print first
  59 $| = 1;
  60
  61 ## Handle options
  62 GetOptions (
  63             "type=s"     => \$TYPE_ARG,
  64             "local|l"    => \$LOCAL_ARG,
  65             "help|h|?"   => \$HELP_ARG,
  66             "version|v"  => \$VERSION_ARG,
  67             "update"     => \$UPDATE_ARG,
  68             "quiet|q"    => \$QUIET_ARG,
  69             ) or &error;
  70
  71 &split_on_argument;
  72
  73
  74 ## Check for options.
  75 ## This section will check for the different options.
  76
  77 sub split_on_argument {
  78
  79     if ($VERSION_ARG) {
  80         &version;
  81
  82     } elsif ($HELP_ARG) {
  83         &help;
  84
  85     } elsif ($LOCAL_ARG) {
  86         &place_local;
  87         &extract;
  88
  89     } elsif ($UPDATE_ARG) {
  90         &place_normal;
  91         &extract;
  92
  93     } elsif (@ARGV > 0) {
  94         &place_normal;
  95         &message;
  96         &extract;
  97
  98     } else {
  99         &help;
 100
 101     }
 102 }
 103
 104 sub place_normal {
 105     $FILE        = $ARGV[0];
 106     $OUTFILE     = "$FILE.h";
 107 }
 108
 109 sub place_local {
 110     $OUTFILE     = fileparse($FILE, ());
 111     if (!-e "tmp/") {
 112         system("mkdir tmp/");
 113     }
 114     $OUTFILE     = "./tmp/$OUTFILE.h"
 115 }
 116
 117 sub determine_type {
 118    if ($TYPE_ARG =~ /^gettext\/(.*)/) {
 119         $gettext_type=$1
 120    }
 121 }
 122
 123 ## Sub for printing release information
 124 sub version{
 125     print "${PROGRAM} (${PACKAGE}) $VERSION\n";
 126     print "Copyright (C) 2000 Free Software Foundation, Inc.\n";
 127     print "Written by Kenneth Christiansen, 2000.\n\n";
 128     print "This is free software; see the source for copying conditions. There is NO\n";
 129     print "warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n";
 130     exit;
 131 }
 132
 133 ## Sub for printing usage information
 134 sub help{
 135     print "Usage: ${PROGRAM} [FILENAME] [OPTIONS] ...\n";
 136     print "Generates a header file from an xml source file.\n\nGrabs all strings ";
 137     print "between <_translatable_node> and it's end tag,\nwhere tag are all allowed ";
 138     print "xml tags. Read the docs for more info.\n\n";
 139     print "  -v, --version                shows the version\n";
 140     print "  -h, --help                   shows this help page\n";
 141     print "  -q, --quiet                  quiet mode\n";
 142     print "\nReport bugs to <kenneth\@gnu.org>.\n";
 143     exit;
 144 }
 145
 146 ## Sub for printing error messages
 147 sub error{
 148 #   print "xml-i18n-extract: invalid option @ARGV\n";
 149     print "Try `${PROGRAM} --help' for more information.\n";
 150     exit;
 151 }
 152
 153 sub message {
 154     print "Generating C format header file for translation.\n";
 155 }
 156
 157 sub extract {
 158     &determine_type;
 159
 160     &convert ($FILE);
 161
 162     open OUT, ">$OUTFILE";
 163     &msg_write;
 164     close OUT;
 165
 166     print "Wrote $OUTFILE\n" unless $QUIET_ARG;
 167 }
 168
 169 sub convert($) {
 170
 171     ## Reading the file
 172     {
 173         local (*IN);
 174         local $/; #slurp mode
 175         open (IN, "<$FILE") || die "can't open $FILE: $!";
 176         $input = <IN>;
 177     }
 178
 179     &type_ini;
 180     &type_keys;
 181     &type_xml;
 182     &type_glade;
 183 }
 184
 185 sub type_ini {
 186
 187     if ($ENABLE_INI) {
 188
 189         ### For generic translatable desktop files ###
 190
 191         if ($gettext_type eq "ini"){
 192
 193             while ($input =~ /^_.*=(.*)$/mg) {
 194                 $messages{$1} = [];
 195             }
 196         }
 197     }
 198 }
 199
 200 sub type_keys {
 201
 202     if ($ENABLE_KEYS) {
 203
 204         ### For generic translatable mime/keys files ###
 205
 206         if ($gettext_type eq "keys"){
 207             while ($input =~ /^\s*_\w+=(.*)$/mg) {
 208                 $messages{$1} = [];
 209             }
 210         }
 211     }
 212 }
 213
 214 sub type_xml {
 215
 216     if ($ENABLE_XML) {
 217
 218         ### For generic translatable XML files ###
 219
 220         if ($gettext_type eq "xml"){
 221
 222             while ($input =~ /[\t\n\s]_\w+=\"([^\"]+)\"/sg) {
 223                 $messages{$1} = [];
 224             }
 225
 226             while ($input =~ /<_(\w+)>([^<]+)<\/_\1>/sg) {
 227                 $messages{$2} = [];
 228             }
 229
 230         }
 231     }
 232 }
 233
 234 sub type_glade {
 235
 236     if ($ENABLE_GLADE) {
 237
 238         ### For translatable Glade XML files ###
 239
 240         if ($gettext_type eq "glade"){
 241
 242             my $translate = "label|title|text|format|copyright|comments|
 243                              preview_text|tooltip";
 244
 245             while ($input =~ /<($translate)>([^<]+)<\/($translate)>/sg) {
 246
 247                 # Glade has some bugs, especially it uses translations tags to contain little
 248                 # non-translatable content. We work around this, by not including these
 249                 # strings that only includes something like: label4, and window1
 250                 if ($2 !~ /^(window|label)[0-9]+$/) {
 251                     $messages{$2} = [];
 252                 }
 253             }
 254
 255             while ($input =~ /<items>(..[^<]*)<\/items>/sg) {
 256                 my @items =  split (/\n/, $1);
 257                 for (my $n = 0; $n < @items; $n++) {
 258                     $messages{$items[$n]} = [];
 259                 }
 260             }
 261
 262         }
 263     }
 264
 265 }
 266
 267 sub msg_write {
 268
 269     foreach my $message (sort keys %messages) {
 270
 271         my ($tag) = @{ $messages{$message} };
 272
 273         # Replace XML entities for some special characters with
 274         # the appropriate gettext syntax for those characters.
 275         $message =~ s/&quot;/\\"/mg; # "
 276         $message =~ s/&lt;/</mg;
 277         $message =~ s/&gt;/>/mg;
 278         $message =~ s/&amp;/&/mg;
 279
 280         print OUT "/* xgettext:no-c-format */\n" if $message =~ /%/;
 281         print OUT "/* $tag */\n" if $tag;
 282
 283         my @lines = split (/\n/, $message);
 284
 285         for (my $n = 0; $n < @lines; $n++) {
 286
 287             if ($n == 0) {
 288                 print OUT "char *s = N_(\"";
 289             } else {
 290                 print OUT "             \"";
 291             }
 292
 293             print OUT $lines[$n];
 294
 295             if ($n < @lines - 1) {
 296                 print OUT "\\n\"\n";
 297             } else {
 298                 print OUT "\");\n";
 299             }
 300         }
 301     }
 302 }
 303