← Back to branch summary

~ubuntu-branches/ubuntu/utopic/mplayerplug-in/utopic

« back to all changes in this revision

Viewing changes to intltool-extract.in

  • Committer: Bazaar Package Importer
  • Author(s): Cesare Tirabassi
  • Date: 2008-07-06 23:35:53 UTC
  • mfrom: (1.1.11 upstream)
  • Revision ID: james.westby@ubuntu.com-20080706233553-tfxk1bnjr8uewq0c
Tags: 3.55-1ubuntu1
* Merge from Debian unstable. Remaining Ubuntu changes:
  - debian/control
    + replace iceweasel with firefox3.0 | firefox 2
    + replace iceape-browser with seamonkey-browser
    + add Depends on | mplayer-nogui (>= 1.0~rc2)
    + add Xb-Npp-xxx tags accordingly to "firefox distro add-on support"
      spec
    + Modify Maintainer value to match the DebianMaintainerField
      specification.
  - debian/mozilla-mplayer.links:
    + add firefox and xulrunner symlinks
* Replace iceape-dev b-d with libxul-dev.
* Add xulrunner in lists of possible "browsers".
* Following upstream suggestion, change required mplayer version
  to be (>= 1.0~rc2).

Show diffs side-by-side

added added

removed removed

Lines of Context:
intltool-extract.in
 
1
#!@INTLTOOL_PERL@ -w 
 
2
# -*- Mode: perl; indent-tabs-mode: nil; c-basic-offset: 4  -*-
 
3
 
 
4
#
 
5
#  The Intltool Message Extractor
 
6
#
 
7
#  Copyright (C) 2000-2001, 2003 Free Software Foundation.
 
8
#
 
9
#  Intltool 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
#  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: Kenneth Christiansen <kenneth@gnu.org>
 
29
#           Darin Adler <darin@bentspoon.com>
 
30
#
 
31
 
 
32
## Release information
 
33
my $PROGRAM      = "intltool-extract";
 
34
my $PACKAGE      = "intltool";
 
35
my $VERSION      = "0.34.2";
 
36
 
 
37
## Loaded modules
 
38
use strict; 
 
39
use File::Basename;
 
40
use Getopt::Long;
 
41
 
 
42
## Scalars used by the option stuff
 
43
my $TYPE_ARG    = "0";
 
44
my $LOCAL_ARG   = "0";
 
45
my $HELP_ARG    = "0";
 
46
my $VERSION_ARG = "0";
 
47
my $UPDATE_ARG  = "0";
 
48
my $QUIET_ARG   = "0";
 
49
my $SRCDIR_ARG  = ".";
 
50
 
 
51
my $FILE;
 
52
my $OUTFILE;
 
53
 
 
54
my $gettext_type = "";
 
55
my $input;
 
56
my %messages = ();
 
57
my %loc = ();
 
58
my %count = ();
 
59
my %comments = ();
 
60
my $strcount = 0;
 
61
 
 
62
my $XMLCOMMENT = "";
 
63
 
 
64
## Use this instead of \w for XML files to handle more possible characters.
 
65
my $w = "[-A-Za-z0-9._:]";
 
66
 
 
67
## Always print first
 
68
$| = 1;
 
69
 
 
70
## Handle options
 
71
GetOptions (
 
72
            "type=s"     => \$TYPE_ARG,
 
73
            "local|l"    => \$LOCAL_ARG,
 
74
            "help|h"     => \$HELP_ARG,
 
75
            "version|v"  => \$VERSION_ARG,
 
76
            "update"     => \$UPDATE_ARG,
 
77
            "quiet|q"    => \$QUIET_ARG,
 
78
            "srcdir=s"   => \$SRCDIR_ARG,
 
79
            ) or &error;
 
80
 
 
81
&split_on_argument;
 
82
 
 
83
 
 
84
## Check for options. 
 
85
## This section will check for the different options.
 
