~ubuntu-branches/ubuntu/raring/virt-manager/raring-proposed

« back to all changes in this revision

Viewing changes to intltool-merge.in

  • Committer: Bazaar Package Importer
  • Author(s): Guido Günther, Laurent Léonard, Guido Günther
  • Date: 2009-10-07 14:04:03 UTC
  • mfrom: (2.3.1 experimental)
  • mto: (2.3.2 experimental)
  • mto: This revision was merged to the branch mainline in revision 21.
  • Revision ID: james.westby@ubuntu.com-20091007140403-kl9yum4ocrar1acq
Tags: 0.8.0-2
[ Laurent Léonard ]
* [61651ae] Drop ${shlibs:Depends} from dependencies since there is no more
  C code.
* [3319434] Drop redo-patches target from debian/rules. Since gbp-pq
  is used now.
* [b04541e] Clean debian/rules. Drop commented post-patches target
  since there is no more autogen.sh.
* [145ba60] Update french translation.
* [799f18e] Update 0001-use-usr-share-gconf-for-schema-data.patch.
* [052f7bb] Remove XS-Python-Version field from debian/control. Since
  it is deprecated with pysupport.
* [bfb1611][1a66b27][a8ce142][4116d07][31ff60a] Fix some misspellings in
  french translation.
* [6e23aff] Clean build dependencies.
* [b71c8c9] Bump Debhelper version to 7.
* [c614f09] Bump Standards-Version to 3.8.3.
* [99a52c2] Clean debian/rules.
* [52f3b63] Add clean target in debian/rules. To clean automatically
  generated files: - debian/pycompat (see #424898)
* [d5e2ef7] Remove tests/Makefile in the debian/rules clean target. To get a
  clean Debian diff at rebuild time, the file is automatically generated.
* [7da6d9b] Don't close connection on all libvirt errors. Pulled from
  upstream 1c886d1863f7.

[ Guido Günther ]
* upload to unstable
* [464fb65] make package arch all since there is no more C code.
* [25f7663] switch to python-support and use python-distutils
* [c4da06a] bump python-libvirt dependency so we get all of VMs new
  features.

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
 
#!@INTLTOOL_PERL@ -w
2
 
# -*- Mode: perl; indent-tabs-mode: nil; c-basic-offset: 4  -*-
3
 
 
4
 
#
5
 
#  The Intltool Message Merger
6
 
#
7
 
#  Copyright (C) 2000, 2003 Free Software Foundation.
8
 
#  Copyright (C) 2000, 2001 Eazel, Inc
9
 
#
10
 
#  Intltool is free software; you can redistribute it and/or
11
 
#  modify it under the terms of the GNU General Public License 
12
 
#  version 2 published by the Free Software Foundation.
13
 
#
14
 
#  Intltool 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 program; if not, write to the Free Software
21
 
#  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
22
 
#
23
 
#  As a special exception to the GNU General Public License, if you
24
 
#  distribute this file as part of a program that contains a
25
 
#  configuration script generated by Autoconf, you may include it under
26
 
#  the same distribution terms that you use for the rest of that program.
27
 
#
28
 
#  Authors:  Maciej Stachowiak <mjs@noisehavoc.org>
29
 
#            Kenneth Christiansen <kenneth@gnu.org>
30
 
#            Darin Adler <darin@bentspoon.com>
31
 
#
32
 
#  Proper XML UTF-8'ification written by Cyrille Chepelov <chepelov@calixo.net>
33
 
#
34
 
 
35
 
## Release information
36
 
my $PROGRAM = "intltool-merge";
37
 
my $PACKAGE = "intltool";
38
 
my $VERSION = "0.37.1";
39
 
 
40
 
## Loaded modules
41
 
use strict; 
42
 
use Getopt::Long;
43
 
use Text::Wrap;
44
 
use File::Basename;
45
 
 
46
 
my $must_end_tag      = -1;
47
 
my $last_depth        = -1;
48
 
my $translation_depth = -1;
49
 
my @tag_stack = ();
50
 
my @entered_tag = ();
51
 
my @translation_strings = ();
52
 
my $leading_space = "";
53
 
 
54
 
## Scalars used by the option stuff
55
 
my $HELP_ARG = 0;
56
 
my $VERSION_ARG = 0;
57
 
my $BA_STYLE_ARG = 0;
58
 
my $XML_STYLE_ARG = 0;
59
 
my $KEYS_STYLE_ARG = 0;
60
 
my $DESKTOP_STYLE_ARG = 0;
61
 
my $SCHEMAS_STYLE_ARG = 0;
62
 
my $RFC822DEB_STYLE_ARG = 0;
63
 
my $QUOTED_STYLE_ARG = 0;
64
 
my $QUOTEDXML_STYLE_ARG = 0;
65
 
my $QUIET_ARG = 0;
66
 
my $PASS_THROUGH_ARG = 0;
67
 
my $UTF8_ARG = 0;
68
 
my $MULTIPLE_OUTPUT = 0;
69
 
my $cache_file;
70
 
 
71
 
## Handle options
72
 
GetOptions 
73
 
(
74
 
 "help" => \$HELP_ARG,
75
 
 "version" => \$VERSION_ARG,
76
 
 "quiet|q" => \$QUIET_ARG,
77
 
 "oaf-style|o" => \$BA_STYLE_ARG, ## for compatibility
78
 
 "ba-style|b" => \$BA_STYLE_ARG,
79
 
 "xml-style|x" => \$XML_STYLE_ARG,
80
 
 "keys-style|k" => \$KEYS_STYLE_ARG,
81
 
 "desktop-style|d" => \$DESKTOP_STYLE_ARG,
82
 
 "schemas-style|s" => \$SCHEMAS_STYLE_ARG,
83
 
 "rfc822deb-style|r" => \$RFC822DEB_STYLE_ARG,
84
 
 "quoted-style" => \$QUOTED_STYLE_ARG,
85
 
 "quotedxml-style" => \$QUOTEDXML_STYLE_ARG,
86
 
 "pass-through|p" => \$PASS_THROUGH_ARG,
87
 
 "utf8|u" => \$UTF8_ARG,
88
 
 "multiple-output|m" => \$MULTIPLE_OUTPUT,
89
 
 "cache|c=s" => \$cache_file
90
 
 ) or &error;
91
 
 
92
 
my $PO_DIR;
93
 
my $FILE;
94
 
my $OUTFILE;
95
 
 
96
 
my %po_files_by_lang = ();
97
 
my %translations = ();
98
 
my $iconv = $ENV{"ICONV"} || "iconv";
99
 
my $devnull = ($^O eq 'MSWin32' ? 'NUL:' : '/dev/null');
100
 
 
101
 
sub isProgramInPath
102
 
{
103
 
    my ($file) = @_;
104
 
    # If either a file exists, or when run it returns 0 exit status
105
 
    return 1 if ((-x $file) or (system("$file -l >$devnull") == 0));
106
 
    return 0;
107
 
}
108
 
 
109
 
if (! isProgramInPath ("$iconv"))
110
 
{
111
 
        print STDERR " *** iconv is not found on this system!\n".
112
 
                     " *** Without it, intltool-merge can not convert encodings.\n";
113
 
        exit;
114
 
}
115
 
 
116
 
# Use this instead of \w for XML files to handle more possible characters.
117
 
my $w = "[-A-Za-z0-9._:]";
118
 
 
119
 
# XML quoted string contents
120
 
my $q = "[^\\\"]*";
121
 
 
122
 
## Check for options. 
123
 
 
124
 
if ($VERSION_ARG) 
125
 
{
126
 
        &print_version;
127
 
128
 
elsif ($HELP_ARG) 
129
 
{
130
 
        &print_help;
131
 
132
 
elsif ($BA_STYLE_ARG && @ARGV > 2) 
133
 
{
134
 
        &utf8_sanity_check;
135
 
        &preparation;
136
 
        &print_message;
137
 
        &ba_merge_translations;
138
 
        &finalize;
139
 
140
 
elsif ($XML_STYLE_ARG && @ARGV > 2) 
141
 
{
142
 
        &utf8_sanity_check;
143
 
        &preparation;
144
 
        &print_message;
145
 
        &xml_merge_output;
146
 
        &finalize;
147
 
148
 
elsif ($KEYS_STYLE_ARG && @ARGV > 2) 
149
 
{
150
 
        &utf8_sanity_check;
151
 
        &preparation;
152
 
        &print_message;
153
 
        &keys_merge_translations;
154
 
        &finalize;
155
 
156
 
elsif ($DESKTOP_STYLE_ARG && @ARGV > 2) 
157
 
{
158
 
        &utf8_sanity_check;
159
 
        &preparation;
160
 
        &print_message;
161
 
        &desktop_merge_translations;
162
 
        &finalize;
163
 
164
 
elsif ($SCHEMAS_STYLE_ARG && @ARGV > 2) 
165
 
{
166
 
        &utf8_sanity_check;
167
 
        &preparation;
168
 
        &print_message;
169
 
        &schemas_merge_translations;
170
 
        &finalize;
171
 
172
 
elsif ($RFC822DEB_STYLE_ARG && @ARGV > 2) 
173
 
{
174
 
        &preparation;
175
 
        &print_message;
176
 
        &rfc822deb_merge_translations;
177
 
        &finalize;
178
 
179
 
elsif (($QUOTED_STYLE_ARG || $QUOTEDXML_STYLE_ARG) && @ARGV > 2)
180
 
{
181
 
        &utf8_sanity_check;
182
 
        &preparation;
183
 
        &print_message;
184
 
        &quoted_merge_translations($QUOTEDXML_STYLE_ARG);
185
 
        &finalize;
186
 
187
 
else 
188
 
{
189
 
        &print_help;
190
 
}
191
 
 
192
 
exit;
193
 
 
194
 
## Sub for printing release information
195
 
sub print_version
196
 
{
197
 
    print <<_EOF_;
198
 
${PROGRAM} (${PACKAGE}) ${VERSION}
199
 
Written by Maciej Stachowiak, Darin Adler and Kenneth Christiansen.
200
 
 
201
 
Copyright (C) 2000-2003 Free Software Foundation, Inc.
202
 
Copyright (C) 2000-2001 Eazel, Inc.
203
 
This is free software; see the source for copying conditions.  There is NO
204
 
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
205
 
_EOF_
206
 
    exit;
207
 
}
208
 
 
209
 
## Sub for printing usage information
210
 
sub print_help
211
 
{
212
 
    print <<_EOF_;
213
 
Usage: ${PROGRAM} [OPTION]... PO_DIRECTORY FILENAME OUTPUT_FILE
214
 
Generates an output file that includes some localized attributes from an
215
 
untranslated source file.
216
 
 
217
 
Mandatory options: (exactly one must be specified)
218
 
  -b, --ba-style         includes translations in the bonobo-activation style
219
 
  -d, --desktop-style    includes translations in the desktop style
220
 
  -k, --keys-style       includes translations in the keys style
221
 
  -s, --schemas-style    includes translations in the schemas style
222
 
  -r, --rfc822deb-style  includes translations in the RFC822 style
223
 
      --quoted-style     includes translations in the quoted string style
224
 
      --quotedxml-style  includes translations in the quoted xml string style
225
 
  -x, --xml-style        includes translations in the standard xml style
226
 
 
227
 
Other options:
228
 
  -u, --utf8             convert all strings to UTF-8 before merging 
229
 
                         (default for everything except RFC822 style)
230
 
  -p, --pass-through     deprecated, does nothing and issues a warning
231
 
  -m, --multiple-output  output one localized file per locale, instead of 
232
 
                         a single file containing all localized elements
233
 
  -c, --cache=FILE       specify cache file name
234
 
                         (usually \$top_builddir/po/.intltool-merge-cache)
235
 
  -q, --quiet            suppress most messages
236
 
      --help             display this help and exit
237
 
      --version          output version information and exit
238
 
 
239
 
Report bugs to http://bugzilla.gnome.org/ (product name "$PACKAGE")
240
 
or send email to <xml-i18n-tools\@gnome.org>.
241
 
_EOF_
242
 
    exit;
243
 
}
244
 
 
245
 
 
246
 
## Sub for printing error messages
247
 
sub print_error
248
 
{
249
 
    print STDERR "Try `${PROGRAM} --help' for more information.\n";
250
 
    exit;
251
 
}
252
 
 
253
 
 
254
 
sub print_message 
255
 
{
256
 
    print "Merging translations into $OUTFILE.\n" unless $QUIET_ARG;
257
 
}
258
 
 
259
 
 
260
 
sub preparation 
261
 
{
262
 
    $PO_DIR = $ARGV[0];
263
 
    $FILE = $ARGV[1];
264
 
    $OUTFILE = $ARGV[2];
265
 
 
266
 
    &gather_po_files;
267
 
    &get_translation_database;
268
 
}
269
 
 
270
 
# General-purpose code for looking up translations in .po files
271
 
 
272
 
sub po_file2lang
273
 
{
274
 
    my ($tmp) = @_; 
275
 
    $tmp =~ s/^.*\/(.*)\.po$/$1/; 
276
 
    return $tmp; 
277
 
}
278
 
 
279
 
sub gather_po_files
280
 
{
281
 
    if (my $linguas = $ENV{"LINGUAS"})
282
 
    {
283
 
        for my $lang (split / /, $linguas) {
284
 
            my $po_file = $PO_DIR . "/" . $lang . ".po";
285
 
            if (-e $po_file) {
286
 
                $po_files_by_lang{$lang} = $po_file;
287
 
            }
288
 
        }
289
 
    }
290
 
    else
291
 
    {
292
 
        if (open LINGUAS_FILE, "$PO_DIR/LINGUAS")
293
 
        {
294
 
            while (<LINGUAS_FILE>)
295
 
            {
296
 
                next if /^#/;
297
 
 
298
 
                for my $lang (split)
299
 
                {
300
 
                    chomp ($lang);
301
 
                    my $po_file = $PO_DIR . "/" . $lang . ".po";
302
 
                    if (-e $po_file) {
303
 
                        $po_files_by_lang{$lang} = $po_file;
304
 
                    }
305
 
                }
306
 
            }
307
 
 
308
 
            close LINGUAS_FILE;
309
 
        }
310
 
        else
311
 
        {
312
 
            for my $po_file (glob "$PO_DIR/*.po") {
313
 
                $po_files_by_lang{po_file2lang($po_file)} = $po_file;
314
 
            }
315
 
        }
316
 
    }
317
 
}
318
 
 
319
 
sub get_local_charset
320
 
{
321
 
    my ($encoding) = @_;
322
 
    my $alias_file = $ENV{"G_CHARSET_ALIAS"} || "@INTLTOOL_LIBDIR@/charset.alias";
323
 
 
324
 
    # seek character encoding aliases in charset.alias (glib)
325
 
 
326
 
    if (open CHARSET_ALIAS, $alias_file) 
327
 
    {
328
 
        while (<CHARSET_ALIAS>) 
329
 
        {
330
 
            next if /^\#/;
331
 
            return $1 if (/^\s*([-._a-zA-Z0-9]+)\s+$encoding\b/i)
332
 
        }
333
 
 
334
 
        close CHARSET_ALIAS;
335
 
    }
336
 
 
337
 
    # if not found, return input string
338
 
 
339
 
    return $encoding;
340
 
}
341
 
 
342
 
sub get_po_encoding
343
 
{
344
 
    my ($in_po_file) = @_;
345
 
    my $encoding = "";
346
 
 
347
 
    open IN_PO_FILE, $in_po_file or die;
348
 
    while (<IN_PO_FILE>) 
349
 
    {
350
 
        ## example: "Content-Type: text/plain; charset=ISO-8859-1\n"
351
 
        if (/Content-Type\:.*charset=([-a-zA-Z0-9]+)\\n/) 
352
 
        {
353
 
            $encoding = $1; 
354
 
            last;
355
 
        }
356
 
    }
357
 
    close IN_PO_FILE;
358
 
 
359
 
    if (!$encoding) 
360
 
    {
361
 
        print STDERR "Warning: no encoding found in $in_po_file. Assuming ISO-8859-1\n" unless $QUIET_ARG;
362
 
        $encoding = "ISO-8859-1";
363
 
    }
364
 
 
365
 
    system ("$iconv -f $encoding -t UTF-8 <$devnull 2>$devnull");
366
 
    if ($?) {
367
 
        $encoding = get_local_charset($encoding);
368
 
    }
369
 
 
370
 
    return $encoding
371
 
}
372
 
 
373
 
sub utf8_sanity_check 
374
 
{
375
 
    print STDERR "Warning: option --pass-through has been removed.\n" if $PASS_THROUGH_ARG;
376
 
    $UTF8_ARG = 1;
377
 
}
378
 
 
379
 
sub get_translation_database
380
 
{
381
 
    if ($cache_file) {
382
 
        &get_cached_translation_database;
383
 
    } else {
384
 
        &create_translation_database;
385
 
    }
386
 
}
387
 
 
388
 
sub get_newest_po_age
389
 
{
390
 
    my $newest_age;
391
 
 
392
 
    foreach my $file (values %po_files_by_lang) 
393
 
    {
394
 
        my $file_age = -M $file;
395
 
        $newest_age = $file_age if !$newest_age || $file_age < $newest_age;
396
 
    }
397
 
 
398
 
    $newest_age = 0 if !$newest_age;
399
 
 
400
 
    return $newest_age;
401
 
}
402
 
 
403
 
sub create_cache
404
 
{
405
 
    print "Generating and caching the translation database\n" unless $QUIET_ARG;
406
 
 
407
 
    &create_translation_database;
408
 
 
409
 
    open CACHE, ">$cache_file" || die;
410
 
    print CACHE join "\x01", %translations;
411
 
    close CACHE;
412
 
}
413
 
 
414
 
sub load_cache 
415
 
{
416
 
    print "Found cached translation database\n" unless $QUIET_ARG;
417
 
 
418
 
    my $contents;
419
 
    open CACHE, "<$cache_file" || die;
420
 
    {
421
 
        local $/;
422
 
        $contents = <CACHE>;
423
 
    }
424
 
    close CACHE;
425
 
    %translations = split "\x01", $contents;
426
 
}
427
 
 
428
 
sub get_cached_translation_database
429
 
{
430
 
    my $cache_file_age = -M $cache_file;
431
 
    if (defined $cache_file_age) 
432
 
    {
433
 
        if ($cache_file_age <= &get_newest_po_age) 
434
 
        {
435
 
            &load_cache;
436
 
            return;
437
 
        }
438
 
        print "Found too-old cached translation database\n" unless $QUIET_ARG;
439
 
    }
440
 
 
441
 
    &create_cache;
442
 
}
443
 
 
444
 
sub create_translation_database
445
 
{
446
 
    for my $lang (keys %po_files_by_lang) 
447
 
    {
448
 
        my $po_file = $po_files_by_lang{$lang};
449
 
 
450
 
        if ($UTF8_ARG) 
451
 
        {
452
 
            my $encoding = get_po_encoding ($po_file);
453
 
 
454
 
            if (lc $encoding eq "utf-8") 
455
 
            {
456
 
                open PO_FILE, "<$po_file";      
457
 
            } 
458
 
            else 
459
 
            {
460
 
                print "NOTICE: $po_file is not in UTF-8 but $encoding, converting...\n" unless $QUIET_ARG;;
461
 
 
462
 
                open PO_FILE, "$iconv -f $encoding -t UTF-8 $po_file|"; 
463
 
            }
464
 
        } 
465
 
        else 
466
 
        {
467
 
            open PO_FILE, "<$po_file";  
468
 
        }
469
 
 
470
 
        my $nextfuzzy = 0;
471
 
        my $inmsgid = 0;
472
 
        my $inmsgstr = 0;
473
 
        my $msgid = "";
474
 
        my $msgstr = "";
475
 
 
476
 
        while (<PO_FILE>) 
477
 
        {
478
 
            $nextfuzzy = 1 if /^#, fuzzy/;
479
 
       
480
 
            if (/^msgid "((\\.|[^\\]+)*)"/ ) 
481
 
            {
482
 
                $translations{$lang, $msgid} = $msgstr if $inmsgstr && $msgid && $msgstr;
483
 
                $msgid = "";
484
 
                $msgstr = "";
485
 
 
486
 
                if ($nextfuzzy) {
487
 
                    $inmsgid = 0;
488
 
                } else {
489
 
                    $msgid = unescape_po_string($1);
490
 
                    $inmsgid = 1;
491
 
                }
492
 
                $inmsgstr = 0;
493
 
                $nextfuzzy = 0;
494
 
            }
495
 
 
496
 
            if (/^msgstr "((\\.|[^\\]+)*)"/) 
497
 
            {
498
 
                $msgstr = unescape_po_string($1);
499
 
                $inmsgstr = 1;
500
 
                $inmsgid = 0;
501
 
            }
502
 
 
503
 
            if (/^"((\\.|[^\\]+)*)"/) 
504
 
            {
505
 
                $msgid .= unescape_po_string($1) if $inmsgid;
506
 
                $msgstr .= unescape_po_string($1) if $inmsgstr;
507
 
            }
508
 
        }
509
 
        $translations{$lang, $msgid} = $msgstr if $inmsgstr && $msgid && $msgstr;
510
 
    }
511
 
}
512
 
 
513
 
sub finalize
514
 
{
515
 
}
516
 
 
517
 
sub unescape_one_sequence
518
 
{
519
 
    my ($sequence) = @_;
520
 
 
521
 
    return "\\" if $sequence eq "\\\\";
522
 
    return "\"" if $sequence eq "\\\"";
523
 
    return "\n" if $sequence eq "\\n";
524
 
    return "\r" if $sequence eq "\\r";
525
 
    return "\t" if $sequence eq "\\t";
526
 
    return "\b" if $sequence eq "\\b";
527
 
    return "\f" if $sequence eq "\\f";
528
 
    return "\a" if $sequence eq "\\a";
529
 
    return chr(11) if $sequence eq "\\v"; # vertical tab, see ascii(7)
530
 
 
531
 
    return chr(hex($1)) if ($sequence =~ /\\x([0-9a-fA-F]{2})/);
532
 
    return chr(oct($1)) if ($sequence =~ /\\([0-7]{3})/);
533
 
 
534
 
    # FIXME: Is \0 supported as well? Kenneth and Rodney don't want it, see bug #48489
535
 
 
536
 
    return $sequence;
537
 
}
538
 
 
539
 
sub unescape_po_string
540
 
{
541
 
    my ($string) = @_;
542
 
 
543
 
    $string =~ s/(\\x[0-9a-fA-F]{2}|\\[0-7]{3}|\\.)/unescape_one_sequence($1)/eg;
544
 
 
545
 
    return $string;
546
 
}
547
 
 
548
 
sub entity_decode
549
 
{
550
 
    local ($_) = @_;
551
 
 
552
 
    s/&apos;/'/g; # '
553
 
    s/&quot;/"/g; # "
554
 
    s/&lt;/</g;
555
 
    s/&gt;/>/g;
556
 
    s/&amp;/&/g;
557
 
 
558
 
    return $_;
559
 
}
560
 
 
561
 
# entity_encode: (string)
562
 
#
563
 
# Encode the given string to XML format (encode '<' etc).
564
 
 
565
 
sub entity_encode
566
 
{
567
 
    my ($pre_encoded) = @_;
568
 
 
569
 
    my @list_of_chars = unpack ('C*', $pre_encoded);
570
 
 
571
 
    # with UTF-8 we only encode minimalistic
572
 
    return join ('', map (&entity_encode_int_minimalist, @list_of_chars));
573
 
}
574
 
 
575
 
sub entity_encode_int_minimalist
576
 
{
577
 
    return "&quot;" if $_ == 34;
578
 
    return "&amp;" if $_ == 38;
579
 
    return "&apos;" if $_ == 39;
580
 
    return "&lt;" if $_ == 60;
581
 
    return "&gt;" if $_ == 62;
582
 
    return chr $_;
583
 
}
584
 
 
585
 
sub entity_encoded_translation
586
 
{
587
 
    my ($lang, $string) = @_;
588
 
 
589
 
    my $translation = $translations{$lang, $string};
590
 
    return $string if !$translation;
591
 
    return entity_encode ($translation);
592
 
}
593
 
 
594
 
## XML (bonobo-activation specific) merge code
595
 
 
596
 
sub ba_merge_translations
597
 
{
598
 
    my $source;
599
 
 
600
 
    {
601
 
       local $/; # slurp mode
602
 
       open INPUT, "<$FILE" or die "can't open $FILE: $!";
603
 
       $source = <INPUT>;
604
 
       close INPUT;
605
 
    }
606
 
 
607
 
    open OUTPUT, ">$OUTFILE" or die "can't open $OUTFILE: $!";
608
 
    # Binmode so that selftest works ok if using a native Win32 Perl...
609
 
    binmode (OUTPUT) if $^O eq 'MSWin32';
610
 
 
611
 
    while ($source =~ s|^(.*?)([ \t]*<\s*$w+\s+($w+\s*=\s*"$q"\s*)+/?>)([ \t]*\n)?||s) 
612
 
    {
613
 
        print OUTPUT $1;
614
 
 
615
 
        my $node = $2 . "\n";
616
 
 
617
 
        my @strings = ();
618
 
        $_ = $node;
619
 
        while (s/(\s)_($w+\s*=\s*"($q)")/$1$2/s) {
620
 
             push @strings, entity_decode($3);
621
 
        }
622
 
        print OUTPUT;
623
 
 
624
 
        my %langs;
625
 
        for my $string (@strings) 
626
 
        {
627
 
            for my $lang (keys %po_files_by_lang) 
628
 
            {
629
 
                $langs{$lang} = 1 if $translations{$lang, $string};
630
 
            }
631
 
        }
632
 
        
633
 
        for my $lang (sort keys %langs) 
634
 
        {
635
 
            $_ = $node;
636
 
            s/(\sname\s*=\s*)"($q)"/$1"$2-$lang"/s;
637
 
            s/(\s)_($w+\s*=\s*")($q)"/$1 . $2 . entity_encoded_translation($lang, $3) . '"'/seg;
638
 
            print OUTPUT;
639
 
        }
640
 
    }
641
 
 
642
 
    print OUTPUT $source;
643
 
 
644
 
    close OUTPUT;
645
 
}
646
 
 
647
 
 
648
 
## XML (non-bonobo-activation) merge code
649
 
 
650
 
 
651
 
# Process tag attributes
652
 
#   Only parameter is a HASH containing attributes -> values mapping
653
 
sub getAttributeString
654
 
{
655
 
    my $sub = shift;
656
 
    my $do_translate = shift || 0;
657
 
    my $language = shift || "";
658
 
    my $result = "";
659
 
    my $translate = shift;
660
 
    foreach my $e (reverse(sort(keys %{ $sub }))) {
661
 
        my $key    = $e;
662
 
        my $string = $sub->{$e};
663
 
        my $quote = '"';
664
 
        
665
 
        $string =~ s/^[\s]+//;
666
 
        $string =~ s/[\s]+$//;
667
 
        
668
 
        if ($string =~ /^'.*'$/)
669
 
        {
670
 
            $quote = "'";
671
 
        }
672
 
        $string =~ s/^['"]//g;
673
 
        $string =~ s/['"]$//g;
674
 
 
675
 
        if ($do_translate && $key =~ /^_/) {
676
 
            $key =~ s|^_||g;
677
 
            if ($language) {
678
 
                # Handle translation
679
 
                my $decode_string = entity_decode($string);
680
 
                my $translation = $translations{$language, $decode_string};
681
 
                if ($translation) {
682
 
                    $translation = entity_encode($translation);
683
 
                    $string = $translation;
684
 
                }
685
 
                $$translate = 2;
686
 
            } else {
687
 
                 $$translate = 2 if ($translate && (!$$translate)); # watch not to "overwrite" $translate
688
 
            }
689
 
        }
690
 
        
691
 
        $result .= " $key=$quote$string$quote";
692
 
    }
693
 
    return $result;
694
 
}
695
 
 
696
 
# Returns a translatable string from XML node, it works on contents of every node in XML::Parser tree
697
 
sub getXMLstring
698
 
{
699
 
    my $ref = shift;
700
 
    my $spacepreserve = shift || 0;
701
 
    my @list = @{ $ref };
702
 
    my $result = "";
703
 
 
704
 
    my $count = scalar(@list);
705
 
    my $attrs = $list[0];
706
 
    my $index = 1;
707
 
 
708
 
    $spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/));
709
 
    $spacepreserve = 0 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?default["']?$/));
710
 
 
711
 
    while ($index < $count) {
712
 
        my $type = $list[$index];
713
 
        my $content = $list[$index+1];
714
 
        if (! $type ) {
715
 
            # We've got CDATA
716
 
            if ($content) {
717
 
                # lets strip the whitespace here, and *ONLY* here
718
 
                $content =~ s/\s+/ /gs if (!$spacepreserve);
719
 
                $result .= $content;
720
 
            }
721
 
        } elsif ( "$type" ne "1" ) {
722
 
            # We've got another element
723
 
            $result .= "<$type";
724
 
            $result .= getAttributeString(@{$content}[0], 0); # no nested translatable elements
725
 
            if ($content) {
726
 
                my $subresult = getXMLstring($content, $spacepreserve);
727
 
                if ($subresult) {
728
 
                    $result .= ">".$subresult . "</$type>";
729
 
                } else {
730
 
                    $result .= "/>";
731
 
                }
732
 
            } else {
733
 
                $result .= "/>";
734
 
            }
735
 
        }
736
 
        $index += 2;
737
 
    }
738
 
    return $result;
739
 
}
740
 
 
741
 
# Translate list of nodes if necessary
742
 
sub translate_subnodes
743
 
{
744
 
    my $fh = shift;
745
 
    my $content = shift;
746
 
    my $language = shift || "";
747
 
    my $singlelang = shift || 0;
748
 
    my $spacepreserve = shift || 0;
749
 
 
750
 
    my @nodes = @{ $content };
751
 
 
752
 
    my $count = scalar(@nodes);
753
 
    my $index = 0;
754
 
    while ($index < $count) {
755
 
        my $type = $nodes[$index];
756
 
        my $rest = $nodes[$index+1];
757
 
        if ($singlelang) {
758
 
            my $oldMO = $MULTIPLE_OUTPUT;
759
 
            $MULTIPLE_OUTPUT = 1;
760
 
            traverse($fh, $type, $rest, $language, $spacepreserve);
761
 
            $MULTIPLE_OUTPUT = $oldMO;
762
 
        } else {
763
 
            traverse($fh, $type, $rest, $language, $spacepreserve);
764
 
        }
765
 
        $index += 2;
766
 
    }
767
 
}
768
 
 
769
 
sub isWellFormedXmlFragment
770
 
{
771
 
    my $ret = eval 'require XML::Parser';
772
 
    if(!$ret) {
773
 
        die "You must have XML::Parser installed to run $0\n\n";
774
 
    } 
775
 
 
776
 
    my $fragment = shift;
777
 
    return 0 if (!$fragment);
778
 
 
779
 
    $fragment = "<root>$fragment</root>";
780
 
    my $xp = new XML::Parser(Style => 'Tree');
781
 
    my $tree = 0;
782
 
    eval { $tree = $xp->parse($fragment); };
783
 
    return $tree;
784
 
}
785
 
 
786
 
sub traverse
787
 
{
788
 
    my $fh = shift; 
789
 
    my $nodename = shift;
790
 
    my $content = shift;
791
 
    my $language = shift || "";
792
 
    my $spacepreserve = shift || 0;
793
 
 
794
 
    if (!$nodename) {
795
 
        if ($content =~ /^[\s]*$/) {
796
 
            $leading_space .= $content;
797
 
        }
798
 
        print $fh $content;
799
 
    } else {
800
 
        # element
801
 
        my @all = @{ $content };
802
 
        my $attrs = shift @all;
803
 
        my $translate = 0;
804
 
        my $outattr = getAttributeString($attrs, 1, $language, \$translate);
805
 
 
806
 
        if ($nodename =~ /^_/) {
807
 
            $translate = 1;
808
 
            $nodename =~ s/^_//;
809
 
        }
810
 
        my $lookup = '';
811
 
 
812
 
        $spacepreserve = 0 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?default["']?$/));
813
 
        $spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/));
814
 
 
815
 
        print $fh "<$nodename", $outattr;
816
 
        if ($translate) {
817
 
            $lookup = getXMLstring($content, $spacepreserve);
818
 
            if (!$spacepreserve) {
819
 
                $lookup =~ s/^\s+//s;
820
 
                $lookup =~ s/\s+$//s;
821
 
            }
822
 
 
823
 
            if ($lookup || $translate == 2) {
824
 
                my $translation = $translations{$language, $lookup} if isWellFormedXmlFragment($translations{$language, $lookup});
825
 
                if ($MULTIPLE_OUTPUT && ($translation || $translate == 2)) {
826
 
                    $translation = $lookup if (!$translation);
827
 
                    print $fh " xml:lang=\"", $language, "\"" if $language;
828
 
                    print $fh ">";
829
 
                    if ($translate == 2) {
830
 
                        translate_subnodes($fh, \@all, $language, 1, $spacepreserve);
831
 
                    } else {
832
 
                        print $fh $translation;
833
 
                    }
834
 
                    print $fh "</$nodename>";
835
 
 
836
 
                    return; # this means there will be no same translation with xml:lang="$language"...
837
 
                            # if we want them both, just remove this "return"
838
 
                } else {
839
 
                    print $fh ">";
840
 
                    if ($translate == 2) {
841
 
                        translate_subnodes($fh, \@all, $language, 1, $spacepreserve);
842
 
                    } else {
843
 
                        print $fh $lookup;
844
 
                    }
845
 
                    print $fh "</$nodename>";
846
 
                }
847
 
            } else {
848
 
                print $fh "/>";
849
 
            }
850
 
 
851
 
            for my $lang (sort keys %po_files_by_lang) {
852
 
                    if ($MULTIPLE_OUTPUT && $lang ne "$language") {
853
 
                        next;
854
 
                    }
855
 
                    if ($lang) {
856
 
                        # Handle translation
857
 
                        #
858
 
                        my $translate = 0;
859
 
                        my $localattrs = getAttributeString($attrs, 1, $lang, \$translate);
860
 
                        my $translation = $translations{$lang, $lookup} if isWellFormedXmlFragment($translations{$lang, $lookup});
861
 
                        if ($translate && !$translation) {
862
 
                            $translation = $lookup;
863
 
                        }
864
 
 
865
 
                        if ($translation || $translate) {
866
 
                            print $fh "\n";
867
 
                            $leading_space =~ s/.*\n//g;
868
 
                            print $fh $leading_space;
869
 
                            print $fh "<", $nodename, " xml:lang=\"", $lang, "\"", $localattrs, ">";
870
 
                            if ($translate == 2) {
871
 
                               translate_subnodes($fh, \@all, $lang, 1, $spacepreserve);
872
 
                            } else {
873
 
                                print $fh $translation;
874
 
                            }
875
 
                            print $fh "</$nodename>";
876
 
                        }
877
 
                    }
878
 
            }
879
 
 
880
 
        } else {
881
 
            my $count = scalar(@all);
882
 
            if ($count > 0) {
883
 
                print $fh ">";
884
 
                my $index = 0;
885
 
                while ($index < $count) {
886
 
                    my $type = $all[$index];
887
 
                    my $rest = $all[$index+1];
888
 
                    traverse($fh, $type, $rest, $language, $spacepreserve);
889
 
                    $index += 2;
890
 
                }
891
 
                print $fh "</$nodename>";
892
 
            } else {
893
 
                print $fh "/>";
894
 
            }
895
 
        }
896
 
    }
897
 
}
898
 
 
899
 
sub intltool_tree_comment
900
 
{
901
 
    my $expat = shift;
902
 
    my $data  = shift;
903
 
    my $clist = $expat->{Curlist};
904
 
    my $pos   = $#$clist;
905
 
 
906
 
    push @$clist, 1 => $data;
907
 
}
908
 
 
909
 
sub intltool_tree_cdatastart
910
 
{
911
 
    my $expat    = shift;
912
 
    my $clist = $expat->{Curlist};
913
 
    my $pos   = $#$clist;
914
 
 
915
 
    push @$clist, 0 => $expat->original_string();
916
 
}
917
 
 
918
 
sub intltool_tree_cdataend
919
 
{
920
 
    my $expat    = shift;
921
 
    my $clist = $expat->{Curlist};
922
 
    my $pos   = $#$clist;
923
 
 
924
 
    $clist->[$pos] .= $expat->original_string();
925
 
}
926
 
 
927
 
sub intltool_tree_char
928
 
{
929
 
    my $expat = shift;
930
 
    my $text  = shift;
931
 
    my $clist = $expat->{Curlist};
932
 
    my $pos   = $#$clist;
933
 
 
934
 
    # Use original_string so that we retain escaped entities
935
 
    # in CDATA sections.
936
 
    #
937
 
    if ($pos > 0 and $clist->[$pos - 1] eq '0') {
938
 
        $clist->[$pos] .= $expat->original_string();
939
 
    } else {
940
 
        push @$clist, 0 => $expat->original_string();
941
 
    }
942
 
}
943
 
 
944
 
sub intltool_tree_start
945
 
{
946
 
    my $expat    = shift;
947
 
    my $tag      = shift;
948
 
    my @origlist = ();
949
 
 
950
 
    # Use original_string so that we retain escaped entities
951
 
    # in attribute values.  We must convert the string to an
952
 
    # @origlist array to conform to the structure of the Tree
953
 
    # Style.
954
 
    #
955
 
    my @original_array = split /\x/, $expat->original_string();
956
 
    my $source         = $expat->original_string();
957
 
 
958
 
    # Remove leading tag.
959
 
    #
960
 
    $source =~ s|^\s*<\s*(\S+)||s;
961
 
 
962
 
    # Grab attribute key/value pairs and push onto @origlist array.
963
 
    #
964
 
    while ($source)
965
 
    {
966
 
       if ($source =~ /^\s*([\w:-]+)\s*[=]\s*["]/)
967
 
       {
968
 
           $source =~ s|^\s*([\w:-]+)\s*[=]\s*["]([^"]*)["]||s;
969
 
           push @origlist, $1;
970
 
           push @origlist, '"' . $2 . '"';
971
 
       }
972
 
       elsif ($source =~ /^\s*([\w:-]+)\s*[=]\s*[']/)
973
 
       {
974
 
           $source =~ s|^\s*([\w:-]+)\s*[=]\s*[']([^']*)[']||s;
975
 
           push @origlist, $1;
976
 
           push @origlist, "'" . $2 . "'";
977
 
       }
978
 
       else
979
 
       {
980
 
           last;
981
 
       }
982
 
    }
983
 
 
984
 
    my $ol = [ { @origlist } ];
985
 
 
986
 
    push @{ $expat->{Lists} }, $expat->{Curlist};
987
 
    push @{ $expat->{Curlist} }, $tag => $ol;
988
 
    $expat->{Curlist} = $ol;
989
 
}
990
 
 
991
 
sub readXml
992
 
{
993
 
    my $filename = shift || return;
994
 
    if(!-f $filename) {
995
 
        die "ERROR Cannot find filename: $filename\n";
996
 
    }
997
 
 
998
 
    my $ret = eval 'require XML::Parser';
999
 
    if(!$ret) {
1000
 
        die "You must have XML::Parser installed to run $0\n\n";
1001
 
    } 
1002
 
    my $xp = new XML::Parser(Style => 'Tree');
1003
 
    $xp->setHandlers(Char => \&intltool_tree_char);
1004
 
    $xp->setHandlers(Start => \&intltool_tree_start);
1005
 
    $xp->setHandlers(CdataStart => \&intltool_tree_cdatastart);
1006
 
    $xp->setHandlers(CdataEnd => \&intltool_tree_cdataend);
1007
 
    my $tree = $xp->parsefile($filename);
1008
 
 
1009
 
# <foo><head id="a">Hello <em>there</em></head><bar>Howdy<ref/></bar>do</foo>
1010
 
# would be:
1011
 
# [foo, [{}, head, [{id => "a"}, 0, "Hello ",  em, [{}, 0, "there"]], bar, [{},
1012
 
# 0, "Howdy",  ref, [{}]], 0, "do" ] ]
1013
 
 
1014
 
    return $tree;
1015
 
}
1016
 
 
1017
 
sub print_header
1018
 
{
1019
 
    my $infile = shift;
1020
 
    my $fh = shift;
1021
 
    my $source;
1022
 
 
1023
 
    if(!-f $infile) {
1024
 
        die "ERROR Cannot find filename: $infile\n";
1025
 
    }
1026
 
 
1027
 
    print $fh qq{<?xml version="1.0" encoding="UTF-8"?>\n};
1028
 
    {
1029
 
        local $/;
1030
 
        open DOCINPUT, "<${FILE}" or die;
1031
 
        $source = <DOCINPUT>;
1032
 
        close DOCINPUT;
1033
 
    }
1034
 
    if ($source =~ /(<!DOCTYPE.*\[.*\]\s*>)/s)
1035
 
    {
1036
 
        print $fh "$1\n";
1037
 
    }
1038
 
    elsif ($source =~ /(<!DOCTYPE[^>]*>)/s)
1039
 
    {
1040
 
        print $fh "$1\n";
1041
 
    }
1042
 
}
1043
 
 
1044
 
sub parseTree
1045
 
{
1046
 
    my $fh        = shift;
1047
 
    my $ref       = shift;
1048
 
    my $language  = shift || "";
1049
 
 
1050
 
    my $name = shift @{ $ref };
1051
 
    my $cont = shift @{ $ref };
1052
 
    
1053
 
    while (!$name || "$name" eq "1") {
1054
 
        $name = shift @{ $ref };
1055
 
        $cont = shift @{ $ref };
1056
 
    }
1057
 
 
1058
 
    my $spacepreserve = 0;
1059
 
    my $attrs = @{$cont}[0];
1060
 
    $spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/));
1061
 
 
1062
 
    traverse($fh, $name, $cont, $language, $spacepreserve);
1063
 
}
1064
 
 
1065
 
sub xml_merge_output
1066
 
{
1067
 
    my $source;
1068
 
 
1069
 
    if ($MULTIPLE_OUTPUT) {
1070
 
        for my $lang (sort keys %po_files_by_lang) {
1071
 
            if ( ! -d $lang ) {
1072
 
                mkdir $lang or -d $lang or die "Cannot create subdirectory $lang: $!\n";
1073
 
            }
1074
 
            open OUTPUT, ">$lang/$OUTFILE" or die "Cannot open $lang/$OUTFILE: $!\n";
1075
 
            binmode (OUTPUT) if $^O eq 'MSWin32';
1076
 
            my $tree = readXml($FILE);
1077
 
            print_header($FILE, \*OUTPUT);
1078
 
            parseTree(\*OUTPUT, $tree, $lang);
1079
 
            close OUTPUT;
1080
 
            print "CREATED $lang/$OUTFILE\n" unless $QUIET_ARG;
1081
 
        }
1082
 
        if ( ! -d "C" ) {
1083
 
            mkdir "C" or -d "C" or die "Cannot create subdirectory C: $!\n";
1084
 
        }
1085
 
        open OUTPUT, ">C/$OUTFILE" or die "Cannot open C/$OUTFILE: $!\n";
1086
 
        binmode (OUTPUT) if $^O eq 'MSWin32';
1087
 
        my $tree = readXml($FILE);
1088
 
        print_header($FILE, \*OUTPUT);
1089
 
        parseTree(\*OUTPUT, $tree);
1090
 
        close OUTPUT;
1091
 
        print "CREATED C/$OUTFILE\n" unless $QUIET_ARG;
1092
 
    } else {
1093
 
        open OUTPUT, ">$OUTFILE" or die "Cannot open $OUTFILE: $!\n";
1094
 
        binmode (OUTPUT) if $^O eq 'MSWin32';
1095
 
        my $tree = readXml($FILE);
1096
 
        print_header($FILE, \*OUTPUT);
1097
 
        parseTree(\*OUTPUT, $tree);
1098
 
        close OUTPUT;
1099
 
        print "CREATED $OUTFILE\n" unless $QUIET_ARG;
1100
 
    }
1101
 
}
1102
 
 
1103
 
sub keys_merge_translation
1104
 
{
1105
 
    my ($lang) = @_;
1106
 
 
1107
 
    if ( ! -d $lang && $MULTIPLE_OUTPUT)
1108
 
    {
1109
 
        mkdir $lang or -d $lang or die "Cannot create subdirectory $lang: $!\n";
1110
 
    }
1111
 
 
1112
 
    open INPUT, "<${FILE}" or die "Cannot open ${FILE}: $!\n";
1113
 
    open OUTPUT, ">$lang/$OUTFILE" or die "Cannot open $lang/$OUTFILE: $!\n";
1114
 
    binmode (OUTPUT) if $^O eq 'MSWin32';
1115
 
 
1116
 
    while (<INPUT>)
1117
 
    {
1118
 
        if (s/^(\s*)_(\w+=(.*))/$1$2/)
1119
 
        {
1120
 
            my $string = $3;
1121
 
 
1122
 
            if (!$MULTIPLE_OUTPUT)
1123
 
            {
1124
 
                print OUTPUT;
1125
 
 
1126
 
                my $non_translated_line = $_;
1127
 
 
1128
 
                for my $lang (sort keys %po_files_by_lang)
1129
 
                {
1130
 
                    my $translation = $translations{$lang, $string};
1131
 
                    next if !$translation;
1132
 
 
1133
 
                    $_ = $non_translated_line;
1134
 
                    s/(\w+)=.*/[$lang]$1=$translation/;
1135
 
                    print OUTPUT;
1136
 
                }
1137
 
            }
1138
 
            else
1139
 
            {
1140
 
                my $non_translated_line = $_;
1141
 
                my $translation = $translations{$lang, $string};
1142
 
                $translation = $string if !$translation;
1143
 
 
1144
 
                $_ = $non_translated_line;
1145
 
                s/(\w+)=.*/$1=$translation/;
1146
 
                print OUTPUT;
1147
 
            }
1148
 
        }
1149
 
        else
1150
 
        {
1151
 
            print OUTPUT;
1152
 
        }
1153
 
    }
1154
 
 
1155
 
    close OUTPUT;
1156
 
    close INPUT;
1157
 
 
1158
 
    print "CREATED $lang/$OUTFILE\n" unless $QUIET_ARG;
1159
 
}
1160
 
 
1161
 
sub keys_merge_translations
1162
 
{
1163
 
    if ($MULTIPLE_OUTPUT)
1164
 
    {
1165
 
        for my $lang (sort keys %po_files_by_lang)
1166
 
        {
1167
 
            keys_merge_translation ($lang);
1168
 
        }
1169
 
        keys_merge_translation ("C");
1170
 
    }
1171
 
    else
1172
 
    {
1173
 
        keys_merge_translation (".");
1174
 
    }
1175
 
}
1176
 
 
1177
 
sub desktop_merge_translations
1178
 
{
1179
 
    open INPUT, "<${FILE}" or die;
1180
 
    open OUTPUT, ">${OUTFILE}" or die;
1181
 
    binmode (OUTPUT) if $^O eq 'MSWin32';
1182
 
 
1183
 
    while (<INPUT>) 
1184
 
    {
1185
 
        if (s/^(\s*)_(\w+=(.*))/$1$2/)  
1186
 
        {
1187
 
            my $string = $3;
1188
 
 
1189
 
            print OUTPUT;
1190
 
 
1191
 
            my $non_translated_line = $_;
1192
 
 
1193
 
            for my $lang (sort keys %po_files_by_lang) 
1194
 
            {
1195
 
                my $translation = $translations{$lang, $string};
1196
 
                next if !$translation;
1197
 
 
1198
 
                $_ = $non_translated_line;
1199
 
                s/(\w+)=.*/${1}[$lang]=$translation/;
1200
 
                print OUTPUT;
1201
 
            }
1202
 
        } 
1203
 
        else 
1204
 
        {
1205
 
            print OUTPUT;
1206
 
        }
1207
 
    }
1208
 
 
1209
 
    close OUTPUT;
1210
 
    close INPUT;
1211
 
}
1212
 
 
1213
 
sub schemas_merge_translations
1214
 
{
1215
 
    my $source;
1216
 
 
1217
 
    {
1218
 
       local $/; # slurp mode
1219
 
       open INPUT, "<$FILE" or die "can't open $FILE: $!";
1220
 
       $source = <INPUT>;
1221
 
       close INPUT;
1222
 
    }
1223
 
 
1224
 
    open OUTPUT, ">$OUTFILE" or die;
1225
 
    binmode (OUTPUT) if $^O eq 'MSWin32';
1226
 
 
1227
 
    # FIXME: support attribute translations
1228
 
 
1229
 
    # Empty nodes never need translation, so unmark all of them.
1230
 
    # For example, <_foo/> is just replaced by <foo/>.
1231
 
    $source =~ s|<\s*_($w+)\s*/>|<$1/>|g;
1232
 
 
1233
 
    while ($source =~ s/
1234
 
                        (.*?)
1235
 
                        (\s+)(<locale\ name="C">(\s*)
1236
 
                            (<default>\s*(?:<!--[^>]*?-->\s*)?(.*?)\s*<\/default>)?(\s*)
1237
 
                            (<short>\s*(?:<!--[^>]*?-->\s*)?(.*?)\s*<\/short>)?(\s*)
1238
 
                            (<long>\s*(?:<!--[^>]*?-->\s*)?(.*?)\s*<\/long>)?(\s*)
1239
 
                        <\/locale>)
1240
 
                       //sx) 
1241
 
    {
1242
 
        print OUTPUT $1;
1243
 
 
1244
 
        my $locale_start_spaces = $2 ? $2 : '';
1245
 
        my $default_spaces = $4 ? $4 : '';
1246
 
        my $short_spaces = $7 ? $7 : '';
1247
 
        my $long_spaces = $10 ? $10 : '';
1248
 
        my $locale_end_spaces = $13 ? $13 : '';
1249
 
        my $c_default_block = $3 ? $3 : '';
1250
 
        my $default_string = $6 ? $6 : '';
1251
 
        my $short_string = $9 ? $9 : '';
1252
 
        my $long_string = $12 ? $12 : '';
1253
 
 
1254
 
        print OUTPUT "$locale_start_spaces$c_default_block";
1255
 
 
1256
 
        $default_string =~ s/\s+/ /g;
1257
 
        $default_string = entity_decode($default_string);
1258
 
        $short_string =~ s/\s+/ /g;
1259
 
        $short_string = entity_decode($short_string);
1260
 
        $long_string =~ s/\s+/ /g;
1261
 
        $long_string = entity_decode($long_string);
1262
 
 
1263
 
        for my $lang (sort keys %po_files_by_lang) 
1264
 
        {
1265
 
            my $default_translation = $translations{$lang, $default_string};
1266
 
            my $short_translation = $translations{$lang, $short_string};
1267
 
            my $long_translation  = $translations{$lang, $long_string};
1268
 
 
1269
 
            next if (!$default_translation && !$short_translation && 
1270
 
                     !$long_translation);
1271
 
 
1272
 
            print OUTPUT "\n$locale_start_spaces<locale name=\"$lang\">";
1273
 
 
1274
 
        print OUTPUT "$default_spaces";    
1275
 
 
1276
 
        if ($default_translation)
1277
 
        {
1278
 
            $default_translation = entity_encode($default_translation);
1279
 
            print OUTPUT "<default>$default_translation</default>";
1280
 
        }
1281
 
 
1282
 
            print OUTPUT "$short_spaces";
1283
 
 
1284
 
            if ($short_translation)
1285
 
            {
1286
 
                        $short_translation = entity_encode($short_translation);
1287
 
                        print OUTPUT "<short>$short_translation</short>";
1288
 
            }
1289
 
 
1290
 
            print OUTPUT "$long_spaces";
1291
 
 
1292
 
            if ($long_translation)
1293
 
            {
1294
 
                        $long_translation = entity_encode($long_translation);
1295
 
                        print OUTPUT "<long>$long_translation</long>";
1296
 
            }       
1297
 
 
1298
 
            print OUTPUT "$locale_end_spaces</locale>";
1299
 
        }
1300
 
    }
1301
 
 
1302
 
    print OUTPUT $source;
1303
 
 
1304
 
    close OUTPUT;
1305
 
}
1306
 
 
1307
 
sub rfc822deb_merge_translations
1308
 
{
1309
 
    my %encodings = ();
1310
 
    for my $lang (keys %po_files_by_lang) {
1311
 
        $encodings{$lang} = ($UTF8_ARG ? 'UTF-8' : get_po_encoding($po_files_by_lang{$lang}));
1312
 
    }
1313
 
 
1314
 
    my $source;
1315
 
 
1316
 
    $Text::Wrap::huge = 'overflow';
1317
 
    $Text::Wrap::break = qr/\n|\s(?=\S)/;
1318
 
 
1319
 
    {
1320
 
       local $/; # slurp mode
1321
 
       open INPUT, "<$FILE" or die "can't open $FILE: $!";
1322
 
       $source = <INPUT>;
1323
 
       close INPUT;
1324
 
    }
1325
 
 
1326
 
    open OUTPUT, ">${OUTFILE}" or die;
1327
 
    binmode (OUTPUT) if $^O eq 'MSWin32';
1328
 
 
1329
 
    while ($source =~ /(^|\n+)(_*)([^:\s]+)(:[ \t]*)(.*?)(?=\n[\S\n]|$)/sg)
1330
 
    {
1331
 
            my $sep = $1;
1332
 
            my $non_translated_line = $3.$4;
1333
 
            my $string = $5;
1334
 
            my $underscore = length($2);
1335
 
            next if $underscore eq 0 && $non_translated_line =~ /^#/;
1336
 
            #  Remove [] dummy strings
1337
 
            my $stripped = $string;
1338
 
            $stripped =~ s/\[\s[^\[\]]*\],/,/g if $underscore eq 2;
1339
 
            $stripped =~ s/\[\s[^\[\]]*\]$//;
1340
 
            $non_translated_line .= $stripped;
1341
 
 
1342
 
            print OUTPUT $sep.$non_translated_line;
1343
 
    
1344
 
            if ($underscore) 
1345
 
            {
1346
 
                my @str_list = rfc822deb_split($underscore, $string);
1347
 
 
1348
 
                for my $lang (sort keys %po_files_by_lang) 
1349
 
                {
1350
 
                    my $is_translated = 1;
1351
 
                    my $str_translated = '';
1352
 
                    my $first = 1;
1353
 
                
1354
 
                    for my $str (@str_list) 
1355
 
                    {
1356
 
                        my $translation = $translations{$lang, $str};
1357
 
                    
1358
 
                        if (!$translation) 
1359
 
                        {
1360
 
                            $is_translated = 0;
1361
 
                            last;
1362
 
                        }
1363
 
 
1364
 
                        #  $translation may also contain [] dummy
1365
 
                        #  strings, mostly to indicate an empty string
1366
 
                        $translation =~ s/\[\s[^\[\]]*\]$//;
1367
 
                        
1368
 
                        if ($first) 
1369
 
                        {
1370
 
                            if ($underscore eq 2)
1371
 
                            {
1372
 
                                $str_translated .= $translation;
1373
 
                            }
1374
 
                            else
1375
 
                            {
1376
 
                                $str_translated .=
1377
 
                                    Text::Tabs::expand($translation) .
1378
 
                                    "\n";
1379
 
                            }
1380
 
                        } 
1381
 
                        else 
1382
 
                        {
1383
 
                            if ($underscore eq 2)
1384
 
                            {
1385
 
                                $str_translated .= ', ' . $translation;
1386
 
                            }
1387
 
                            else
1388
 
                            {
1389
 
                                $str_translated .= Text::Tabs::expand(
1390
 
                                    Text::Wrap::wrap(' ', ' ', $translation)) .
1391
 
                                    "\n .\n";
1392
 
                            }
1393
 
                        }
1394
 
                        $first = 0;
1395
 
 
1396
 
                        #  To fix some problems with Text::Wrap::wrap
1397
 
                        $str_translated =~ s/(\n )+\n/\n .\n/g;
1398
 
                    }
1399
 
                    next unless $is_translated;
1400
 
 
1401
 
                    $str_translated =~ s/\n \.\n$//;
1402
 
                    $str_translated =~ s/\s+$//;
1403
 
 
1404
 
                    $_ = $non_translated_line;
1405
 
                    s/^(\w+):\s*.*/$sep${1}-$lang.$encodings{$lang}: $str_translated/s;
1406
 
                    print OUTPUT;
1407
 
                }
1408
 
            }
1409
 
    }
1410
 
    print OUTPUT "\n";
1411
 
 
1412
 
    close OUTPUT;
1413
 
    close INPUT;
1414
 
}
1415
 
 
1416
 
sub rfc822deb_split 
1417
 
{
1418
 
    # Debian defines a special way to deal with rfc822-style files:
1419
 
    # when a value contain newlines, it consists of
1420
 
    #   1.  a short form (first line)
1421
 
    #   2.  a long description, all lines begin with a space,
1422
 
    #       and paragraphs are separated by a single dot on a line
1423
 
    # This routine returns an array of all paragraphs, and reformat
1424
 
    # them.
1425
 
    # When first argument is 2, the string is a comma separated list of
1426
 
    # values.
1427
 
    my $type = shift;
1428
 
    my $text = shift;
1429
 
    $text =~ s/^[ \t]//mg;
1430
 
    return (split(/, */, $text, 0)) if $type ne 1;
1431
 
    return ($text) if $text !~ /\n/;
1432
 
 
1433
 
    $text =~ s/([^\n]*)\n//;
1434
 
    my @list = ($1);
1435
 
    my $str = '';
1436
 
 
1437
 
    for my $line (split (/\n/, $text)) 
1438
 
    {
1439
 
        chomp $line;
1440
 
        if ($line =~ /^\.\s*$/)
1441
 
        {
1442
 
            #  New paragraph
1443
 
            $str =~ s/\s*$//;
1444
 
            push(@list, $str);
1445
 
            $str = '';
1446
 
        } 
1447
 
        elsif ($line =~ /^\s/) 
1448
 
        {
1449
 
            #  Line which must not be reformatted
1450
 
            $str .= "\n" if length ($str) && $str !~ /\n$/;
1451
 
            $line =~ s/\s+$//;
1452
 
            $str .= $line."\n";
1453
 
        } 
1454
 
        else 
1455
 
        {
1456
 
            #  Continuation line, remove newline
1457
 
            $str .= " " if length ($str) && $str !~ /\n$/;
1458
 
            $str .= $line;
1459
 
        }
1460
 
    }
1461
 
 
1462
 
    $str =~ s/\s*$//;
1463
 
    push(@list, $str) if length ($str);
1464
 
 
1465
 
    return @list;
1466
 
}
1467
 
 
1468
 
sub quoted_translation
1469
 
{
1470
 
    my ($xml_mode, $lang, $string) = @_;
1471
 
 
1472
 
    $string = entity_decode($string) if $xml_mode;
1473
 
    $string =~ s/\\\"/\"/g;
1474
 
 
1475
 
    my $translation = $translations{$lang, $string};
1476
 
    $translation = $string if !$translation;
1477
 
    $translation = entity_encode($translation) if $xml_mode;
1478
 
    $translation =~ s/\"/\\\"/g;
1479
 
    return $translation
1480
 
}
1481
 
 
1482
 
sub quoted_merge_translations
1483
 
{
1484
 
    my ($xml_mode) = @_;
1485
 
 
1486
 
    if (!$MULTIPLE_OUTPUT) {
1487
 
        print "Quoted only supports Multiple Output.\n";
1488
 
        exit(1);
1489
 
    }
1490
 
 
1491
 
    for my $lang (sort keys %po_files_by_lang) {
1492
 
        if ( ! -d $lang ) {
1493
 
            mkdir $lang or -d $lang or die "Cannot create subdirectory $lang: $!\n";
1494
 
        }
1495
 
        open INPUT, "<${FILE}" or die;
1496
 
        open OUTPUT, ">$lang/$OUTFILE" or die "Cannot open $lang/$OUTFILE: $!\n";
1497
 
        binmode (OUTPUT) if $^O eq 'MSWin32';
1498
 
        while (<INPUT>) 
1499
 
        {
1500
 
            s/\"(([^\"]|\\\")*[^\\\"])\"/"\"" . &quoted_translation($xml_mode, $lang, $1) . "\""/ge;
1501
 
            print OUTPUT;
1502
 
        }
1503
 
        close OUTPUT;
1504
 
        close INPUT;
1505
 
    }
1506
 
}