← Back to branch summary

~ubuntu-branches/ubuntu/maverick/gnome-terminal/maverick-proposed

« back to all changes in this revision

Viewing changes to intltool-extract.in

Tags: upstream-2.12.0
Import upstream version 2.12.0

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.31";
 
35
my $VERSION      = "0.34.1";
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
 
115
117
}   
116
118
 
117
119
sub place_local {
 
120
    $FILE        = $ARGV[0];
118
121
    $OUTFILE     = fileparse($FILE, ());
119
122
    if (!-e "tmp/") { 
120
123
        system("mkdir tmp/"); 
185
188
    &convert;
186
189
 
187
190
    open OUT, ">$OUTFILE";
 
191
    binmode (OUT) if $^O eq 'MSWin32';
188
192
    &msg_write;
189
193
    close OUT;
190
194
 
265
269
 
266
270
sub type_xml {
267
271
    ### For generic translatable XML files ###
268
 
        
269
 
    while ($input =~ /\s_$w+\s*=\s*\"([^"]+)\"/sg) { # "
270
 
        $messages{entity_decode_minimal($1)} = [];
271
 
    }
272
 
 
273
 
    while ($input =~ /(?:<!--([^>]*?)-->\s*)?<_($w+)(?: xml:space="($w+)")?>(.+?)<\/_\2>/sg) {
274
 
        $_ = $4;
275
 
        if (!defined($3) || $3 ne "preserve") {
276
 
            s/\s+/ /g;
277
 
            s/^ //;
278
 
            s/ $//;
279
 
        }
280
 
        $messages{$_} = [];
281
 
        $comments{$_} = $1 if (defined($1));
282
 
    }
 
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  = shift;
 
489
    my $clist = $expat->{Curlist};
 
490
    my $pos   = $#$clist;
 
491
 
 
492
    push @$clist, 1 => $data;
 
493
}
 
494
 
 
495
# Verbatim copy from intltool-merge.in.in
 
496
sub intltool_tree_cdatastart
 
497
{
 
498
    my $expat    = shift;
 
499
    my $clist = $expat->{Curlist};
 
500
    my $pos   = $#$clist;
 
501
 
 
502
    push @$clist, 0 => $expat->original_string();
 
503
}
 
504
 
 
505
# Verbatim copy from intltool-merge.in.in
 
506
sub intltool_tree_cdataend
 
507
{
 
508
    my $expat    = shift;
 
509
    my $clist = $expat->{Curlist};
 
510
    my $pos   = $#$clist;
 
511
 
 
512
    $clist->[$pos] .= $expat->original_string();
 
513
}
 
514
 
 
515
# Verbatim copy from intltool-merge.in.in
 
516
sub intltool_tree_char
 
517
{
 
518
    my $expat = shift;
 
519
    my $text  = shift;
 
520
    my $clist = $expat->{Curlist};
 
521
    my $pos   = $#$clist;
 
522
 
 
523
    # Use original_string so that we retain escaped entities
 
524
    # in CDATA sections.
 
525
    #
 
526
    if ($pos > 0 and $clist->[$pos - 1] eq '0') {
 
527
        $clist->[$pos] .= $expat->original_string();
 
528
    } else {
 
529
        push @$clist, 0 => $expat->original_string();
 
530
    }
 
531
}
 
532
 
 
533
# Verbatim copy from intltool-merge.in.in
 
534
sub intltool_tree_start
 