86
 
 
87
sub split_on_argument {
 
88
 
 
89
    if ($VERSION_ARG) {
 
90
        &version;
 
91
 
 
92
    } elsif ($HELP_ARG) {
 
93
        &help;
 
94
        
 
95
    } elsif ($LOCAL_ARG) {
 
96
        &place_local;
 
97
        &extract;
 
98
 
 
99
    } elsif ($UPDATE_ARG) {
 
100
        &place_normal;
 
101
        &extract;
 
102
 
 
103
    } elsif (@ARGV > 0) {
 
104
        &place_normal;
 
105
        &message;
 
106
        &extract;
 
107
 
 
108
    } else {
 
109
        &help;
 
110
 
 
111
    }  
 
112
}    
 
113
 
 
114
sub place_normal {
 
115
    $FILE        = $ARGV[0];
 
116
    $OUTFILE     = "$FILE.h";
 
117
}   
 
118
 
 
119
sub place_local {
 
120
    $FILE        = $ARGV[0];
 
121
    $OUTFILE     = fileparse($FILE, ());
 
122
    if (!-e "tmp/") { 
 
123
        system("mkdir tmp/"); 
 
124
    }
 
125
    $OUTFILE     = "./tmp/$OUTFILE.h"
 
126
}
 
127
 
 
128
sub determine_type {
 
129
   if ($TYPE_ARG =~ /^gettext\/(.*)/) {
 
130
        $gettext_type=$1
 
131
   }
 
132
}
 
133
 
 
134
## Sub for printing release information
 
135
sub version{
 
136
    print <<_EOF_;
 
137
${PROGRAM} (${PACKAGE}) $VERSION
 
138
Copyright (C) 2000, 2003 Free Software Foundation, Inc.
 
139
Written by Kenneth Christiansen, 2000.
 
140
 
 
141
This is free software; see the source for copying conditions.  There is NO
 
142
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
143
_EOF_
 
144
    exit;
 
145
}
 
146
 
 
147
## Sub for printing usage information
 
148
sub help {
 
149
    print <<_EOF_;
 
150
Usage: ${PROGRAM} [OPTION]... [FILENAME]
 
151
Generates a header file from an XML source file.
 
152
 
 
153
It grabs all strings between <_translatable_node> and its end tag in
 
154
XML files. Read manpage (man ${PROGRAM}) for more info.
 
155
 
 
156
      --type=TYPE   Specify the file type of FILENAME. Currently supports:
 
157
                    "gettext/glade", "gettext/ini", "gettext/keys"
 
158
                    "gettext/rfc822deb", "gettext/schemas",
 
159
                    "gettext/scheme", "gettext/xml"
 
160
  -l, --local       Writes output into current working directory
 
161
                    (conflicts with --update)
 
162
      --update      Writes output into the same directory the source file 
 
163
                    reside (conflicts with --local)
 
164
      --srcdir      Root of the source tree
 
165
  -v, --version     Output version information and exit
 
166
  -h, --help        Display this help and exit
 
167
  -q, --quiet       Quiet mode
 
168
 
 
169
Report bugs to http://bugzilla.gnome.org/ (product name "$PACKAGE")
 
170
or send email to <xml-i18n-tools\@gnome.org>.
 
171
_EOF_
 
172
    exit;
 
173
}
 
174
 
 
175
## Sub for printing error messages
 
176
sub error{
 
177
    print STDERR "Try `${PROGRAM} --help' for more information.\n";
 
178
    exit;
 
179
}
 
180
 
 
181
sub message {
 
182
    print "Generating C format header file for translation.\n" unless $QUIET_ARG;
 
183
}
 
184
 
 
185
sub extract {
 
186
    &determine_type;
 
187
 
 
188
    &convert;
 
189
 
 
190
    open OUT, ">$OUTFILE";
 
191
    binmode (OUT) if $^O eq 'MSWin32';
 
192
    &msg_write;
 
193
    close OUT;
 
194
 
 
195
    print "Wrote $OUTFILE\n" unless $QUIET_ARG;
 
196
}
 
197
 
 
198
sub convert {
 
199
 
 
200
    ## Reading the file
 
201
    {
 
202
        local (*IN);
 
203
        local $/; #slurp mode
 
204
        open (IN, "<$SRCDIR_ARG/$FILE") || die "can't open $SRCDIR_ARG/$FILE: $!";
 
205
        $input = <IN>;
 
206
    }
 
207
 
 
208
    &type_ini if $gettext_type eq "ini";
 
209
    &type_keys if $gettext_type eq "keys";
 
210
    &type_xml if $gettext_type eq "xml";
 
211
    &type_glade if $gettext_type eq "glade";
 
212
    &type_scheme if $gettext_type eq "scheme";
 
213
    &type_schemas  if $gettext_type eq "schemas";
 
214
    &type_rfc822deb  if $gettext_type eq "rfc822deb";
 
215
}
 
