← Back to branch summary

~ubuntu-branches/ubuntu/wily/xfce4-appfinder/wily-proposed

« back to all changes in this revision

Viewing changes to intltool-extract.in

  • Committer: Bazaar Package Importer
  • Author(s): Simon Huggins, Yves-Alexis Perez, Simon Huggins
  • Date: 2007-11-27 16:39:17 UTC
  • mfrom: (1.1.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20071127163917-b6no7r2t7ee1gy0h
Tags: 4.4.2-1
[ Yves-Alexis Perez ]
* New upstream release.
* debian/menu: switch to new menu policy.
* debian/rules: don't ignore all make errors at clean stage.

[ Simon Huggins ]
* debian/control: Move fake Homepage field to a real one now dpkg
  supports it.
* Add Vcs-* headers to debian/control

Show diffs side-by-side

added added

removed removed

Lines of Context:
intltool-extract.in
32
32
## Release information
33
33
my $PROGRAM      = "intltool-extract";
34
34
my $PACKAGE      = "intltool";
35
 
my $VERSION      = "0.33";
 
35
my $VERSION      = "0.35.5";
36
36
 
37
37
## Loaded modules
38
38
use strict; 
59
59
my %comments = ();
60
60
my $strcount = 0;
61
61
 
 
62
my $XMLCOMMENT = "";
 
63
 
62
64
## Use this instead of \w for XML files to handle more possible characters.
63
65
my $w = "[-A-Za-z0-9._:]";
64
66
 
112
114
sub place_normal {
113
115
    $FILE        = $ARGV[0];
114
116
    $OUTFILE     = "$FILE.h";
 
117
 
 
118
    my $dirname = dirname ($OUTFILE);
 
119
    if (! -d "$dirname" && $dirname ne "") {
 
120
        system ("mkdir -p $dirname");
 
121
    }
115
122
}   
116
123
 
117
124
sub place_local {
154
161
      --type=TYPE   Specify the file type of FILENAME. Currently supports:
155
162
                    "gettext/glade", "gettext/ini", "gettext/keys"
156
163
                    "gettext/rfc822deb", "gettext/schemas",
157
 
                    "gettext/scheme", "gettext/xml"
 
164
                    "gettext/scheme", "gettext/xml", "gettext/quoted"
158
165
  -l, --local       Writes output into current working directory
159
166
                    (conflicts with --update)
160
167
      --update      Writes output into the same directory the source file 
186
193
    &convert;
187
194
 
188
195
    open OUT, ">$OUTFILE";
 
196
    binmode (OUT) if $^O eq 'MSWin32';
189
197
    &msg_write;
190
198
    close OUT;
191
199
 
209
217
    &type_scheme if $gettext_type eq "scheme";
210
218
    &type_schemas  if $gettext_type eq "schemas";
211
219
    &type_rfc822deb  if $gettext_type eq "rfc822deb";
 
220
    &type_quoted if $gettext_type eq "quoted";
212
221
}
213
222
 
214
223
sub entity_decode_minimal
239
248
{
240
249
    return '\"' if $_ eq '"';
241
250
    return '\n' if $_ eq "\n";
242
 
    return '\\' if $_ eq '\\';
 
251
    return '\\\\' if $_ eq '\\';
243
252
 
244
253
    return $_;
245
254
}
252
261
 
253
262
sub type_ini {
254
263
    ### For generic translatable desktop files ###
255
 
    while ($input =~ /^_.*=(.*)$/mg) {
256
 
        $messages{$1} = [];
 
264
    while ($input =~ /^(#(.+)\n)?^_.*=(.*)$/mg) {
 
265
        if (defined($2))  {
 
266
            $comments{$3} = $2;
 
267
        }
 
268
        $messages{$3} = [];
257
269
    }
258
270
}
259
271
 
266
278
 
267
279
sub type_xml {
268
280
    ### For generic translatable XML files ###
269
 
        
270
 
    while ($input =~ /(?:<!--([^>]*?)-->[^\n]*\n?[^\n]*)?\s_$w+\s*=\s*\"([^"]*)\"/sg) { # "
271
 
        $messages{entity_decode_minimal($2)} = [];
272
 
        $comments{entity_decode_minimal($2)} = $1 if (defined($1));
273
 
    }
274
 
 
275
 
    while ($input =~ /(?:<!--([^>]*?)-->\s*)?<_($w+)(?: xml:space="($w+)")?[^>]*>(.*?)<\/_\2>/sg) {
276
 
        $_ = $4;
277
 
        if (!defined($3) || $3 ne "preserve") {
278
 
            s/\s+/ /g;
279
 
            s/^ //;
280
 
            s/ $//;
281
 
        }
282
 
        $messages{$_} = [];
283
 
        $comments{$_} = $1 if (defined($1));
284
 
    }
 
281
    my $tree = readXml($input);
 
282
    parseTree(0, $tree);
 
283
}
 
284
 
 
285
sub print_var {
 
286
    my $var = shift;
 
287
    my $vartype = ref $var;
 
288
    
 
289
    if ($vartype =~ /ARRAY/) {
 
290
        my @arr = @{$var};
 
291
        print "[ ";
 
292
        foreach my $el (@arr) {
 
293
            print_var($el);
 
294
            print ", ";
 
295
        }
 
296
        print "] ";
 
297
    } elsif ($vartype =~ /HASH/) {
 
298
        my %hash = %{$var};
 
299
        print "{ ";
 
300
        foreach my $key (keys %hash) {
 
301
            print "$key => ";
 
302
            print_var($hash{$key});
 
303
            print ", ";
 
304
        }
 
305
        print "} ";
 
306
    } else {
 
307
        print $var;
 
308
    }
 
309
}
 
310
 
 
311
# Same syntax as getAttributeString in intltool-merge.in.in, similar logic (look for ## differences comment)
 
312
sub getAttributeString
 
313
{
 
314
    my $sub = shift;
 
315
    my $do_translate = shift || 1;
 
316
    my $language = shift || "";
 
317
    my $translate = shift;
 
318
    my $result = "";
 
319
    foreach my $e (reverse(sort(keys %{ $sub }))) {
 
320
        my $key    = $e;
 
321
        my $string = $sub->{$e};
 
322
        my $quote = '"';
 
323
        
 
324
        $string =~ s/^[\s]+//;
 
325
        $string =~ s/[\s]+$//;
 
326
        
 
327
        if ($string =~ /^'.*'$/)
 
328
        {
 
329
            $quote = "'";
 
330
        }
 
331
        $string =~ s/^['"]//g;
 
332
        $string =~ s/['"]$//g;
 
333
 
 
334
        ## differences from intltool-merge.in.in
 
335
        if ($key =~ /^_/) {
 
336
            $comments{entity_decode($string)} = $XMLCOMMENT if $XMLCOMMENT;
 
337
            $messages{entity_decode($string)} = [];
 
338
            $$translate = 2;
 
339
        }
 
340
        ## differences end here from intltool-merge.in.in
 
341
        $result .= " $key=$quote$string$quote";
 
342
    }
 
343
    return $result;
 
344
}
 
345
 
 
346
# Verbatim copy from intltool-merge.in.in
 
347
sub getXMLstring
 
348
{
 
349
    my $ref = shift;
 
350
    my $spacepreserve = shift || 0;
 
351
    my @list = @{ $ref };
 
352
    my $result = "";
 
353
 
 
354
    my $count = scalar(@list);
 
355
    my $attrs = $list[0];
 
356
    my $index = 1;
 
357
 
 
358
    $spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/));
 
359
    $spacepreserve = 0 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?default["']?$/));
 
360
 
 
361
    while ($index < $count) {
 
362
        my $type = $list[$index];
 
363
        my $content = $list[$index+1];
 
364
        if (! $type ) {
 
365
            # We've got CDATA
 
366
            if ($content) {
 
367
                # lets strip the whitespace here, and *ONLY* here
 
368
                $content =~ s/\s+/ /gs if (!$spacepreserve);
 
369
                $result .= $content;
 
370
            }
 
371
        } elsif ( "$type" ne "1" ) {
 
372
            # We've got another element
 
373
            $result .= "<$type";
 
374
            $result .= getAttributeString(@{$content}[0], 0); # no nested translatable elements
 
375
            if ($content) {
 
376
                my $subresult = getXMLstring($content, $spacepreserve);
 
377
                if ($subresult) {
 
378
                    $result .= ">".$subresult . "</$type>";
 
379
                } else {
 
380
                    $result .= "/>";
 
381
                }
 
382
            } else {
 
383
                $result .= "/>";
 
384
            }
 
385
        }
 
386
        $index += 2;
 
387
    }
 
388
    return $result;
 
389
}
 
390
 
 
391
# Verbatim copy from intltool-merge.in.in, except for MULTIPLE_OUTPUT handling removed
 
392
# Translate list of nodes if necessary
 
393
sub translate_subnodes
 
394
{
 
395
    my $fh = shift;
 
396
    my $content = shift;
 
397
    my $language = shift || "";
 
398
    my $singlelang = shift || 0;
 
399
    my $spacepreserve = shift || 0;
 
400
 
 
401
    my @nodes = @{ $content };
 
402
 
 
403
    my $count = scalar(@nodes);
 
404
    my $index = 0;
 
405
    while ($index < $count) {
 
406
        my $type = $nodes[$index];
 
407
        my $rest = $nodes[$index+1];
 
408
        traverse($fh, $type, $rest, $language, $spacepreserve);
 
409
        $index += 2;
 
410
    }
 
411
}
 
412
 
 
413
# Based on traverse() in intltool-merge.in.in
 
414
sub traverse
 
415
{
 
416
    my $fh = shift; # unused, to allow us to sync code between -merge and -extract
 
417
    my $nodename = shift;
 
418
    my $content = shift;
 
419
    my $language = shift || "";
 
420
    my $spacepreserve = shift || 0;
 
421
 
 
422
    if ($nodename && "$nodename" eq "1") {
 
423
        $XMLCOMMENT = $content;
 
424
    } elsif ($nodename) {
 
425
        # element
 
426
        my @all = @{ $content };
 
427
        my $attrs = shift @all;
 
428
        my $translate = 0;
 
429
        my $outattr = getAttributeString($attrs, 1, $language, \$translate);
 
430
 
 
431
        if ($nodename =~ /^_/) {
 
432
            $translate = 1;
 
433
            $nodename =~ s/^_//;
 
434
        }
 
435
        my $lookup = '';
 
436
 
 
437
        $spacepreserve = 0 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?default["']?$/));
 
438
        $spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/));
 
439
 
 
440
        if ($translate) {
 
441
            $lookup = getXMLstring($content, $spacepreserve);
 
442
            if (!$spacepreserve) {
 
443
                $lookup =~ s/^\s+//s;
 
444
                $lookup =~ s/\s+$//s;
 
445
            }
 
446
 
 
447
            if ($lookup && $translate != 2) {
 
448
                $comments{$lookup} = $XMLCOMMENT if $XMLCOMMENT;
 
449
                $messages{$lookup} = [];
 
450
            } elsif ($translate == 2) {
 
451
                translate_subnodes($fh, \@all, $language, 1, $spacepreserve);
 
452
            }
 
453
        } else {
 
454
            $XMLCOMMENT = "";
 
455
            my $count = scalar(@all);
 
456
            if ($count > 0) {
 
457
                my $index = 0;
 
458
                while ($index < $count) {
 
459
                    my $type = $all[$index];
 
460
                    my $rest = $all[$index+1];
 
461
                    traverse($fh, $type, $rest, $language, $spacepreserve);
 
462
                    $index += 2;
 
463
                }
 
464
            }
 
465
        }
 
466
        $XMLCOMMENT = "";
 
467
    }
 
468
}
 
469
 
 
470
 
 
471
# Verbatim copy from intltool-merge.in.in, $fh for compatibility
 
472
sub parseTree
 
473
{
 
474
    my $fh        = shift;
 
475
    my $ref       = shift;
 
476
    my $language  = shift || "";
 
477
 
 
478
    my $name = shift @{ $ref };
 
479
    my $cont = shift @{ $ref };
 
480
 
 
481
    while (!$name || "$name" eq "1") {
 
482
        $name = shift @{ $ref };
 
483
        $cont = shift @{ $ref };
 
484
    }
 
485
 
 
486
    my $spacepreserve = 0;
 
487
    my $attrs = @{$cont}[0];
 
488
    $spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/));
 