535
{
 
536
    my $expat    = shift;
 
537
    my $tag      = shift;
 
538
    my @origlist = ();
 
539
 
 
540
    # Use original_string so that we retain escaped entities
 
541
    # in attribute values.  We must convert the string to an
 
542
    # @origlist array to conform to the structure of the Tree
 
543
    # Style.
 
544
    #
 
545
    my @original_array = split /\x/, $expat->original_string();
 
546
    my $source         = $expat->original_string();
 
547
 
 
548
    # Remove leading tag.
 
549
    #
 
550
    $source =~ s|^\s*<\s*(\S+)||s;
 
551
 
 
552
    # Grab attribute key/value pairs and push onto @origlist array.
 
553
    #
 
554
    while ($source)
 
555
    {
 
556
       if ($source =~ /^\s*([\w:-]+)\s*[=]\s*["]/)
 
557
       {
 
558
           $source =~ s|^\s*([\w:-]+)\s*[=]\s*["]([^"]*)["]||s;
 
559
           push @origlist, $1;
 
560
           push @origlist, '"' . $2 . '"';
 
561
       }
 
562
       elsif ($source =~ /^\s*([\w:-]+)\s*[=]\s*[']/)
 
563
       {
 
564
           $source =~ s|^\s*([\w:-]+)\s*[=]\s*[']([^']*)[']||s;
 
565
           push @origlist, $1;
 
566
           push @origlist, "'" . $2 . "'";
 
567
       }
 
568
       else
 
569
       {
 
570
           last;
 
571
       }
 
572
    }
 
573
 
 
574
    my $ol = [ { @origlist } ];
 
575
 
 
576
    push @{ $expat->{Lists} }, $expat->{Curlist};
 
577
    push @{ $expat->{Curlist} }, $tag => $ol;
 
578
    $expat->{Curlist} = $ol;
 
579
}
 
580
 
 
581
# Copied from intltool-merge.in.in and added comment handler.
 
582
sub readXml
 
583
{
 
584
    my $xmldoc = shift || return;
 
585
    my $ret = eval 'require XML::Parser';
 
586
    if(!$ret) {
 
587
        die "You must have XML::Parser installed to run $0\n\n";
 
588
    }
 
589
    my $xp = new XML::Parser(Style => 'Tree');
 
590
    $xp->setHandlers(Char => \&intltool_tree_char);
 
591
    $xp->setHandlers(Start => \&intltool_tree_start);
 
592
    $xp->setHandlers(CdataStart => \&intltool_tree_cdatastart);
 
593
    $xp->setHandlers(CdataEnd => \&intltool_tree_cdataend);
 
594
 
 
595
    ## differences from intltool-merge.in.in
 
596
    $xp->setHandlers(Comment => \&intltool_tree_comment);
 
597
    ## differences end here from intltool-merge.in.in
 
598
 
 
599
    my $tree = $xp->parse($xmldoc);
 
600
    #print_var($tree);
 
601
 
 
602
# <foo><!-- comment --><head id="a">Hello <em>there</em></head><bar>Howdy<ref/></bar>do</foo>
 
603
# would be:
 
604
# [foo, [{}, 1, "comment", head, [{id => "a"}, 0, "Hello ",  em, [{}, 0, "there"]], bar, 
 
605
# [{}, 0, "Howdy",  ref, [{}]], 0, "do" ] ]
 
606
 
 
607
    return $tree;
283
608
}
284
609
 
285
610
sub type_schemas {
393
718
        # Glade sometimes uses tags that normally mark translatable things for
394
719
        # little bits of non-translatable content. We work around this by not
395
720
        # translating strings that only includes something like label4 or window1.
396
 
        $messages{entity_decode($2)} = [] unless $2 =~ /^(window|label)[0-9]+$/;
 
721
        $messages{entity_decode($2)} = [] unless $2 =~ /^(window|label|dialog)[0-9]+$/;
397
722
    }
398
723
    
399
724
    while ($input =~ /<items>(..[^<]*)<\/items>/sg) {
403
728
    }
404
729
 
405
730
    ## handle new glade files
406
 
    while ($input =~ /<(property|atkproperty)\s+[^>]*translatable\s*=\s*"yes"[^>]*>([^<]+)<\/\1>/sg) {
407
 
        $messages{entity_decode($2)} = [] unless $2 =~ /^(window|label)[0-9]+$/;
 
731
    while ($input =~ /<(property|atkproperty)\s+[^>]*translatable\s*=\s*"yes"(?:\s+[^>]*comments\s*=\s*"([^"]*)")?[^>]*>([^<]+)<\/\1>/sg) {
 
732
        $messages{entity_decode($3)} = [] unless $3 =~ /^(window|label)[0-9]+$/;
 
733
        if (defined($2) and !($3 =~ /^(window|label)[0-9]+$/)) {
 
734
           $comments{entity_decode($3)} = entity_decode($2) ;
 
735
        }
408
736
    }
409
737
    while ($input =~ /<atkaction\s+action_name="([^>]*)"\s+description="([^>]+)"\/>/sg) {
410
738
        $messages{entity_decode_minimal($2)} = [];
412
740
}
413
741
 
414
742
sub type_scheme {
415
 
    while ($input =~ /_\w*\(?"((?:[^"\\]+|\\.)*)"\)?/sg) {
416
 
        $messages{$1} = [];
 
743
    my ($line, $i, $state, $str, $trcomment, $char);
 
744
    for $line (split(/\n/, $input)) {
 
745
        $i = 0;
 
746
        $state = 0; # 0 - nothing, 1 - string, 2 - translatable string
 
747
        while ($i < length($line)) {
 
748
            if (substr($line,$i,1) eq "\"") {
 
749
                if ($state == 2) {
 
750
                    $comments{$str} = $trcomment if ($trcomment);
 
751
                    $messages{$str} = [];
 
752
                    $str = '';
 
753
                    $state = 0; $trcomment = "";
 
754
                } elsif ($state == 1) {
 
755
                    $str = '';
 
756
                    $state = 0; $trcomment = "";
 
757
                } else {
 
758
                    $state = 1;
 
759
                    $str = '';
 
760
                    if ($i>0 && substr($line,$i-1,1) eq '_') {
 
761
                        $state = 2;
 
762
                    }
 
763
                }
 
764
            } elsif (!$state) {
 
765
                if (substr($line,$i,1) eq ";") {
 
766
                    $trcomment = substr($line,$i+1);
 
767
                    $trcomment =~ s/^;*\s*//;
 
768
                    $i = length($line);
 
769
                } elsif ($trcomment && substr($line,$i,1) !~ /\s|\(|\)|_/) {
 
770
                    $trcomment = "";
 
771
                }
 
772
            } else {
 
773
                if (substr($line,$i,1) eq "\\") {
 
774
                    $char = substr($line,$i+1,1);
 
775
                    if ($char ne "\"" && $char ne "\\") {
 
776
                       $str = $str . "\\";
 
777
                    }
 
778
                    $i++;
 
779
                }
 
780
                $str = $str . substr($line,$i,1);
 
781
            }
 
782
            $i++;
 
783
        }
417
784
    }
418
785
}
419
786