216
 
 
217
sub entity_decode_minimal
 
218
{
 
219
    local ($_) = @_;
 
220
 
 
221
    s/&apos;/'/g; # '
 
222
    s/&quot;/"/g; # "
 
223
    s/&amp;/&/g;
 
224
 
 
225
    return $_;
 
226
}
 
227
 
 
228
sub entity_decode
 
229
{
 
230
    local ($_) = @_;
 
231
 
 
232
    s/&apos;/'/g; # '
 
233
    s/&quot;/"/g; # "
 
234
    s/&amp;/&/g;
 
235
    s/&lt;/</g;
 
236
    s/&gt;/>/g;
 
237
 
 
238
    return $_;
 
239
}
 
240
 
 
241
sub escape_char
 
242
{
 
243
    return '\"' if $_ eq '"';
 
244
    return '\n' if $_ eq "\n";
 
245
    return '\\' if $_ eq '\\';
 
246
 
 
247
    return $_;
 
248
}
 
249
 
 
250
sub escape
 
251
{
 
252
    my ($string) = @_;
 
253
    return join "", map &escape_char, split //, $string;
 
254
}
 
255
 
 
256
sub type_ini {
 
257
    ### For generic translatable desktop files ###
 
258
    while ($input =~ /^_.*=(.*)$/mg) {
 
259
        $messages{$1} = [];
 
260
    }
 
261
}
 
262
 
 
263
sub type_keys {
 
264
    ### For generic translatable mime/keys files ###
 
265
    while ($input =~ /^\s*_\w+=(.*)$/mg) {
 
266
        $messages{$1} = [];
 
267
    }
 
268
}
 
269
 
 
270
sub type_xml {
 
271
    ### For generic translatable XML files ###
 
272
    my $tree = readXml($input);
 
273
    parseTree(0, $tree);
 
274
}
 
275
 
 
276
sub print_var {
 
277
    my $var = shift;
 
278
    my $vartype = ref $var;
 
279
    
 
280
    if ($vartype =~ /ARRAY/) {
 
281
        my @arr = @{$var};
 
282
        print "[ ";
 
283
        foreach my $el (@arr) {
 
284
            print_var($el);
 
285
            print ", ";
 
286
        }
 
287
        print "] ";
 
288
    } elsif ($vartype =~ /HASH/) {
 
289
        my %hash = %{$var};
 
290
        print "{ ";
 
291
        foreach my $key (keys %hash) {
 
292
            print "$key => ";
 
293
            print_var($hash{$key});
 
294
            print ", ";
 
295
        }
 
296
        print "} ";
 
297
    } else {
 
298
        print $var;
 
299
    }
 
300
}
 
301
 
 
302
# Same syntax as getAttributeString in intltool-merge.in.in, similar logic (look for ## differences comment)
 
303
sub getAttributeString
 