489
 
 
490
    traverse($fh, $name, $cont, $language, $spacepreserve);
 
491
}
 
492
 
 
493
# Verbatim copy from intltool-merge.in.in
 
494
sub intltool_tree_comment
 
495
{
 
496
    my $expat = shift;
 
497
    my $data  = $expat->original_string();
 
498
    my $clist = $expat->{Curlist};
 
499
    my $pos   = $#$clist;
 
500
 
 
501
    $data =~ s/^<!--//s;
 
502
    $data =~ s/-->$//s;
 
503
    push @$clist, 1 => $data;
 
504
}
 
505
 
 
506
# Verbatim copy from intltool-merge.in.in
 
507
sub intltool_tree_cdatastart
 
508
{
 
509
    my $expat    = shift;
 
510
    my $clist = $expat->{Curlist};
 
511
    my $pos   = $#$clist;
 
512
 
 
513
    push @$clist, 0 => $expat->original_string();
 
514
}
 
515
 
 
516
# Verbatim copy from intltool-merge.in.in
 
517
sub intltool_tree_cdataend
 
518
{
 
519
    my $expat    = shift;
 
520
    my $clist = $expat->{Curlist};
 
521
    my $pos   = $#$clist;
 
522
 
 
523
    $clist->[$pos] .= $expat->original_string();
 
524
}
 