304
{
 
305
    my $sub = shift;
 
306
    my $do_translate = shift || 1;
 
307
    my $language = shift || "";
 
308
    my $translate = shift;
 
309
    my $result = "";
 
310
    foreach my $e (reverse(sort(keys %{ $sub }))) {
 
311
        my $key    = $e;
 
312
        my $string = $sub->{$e};
 
313
        my $quote = '"';
 
314
        
 
315
        $string =~ s/^[\s]+//;
 
316
        $string =~ s/[\s]+$//;
 
317
        
 
318
        if ($string =~ /^'.*'$/)
 
319
        {
 
320
            $quote = "'";
 
321
        }
 
322
        $string =~ s/^['"]//g;
 
323
        $string =~ s/['"]$//g;
 
324
 
 
325
        ## differences from intltool-merge.in.in
 
326
        if ($key =~ /^_/) {
 
327
            $comments{entity_decode($string)} = $XMLCOMMENT if $XMLCOMMENT;
 
328
            $messages{entity_decode($string)} = [];
 
329
            $$translate = 2;
 
330
        }
 
331
        ## differences end here from intltool-merge.in.in
 
332
        $result .= " $key=$quote$string$quote";
 
333
    }
 
334
    return $result;
 
335
}
 
336
 
 
337
# Verbatim copy from intltool-merge.in.in
 
338
sub getXMLstring
 
339
{
 
340
    my $ref = shift;
 
341
    my $spacepreserve = shift || 0;
 
342
    my @list = @{ $ref };
 
343
    my $result = "";
 
344
 
 
345
    my $count = scalar(@list);
 
346
    my $attrs = $list[0];
 
347
    my $index = 1;
 
348
 
 
349
    $spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/));
 
350
    $spacepreserve = 0 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?default["']?$/));
 
351
 
 
352
    while ($index < $count) {
 
353
        my $type = $list[$index];
 
354
        my $content = $list[$index+1];
 
355
        if (! $type ) {
 
356
            # We've got CDATA
 
357
            if ($content) {
 
358
                # lets strip the whitespace here, and *ONLY* here
 
359
                $content =~ s/\s+/ /gs if (!$spacepreserve);
 
360
                $result .= $content;
 
361
            }
 
362
        } elsif ( "$type" ne "1" ) {
 
363
            # We've got another element
 
364
            $result .= "<$type";
 
365
            $result .= getAttributeString(@{$content}[0], 0); # no nested translatable elements
 
366
            if ($content) {
 
367
                my $subresult = getXMLstring($content, $spacepreserve);
 
368
                if ($subresult) {
 
369
                    $result .= ">".$subresult . "</$type>";
 
370
                } else {
 
371
                    $result .= "/>";
 
372
                }
 
373
            } else {
 
374
                $result .= "/>";
 
375
            }
 
376
        }
 
377
        $index += 2;
 
378
    }
 
379
    return $result;
 
380
}
 
381
 
 
382
# Verbatim copy from intltool-merge.in.in, except for MULTIPLE_OUTPUT handling removed
 
383
# Translate list of nodes if necessary
 
384
sub translate_subnodes
 
385
{
 
386
    my $fh = shift;
 
387
    my $content = shift;
 
388
    my $language = shift || "";
 
389
    my $singlelang = shift || 0;
 
390
    my $spacepreserve = shift || 0;
 
391
 
 
392
    my @nodes = @{ $content };
 
393
 
 
394
    my $count = scalar(@nodes);
 
395
    my $index = 0;
 
396
    while ($index < $count) {
 
397
        my $type = $nodes[$index];
 
398
        my $rest = $nodes[$index+1];
 
399
        traverse($fh, $type, $rest, $language, $spacepreserve);
 
400
        $index += 2;
 
401
    }
 
402
}
 
403
 
 
404
# Based on traverse() in intltool-merge.in.in
 
405
sub traverse
 
406
{
 
407
    my $fh = shift; # unused, to allow us to sync code between -merge and -extract
 
408
    my $nodename = shift;
 
409
    my $content = shift;
 
410
    my $language = shift || "";
 
411
    my $spacepreserve = shift || 0;
 
412
 
 
413
    if ($nodename && "$nodename" eq "1") {
 
414
        $XMLCOMMENT = $content;
 
415
    } elsif ($nodename) {
 
416
        # element
 
417
        my @all = @{ $content };
 
418
        my $attrs = shift @all;
 
419
        my $translate = 0;
 
420
        my $outattr = getAttributeString($attrs, 1, $language, \$translate);
 
421
 
 
422
        if ($nodename =~ /^_/) {
 
423
            $translate = 1;
 
424
            $nodename =~ s/^_//;
 
425
        }
 
426
        my $lookup = '';
 
427
 
 
428
        $spacepreserve = 0 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?default["']?$/));
 
429
        $spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/));
 
430
 
 
431
        if ($translate) {
 
432
            $lookup = getXMLstring($content, $spacepreserve);
 
433
            if (!$spacepreserve) {
 
434
                $lookup =~ s/^\s+//s;
 
435
                $lookup =~ s/\s+$//s;
 
436
            }
 
437
 
 
438
            if ($lookup && $translate != 2) {
 
439
                $comments{$lookup} = $XMLCOMMENT if $XMLCOMMENT;
 
440
                $messages{$lookup} = [];
 
441
            } elsif ($translate == 2) {
 
442
                translate_subnodes($fh, \@all, $language, 1, $spacepreserve);
 
443
            }
 
444
        } else {
 
445
            $XMLCOMMENT = "";
 
446
            my $count = scalar(@all);
 
447
            if ($count > 0) {
 
448
                my $index = 0;
 
449
                while ($index < $count) {
 
450
                    my $type = $all[$index];
 
451
                    my $rest = $all[$index+1];
 
452
                    traverse($fh, $type, $rest, $language, $spacepreserve);
 
453
                    $index += 2;
 
454
                }
 
455
            }
 
456
        }
 
457
        $XMLCOMMENT = "";
 
458
    }
 
459
}
 
460
 
 
461
 
 
462
# Verbatim copy from intltool-merge.in.in, $fh for compatibility
 
463
sub parseTree
 
464
{
 
465
    my $fh        = shift;
 
466
    my $ref       = shift;
 
467
    my $language  = shift || "";
 
468
 
 
469
    my $name = shift @{ $ref };
 
470
    my $cont = shift @{ $ref };
 
471
 
 
472
    while (!$name || "$name" eq "1") {
 
473
        $name = shift @{ $ref };
 
474
        $cont = shift @{ $ref };
 
475
    }
 
476
 
 
477
    my $spacepreserve = 0;
 
478
    my $attrs = @{$cont}[0];
 
479
    $spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/));
 
480
 
 
481
    traverse($fh, $name, $cont, $language, $spacepreserve);
 
482
}
 
483
 
 
484
# Verbatim copy from intltool-merge.in.in
 
485
sub intltool_tree_comment
 
486
{
 
487
    my $expat = shift;
 
488
    my $data  = $expat->original_string();
 
489
    my $clist = $expat->{Curlist};
 
490
    my $pos   = $#$clist;
 
491
 
 
492
    $data =~ s/^<!--//s;
 
493
    $data =~ s/-->$//s;
 
494
    push @$clist, 1 => $data;
 
495
}
 
496
 
 
497
# Verbatim copy from intltool-merge.in.in
 
498
sub intltool_tree_cdatastart
 
499
{
 
500
    my $expat    = shift;
 
501
    my $clist = $expat->{Curlist};
 
502
    my $pos   = $#$clist;
 
503
 
 
504
    push @$clist, 0 => $expat->original_string();
 
505
}
 
506
 
 
507
# Verbatim copy from intltool-merge.in.in
 
508
sub intltool_tree_cdataend
 
509
{
 
510
    my $expat    = shift;
 
511
    my $clist = $expat->{Curlist};
 
512
    my $pos   = $#$clist;
 
513
 
 
514
    $clist->[$pos] .= $expat->original_string();
 
515
}
 
516
 
 
517
# Verbatim copy from intltool-merge.in.in
 
518
sub intltool_tree_char
 
519
{
 
520
    my $expat = shift;
 
521
    my $text  = shift;
 
522
    my $clist = $expat->{Curlist};
 
523
    my $pos   = $#$clist;
 
524
 
 
525
    # Use original_string so that we retain escaped entities
 
526
    # in CDATA sections.
 
527
    #
 
528
    if ($pos > 0 and $clist->[$pos - 1] eq '0') {
 
529
        $clist->[$pos] .= $expat->original_string();
 
530
    } else {
 
531
        push @$clist, 0 => $expat->original_string();
 
532
    }
 
533
}
 
534
 
 
535
# Verbatim copy from intltool-merge.in.in
 
536
sub intltool_tree_start
 