525
 
 
526
# Verbatim copy from intltool-merge.in.in
 
527
sub intltool_tree_char
 
528
{
 
529
    my $expat = shift;
 
530
    my $text  = shift;
 
531
    my $clist = $expat->{Curlist};
 
532
    my $pos   = $#$clist;
 
533
 
 
534
    # Use original_string so that we retain escaped entities
 
535
    # in CDATA sections.
 
536
    #
 
537
    if ($pos > 0 and $clist->[$pos - 1] eq '0') {
 
538
        $clist->[$pos] .= $expat->original_string();
 
539
    } else {
 
540
        push @$clist, 0 => $expat->original_string();
 
541
    }
 
542
}
 
543
 
 
544
# Verbatim copy from intltool-merge.in.in
 
545
sub intltool_tree_start
 
546
{
 
547
    my $expat    = shift;
 
548
    my $tag      = shift;
 
549
    my @origlist = ();
 
550
 
 
551
    # Use original_string so that we retain escaped entities
 
552
    # in attribute values.  We must convert the string to an
 
553
    # @origlist array to conform to the structure of the Tree
 
554
    # Style.
 
555
    #
 
556
    my @original_array = split /\x/, $expat->original_string();
 
557
    my $source         = $expat->original_string();
 
558
 
 
559
    # Remove leading tag.
 
560
    #
 
561
    $source =~ s|^\s*<\s*(\S+)||s;
 
562
 
 
563
    # Grab attribute key/value pairs and push onto @origlist array.
 
564
    #
 
565
    while ($source)
 
566
    {
 
567
       if ($source =~ /^\s*([\w:-]+)\s*[=]\s*["]/)
 
568
       {
 
569
           $source =~ s|^\s*([\w:-]+)\s*[=]\s*["]([^"]*)["]||s;
 
570
           push @origlist, $1;
 
571
           push @origlist, '"' . $2 . '"';
 
572
       }
 
573
       elsif ($source =~ /^\s*([\w:-]+)\s*[=]\s*[']/)
 
574
       {
 
575
           $source =~ s|^\s*([\w:-]+)\s*[=]\s*[']([^']*)[']||s;
 
576
           push @origlist, $1;
 
577
           push @origlist, "'" . $2 . "'";
 
578
       }
 
579
       else
 
580
       {
 
581
           last;
 
582
       }
 
583
    }
 
584
 
 
585
    my $ol = [ { @origlist } ];
 
586
 
 
587
    push @{ $expat->{Lists} }, $expat->{Curlist};
 
588
    push @{ $expat->{Curlist} }, $tag => $ol;
 
589
    $expat->{Curlist} = $ol;
 
590
}
 
591
 
 
592
# Copied from intltool-merge.in.in and added comment handler.
 
593
sub readXml
 
594
{
 
595
    my $xmldoc = shift || return;
 
596
    my $ret = eval 'require XML::Parser';
 
597
    if(!$ret) {
 
598
        die "You must have XML::Parser installed to run $0\n\n";
 
599
    }
 
600
    my $xp = new XML::Parser(Style => 'Tree');
 
601
    $xp->setHandlers(Char => \&intltool_tree_char);
 
602
    $xp->setHandlers(Start => \&intltool_tree_start);
 
603
    $xp->setHandlers(CdataStart => \&intltool_tree_cdatastart);
 
604
    $xp->setHandlers(CdataEnd => \&intltool_tree_cdataend);
 
605
 
 
606
    ## differences from intltool-merge.in.in
 
607
    $xp->setHandlers(Comment => \&intltool_tree_comment);
 
608
    ## differences end here from intltool-merge.in.in
 
609
 
 
610
    my $tree = $xp->parse($xmldoc);
 
611
    #print_var($tree);
 
612
 
 
613
# <foo><!-- comment --><head id="a">Hello <em>there</em></head><bar>Howdy<ref/></bar>do</foo>
 
614
# would be:
 
615
# [foo, [{}, 1, "comment", head, [{id => "a"}, 0, "Hello ",  em, [{}, 0, "there"]], bar, 
 
616
# [{}, 0, "Howdy",  ref, [{}]], 0, "do" ] ]
 
617
 
 
618
    return $tree;
285
619
}
286
620
 
287
621
sub type_schemas {
386
720
    return @list;
387
721
}
388
722
 
 
723
sub type_quoted {
 
724
    while ($input =~ /\"(([^\"]|\\\")*[^\\\"])\"/g) {
 
725
        my $message = $1;
 
726
        my $before = $`;
 
727
        $message =~ s/\\\"/\"/g;
 
728
        $before =~ s/[^\n]//g;
 
729
        $messages{$message} = [];
 
730
        $loc{$message} = length ($before) + 2;
 
731
    }
 
732
}
 
733
 
389
734
sub type_glade {
390
735
    ### For translatable Glade XML files ###
391
736