537
{
 
538
    my $expat    = shift;
 
539
    my $tag      = shift;
 
540
    my @origlist = ();
 
541
 
 
542
    # Use original_string so that we retain escaped entities
 
543
    # in attribute values.  We must convert the string to an
 
544
    # @origlist array to conform to the structure of the Tree
 
545
    # Style.
 
546
    #
 
547
    my @original_array = split /\x/, $expat->original_string();
 
548
    my $source         = $expat->original_string();
 
549
 
 
550
    # Remove leading tag.
 
551
    #
 
552
    $source =~ s|^\s*<\s*(\S+)||s;
 
553
 
 
554
    # Grab attribute key/value pairs and push onto @origlist array.
 
555
    #
 
556
    while ($source)
 
557
    {
 
558
       if ($source =~ /^\s*([\w:-]+)\s*[=]\s*["]/)
 
559
       {
 
560
           $source =~ s|^\s*([\w:-]+)\s*[=]\s*["]([^"]*)["]||s;
 
561
           push @origlist, $1;
 
562
           push @origlist, '"' . $2 . '"';
 
563
       }
 
564
       elsif ($source =~ /^\s*([\w:-]+)\s*[=]\s*[']/)
 
565
       {
 
566
           $source =~ s|^\s*([\w:-]+)\s*[=]\s*[']([^']*)[']||s;
 
567
           push @origlist, $1;
 
568
           push @origlist, "'" . $2 . "'";
 
569
       }
 
570
       else
 
571
       {
 
572
           last;
 
573
       }
 
574
    }
 
575
 
 
576
    my $ol = [ { @origlist } ];
 
577
 
 
578
    push @{ $expat->{Lists} }, $expat->{Curlist};
 
579
    push @{ $expat->{Curlist} }, $tag => $ol;
 
580
    $expat->{Curlist} = $ol;
 
581
}
 
582
 
 
583
# Copied from intltool-merge.in.in and added comment handler.
 
584
sub readXml
 
585
{
 
586
    my $xmldoc = shift || return;
 
587
    my $ret = eval 'require XML::Parser';
 
588
    if(!$ret) {
 
589
        die "You must have XML::Parser installed to run $0\n\n";
 
590
    }
 
591
    my $xp = new XML::Parser(Style => 'Tree');
 
592
    $xp->setHandlers(Char => \&intltool_tree_char);
 
593
    $xp->setHandlers(Start => \&intltool_tree_start);
 
594
    $xp->setHandlers(CdataStart => \&intltool_tree_cdatastart);
 
595
    $xp->setHandlers(CdataEnd => \&intltool_tree_cdataend);
 
596
 
 
597
    ## differences from intltool-merge.in.in
 
598
    $xp->setHandlers(Comment => \&intltool_tree_comment);
 
599
    ## differences end here from intltool-merge.in.in
 
600
 
 
601
    my $tree = $xp->parse($xmldoc);
 
602
    #print_var($tree);
 
603
 
 
604
# <foo><!-- comment --><head id="a">Hello <em>there</em></head><bar>Howdy<ref/></bar>do</foo>
 
605
# would be:
 
606
# [foo, [{}, 1, "comment", head, [{id => "a"}, 0, "Hello ",  em, [{}, 0, "there"]], bar, 
 
607
# [{}, 0, "Howdy",  ref, [{}]], 0, "do" ] ]
 
608
 
 
609
    return $tree;
 
610
}
 
611
 
 
612
sub type_schemas {
 
613
    ### For schemas XML files ###
 
614
         
 
615
    # FIXME: We should handle escaped < (less than)
 
616
    while ($input =~ /
 
617
                      <locale\ name="C">\s*
 
618
                          (<default>\s*(?:<!--([^>]*?)-->\s*)?(.*?)\s*<\/default>\s*)?
 
619
                          (<short>\s*(?:<!--([^>]*?)-->\s*)?(.*?)\s*<\/short>\s*)?
 
620
                          (<long>\s*(?:<!--([^>]*?)-->\s*)?(.*?)\s*<\/long>\s*)?
 
621
                      <\/locale>
 
622
                     /sgx) {
 
623
        my @totranslate = ($3,$6,$9);
 
624
        my @eachcomment = ($2,$5,$8);
 
625
        foreach (@totranslate) {
 
626
            my $currentcomment = shift @eachcomment;
 
627
            next if !$_;
 
628
            s/\s+/ /g;
 
629
            $messages{entity_decode_minimal($_)} = [];
 
630
            $comments{entity_decode_minimal($_)} = $currentcomment if (defined($currentcomment));
 
631
        }
 
632
    }
 
633
}
 
634
 
 
635
sub type_rfc822deb {
 
636
    ### For rfc822-style Debian configuration files ###
 
637
 
 
638
    my $lineno = 1;
 
639
    my $type = '';
 
640
    while ($input =~ /\G(.*?)(^|\n)(_+)([^:]+):[ \t]*(.*?)(?=\n\S|$)/sg)
 
641
    {
 
642
        my ($pre, $newline, $underscore, $tag, $text) = ($1, $2, $3, $4, $5);
 
643
        while ($pre =~ m/\n/g)
 
644
        {
 
645
            $lineno ++;
 
646
        }
 
647
        $lineno += length($newline);
 
648
        my @str_list = rfc822deb_split(length($underscore), $text);
 
649
        for my $str (@str_list)
 
650
        {
 
651
            $strcount++;
 
652
            $messages{$str} = [];
 
653
            $loc{$str} = $lineno;
 
654
            $count{$str} = $strcount;
 
655
            my $usercomment = '';
 
656
            while($pre =~ s/(^|\n)#([^\n]*)$//s)
 
657
            {
 
658
                $usercomment = "\n" . $2 . $usercomment;
 
659
            }
 
660
            $comments{$str} = $tag . $usercomment;
 
661
        }
 
662
        $lineno += ($text =~ s/\n//g);
 
663
    }
 
664
}
 
665
 
 
666
sub rfc822deb_split {
 
667
    # Debian defines a special way to deal with rfc822-style files:
 
668
    # when a value contain newlines, it consists of
 
669
    #   1.  a short form (first line)
 
670
    #   2.  a long description, all lines begin with a space,
 
671
    #       and paragraphs are separated by a single dot on a line
 
672
    # This routine returns an array of all paragraphs, and reformat
 
673
    # them.
 
674
    # When first argument is 2, the string is a comma separated list of
 
675
    # values.
 
676
    my $type = shift;
 
677
    my $text = shift;
 
678
    $text =~ s/^[ \t]//mg;
 
679
    return (split(/, */, $text, 0)) if $type ne 1;
 
680
    return ($text) if $text !~ /\n/;
 
681
 
 
682
    $text =~ s/([^\n]*)\n//;
 
683
    my @list = ($1);
 
684
    my $str = '';
 
685
    for my $line (split (/\n/, $text))
 
686
    {
 
687
        chomp $line;
 
688
        if ($line =~ /^\.\s*$/)
 
689
        {
 
690
            #  New paragraph
 
691
            $str =~ s/\s*$//;
 
692
            push(@list, $str);
 
693
            $str = '';
 
694
        }
 
695
        elsif ($line =~ /^\s/)
 
696
        {
 
697
            #  Line which must not be reformatted
 
698
            $str .= "\n" if length ($str) && $str !~ /\n$/;
 
699
            $line =~ s/\s+$//;
 
700
            $str .= $line."\n";
 
701
        }
 
702
        else
 
703
        {
 
704
            #  Continuation line, remove newline
 
705
            $str .= " " if length ($str) && $str !~ /\n$/;
 
706
            $str .= $line;
 
707
        }
 
708
    }
 
709
    $str =~ s/\s*$//;
 
710
    push(@list, $str) if length ($str);
 
711
    return @list;
 
712
}
 
713
 
 
714
sub type_glade {
 
715
    ### For translatable Glade XML files ###
 
716
 
 
717
    my $tags = "label|title|text|format|copyright|comments|preview_text|tooltip|message";
 
718
 
 
719
    while ($input =~ /<($tags)>([^<]+)<\/($tags)>/sg) {
 
720
        # Glade sometimes uses tags that normally mark translatable things for
 
721
        # little bits of non-translatable content. We work around this by not
 
722
        # translating strings that only includes something like label4 or window1.
 
723
        $messages{entity_decode($2)} = [] unless $2 =~ /^(window|label|dialog)[0-9]+$/;
 
724
    }
 
725
    
 
726
    while ($input =~ /<items>(..[^<]*)<\/items>/sg) {
 
727
        for my $item (split (/\n/, $1)) {
 
728
            $messages{entity_decode($item)} = [];
 
729
        }
 
730
    }
 
731
 
 
732
    ## handle new glade files
 
733
    while ($input =~ /<(property|atkproperty)\s+[^>]*translatable\s*=\s*"yes"(?:\s+[^>]*comments\s*=\s*"([^"]*)")?[^>]*>([^<]+)<\/\1>/sg) {
 
734
        $messages{entity_decode($3)} = [] unless $3 =~ /^(window|label)[0-9]+$/;
 
735
        if (defined($2) and !($3 =~ /^(window|label)[0-9]+$/)) {
 
736
           $comments{entity_decode($3)} = entity_decode($2) ;
 
737
        }
 
738
    }
 
739
    while ($input =~ /<atkaction\s+action_name="([^>]*)"\s+description="([^>]+)"\/>/sg) {
 
740
        $messages{entity_decode_minimal($2)} = [];
 
741
    }
 
742
}
 
743
 
 
744
sub type_scheme {
 
745
    my ($line, $i, $state, $str, $trcomment, $char);
 
746
    for $line (split(/\n/, $input)) {
 
747
        $i = 0;
 
748
        $state = 0; # 0 - nothing, 1 - string, 2 - translatable string
 
749
        while ($i < length($line)) {
 
750
            if (substr($line,$i,1) eq "\"") {
 
751
                if ($state == 2) {
 
752
                    $comments{$str} = $trcomment if ($trcomment);
 
753
                    $messages{$str} = [];
 
754
                    $str = '';
 
755
                    $state = 0; $trcomment = "";
 
756
                } elsif ($state == 1) {
 
757
                    $str = '';
 
758
                    $state = 0; $trcomment = "";
 
759
                } else {
 
760
                    $state = 1;
 
761
                    $str = '';
 
762
                    if ($i>0 && substr($line,$i-1,1) eq '_') {
 
763
                        $state = 2;
 
764
                    }
 
765
                }
 
766
            } elsif (!$state) {
 
767
                if (substr($line,$i,1) eq ";") {
 
768
                    $trcomment = substr($line,$i+1);
 
769
                    $trcomment =~ s/^;*\s*//;
 
770
                    $i = length($line);
 
771
                } elsif ($trcomment && substr($line,$i,1) !~ /\s|\(|\)|_/) {
 
772
                    $trcomment = "";
 
773
                }
 
774
            } else {
 
775
                if (substr($line,$i,1) eq "\\") {
 
776
                    $char = substr($line,$i+1,1);
 
777
                    if ($char ne "\"" && $char ne "\\") {
 
778
                       $str = $str . "\\";
 
779
                    }
 
780
                    $i++;
 
781
                }
 
782
                $str = $str . substr($line,$i,1);
 
783
            }
 
784
            $i++;
 
785
        }
 
786
    }
 
787
}
 
788
 
 
789
sub msg_write {
 
790
    my @msgids;
 
791
    if (%count)
 
792
    {
 
793
        @msgids = sort { $count{$a} <=> $count{$b} } keys %count;
 
794
    }
 
795
    else
 
796
    {
 
797
        @msgids = sort keys %messages;
 
798
    }
 
799
    for my $message (@msgids)
 
800
    {
 
801
        my $offsetlines = 1;
 
802
        $offsetlines++ if $message =~ /%/;
 
803
        if (defined ($comments{$message}))
 
804
        {
 
805
                while ($comments{$message} =~ m/\n/g)
 
806
                {
 
807
                    $offsetlines++;
 
808
                }
 
809
        }
 
810
        print OUT "# ".($loc{$message} - $offsetlines).  " \"$FILE\"\n"
 
811
                if defined $loc{$message};
 
812
        print OUT "/* ".$comments{$message}." */\n"
 
813
                if defined $comments{$message};
 
814
        print OUT "/* xgettext:no-c-format */\n" if $message =~ /%/;
 
815
        
 
816
        my @lines = split (/\n/, $message, -1);
 
817
        for (my $n = 0; $n < @lines; $n++)
 
818
        {
 
819
            if ($n == 0)
 
820
            {
 
821
                print OUT "char *s = N_(\""; 
 
822
            }
 
823
            else
 
824
            {  
 
825
                print OUT "             \""; 
 
826
            }
 
827
 
 
828
            print OUT escape($lines[$n]);
 
829
 
 
830
            if ($n < @lines - 1)
 
831
            {
 
832
                print OUT "\\n\"\n"; 
 
833
            }
 
834
            else
 
835
            {
 
836
                print OUT "\");\n";  
 
837
            }
 
838
        }
 
839
    }
 
840
}
 
841