← Back to branch summary

~ubuntu-branches/ubuntu/hardy/uim/hardy

« back to all changes in this revision

Viewing changes to intltool-extract.in

  • Committer: Bazaar Package Importer
  • Author(s): Masahito Omote
  • Date: 2007-04-21 03:46:09 UTC
  • mfrom: (1.1.6 upstream)
  • Revision ID: james.westby@ubuntu.com-20070421034609-gpcurkutp8vaysqj
Tags: 1:1.4.1-3
* Switch to dh_gtkmodules for the gtk 2.10 transition (Closes:
  #419318)
  - debian/control: Add ${misc:Depends} and remove libgtk2.0-bin on
    uim-gtk2.0.
  - debian/uim-gtk2.0.post{inst,rm}: Removed.

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.2";
 
35
my $VERSION      = "0.35.4";
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 {
 
125
    $FILE        = $ARGV[0];
118
126
    $OUTFILE     = fileparse($FILE, ());
119
127
    if (!-e "tmp/") { 
120
128
        system("mkdir tmp/"); 
153
161
      --type=TYPE   Specify the file type of FILENAME. Currently supports:
154
162
                    "gettext/glade", "gettext/ini", "gettext/keys"
155
163
                    "gettext/rfc822deb", "gettext/schemas",
156
 
                    "gettext/scheme", "gettext/xml"
 
164
                    "gettext/scheme", "gettext/xml", "gettext/quoted"
157
165
  -l, --local       Writes output into current working directory
158
166
                    (conflicts with --update)
159
167
      --update      Writes output into the same directory the source file 
185
193
    &convert;
186
194
 
187
195
    open OUT, ">$OUTFILE";
 
196
    binmode (OUT) if $^O eq 'MSWin32';
188
197
    &msg_write;
189
198
    close OUT;
190
199
 
208
217
    &type_scheme if $gettext_type eq "scheme";
209
218
    &type_schemas  if $gettext_type eq "schemas";
210
219
    &type_rfc822deb  if $gettext_type eq "rfc822deb";
 
220
    &type_quoted if $gettext_type eq "quoted";
211
221
}
212
222
 
213
223
sub entity_decode_minimal
238
248
{
239
249
    return '\"' if $_ eq '"';
240
250
    return '\n' if $_ eq "\n";
241
 
    return '\\' if $_ eq '\\';
 
251
    return '\\\\' if $_ eq '\\';
242
252
 
243
253
    return $_;
244
254
}
265
275
 
266
276
sub type_xml {
267
277
    ### For generic translatable XML files ###
268
 
        
269
 
    while ($input =~ /(?:<!--([^>]*?)-->[^\n]*\n?[^\n]*)?\s_$w+\s*=\s*\"([^"]+)\"/sg) { # "
270
 
        $messages{entity_decode_minimal($2)} = [];
271
 
        $comments{entity_decode_minimal($2)} = $1 if (defined($1));
272
 
    }
273
 
 
274
 
    while ($input =~ /(?:<!--([^>]*?)-->\s*)?<_($w+)(?: xml:space="($w+)")?[^>]*>(.+?)<\/_\2>/sg) {
275
 
        $_ = $4;
276
 
        if (!defined($3) || $3 ne "preserve") {
277
 
            s/\s+/ /g;
278
 
            s/^ //;
279
 
            s/ $//;
280
 
        }
281
 
        $messages{$_} = [];
282
 
        $comments{$_} = $1 if (defined($1));
283
 
    }
 
278
    my $tree = readXml($input);
 
279
    parseTree(0, $tree);
 
280
}
 
281
 
 
282
sub print_var {
 
283
    my $var = shift;
 
284
    my $vartype = ref $var;
 
285
    
 
286
    if ($vartype =~ /ARRAY/) {
 
287
        my @arr = @{$var};
 
288
        print "[ ";
 
289
        foreach my $el (@arr) {
 
290
            print_var($el);
 
291
            print ", ";
 
292
        }
 
293
        print "] ";
 
294
    } elsif ($vartype =~ /HASH/) {
 
295
        my %hash = %{$var};
 
296
        print "{ ";
 
297
        foreach my $key (keys %hash) {
 
298
            print "$key => ";
 
299
            print_var($hash{$key});
 
300
            print ", ";
 
301
        }
 
302
        print "} ";
 
303
    } else {
 
304
        print $var;
 
305
    }
 
306
}
 
307
 
 
308
# Same syntax as getAttributeString in intltool-merge.in.in, similar logic (look for ## differences comment)
 
309
sub getAttributeString
 
310
{
 
311
    my $sub = shift;
 
312
    my $do_translate = shift || 1;
 
313
    my $language = shift || "";
 
314
    my $translate = shift;
 
315
    my $result = "";
 
316
    foreach my $e (reverse(sort(keys %{ $sub }))) {
 
317
        my $key    = $e;
 
318
        my $string = $sub->{$e};
 
319
        my $quote = '"';
 
320
        
 
321
        $string =~ s/^[\s]+//;
 
322
        $string =~ s/[\s]+$//;
 
323
        
 
324
        if ($string =~ /^'.*'$/)
 
325
        {
 
326
            $quote = "'";
 
327
        }
 
328
        $string =~ s/^['"]//g;
 
329
        $string =~ s/['"]$//g;
 
330
 
 
331
        ## differences from intltool-merge.in.in
 
332
        if ($key =~ /^_/) {
 
333
            $comments{entity_decode($string)} = $XMLCOMMENT if $XMLCOMMENT;
 
334
            $messages{entity_decode($string)} = [];
 
335
            $$translate = 2;
 
336
        }
 
337
        ## differences end here from intltool-merge.in.in
 
338
        $result .= " $key=$quote$string$quote";
 
339
    }
 
340
    return $result;
 
341
}
 
342
 
 
343
# Verbatim copy from intltool-merge.in.in
 
344
sub getXMLstring
 
345
{
 
346
    my $ref = shift;
 
347
    my $spacepreserve = shift || 0;
 
348
    my @list = @{ $ref };
 
349
    my $result = "";
 
350
 
 
351
    my $count = scalar(@list);
 
352
    my $attrs = $list[0];
 
353
    my $index = 1;
 
354
 
 
355
    $spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/));
 
356
    $spacepreserve = 0 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?default["']?$/));
 
357
 
 
358
    while ($index < $count) {
 
359
        my $type = $list[$index];
 
360
        my $content = $list[$index+1];
 
361
        if (! $type ) {
 
362
            # We've got CDATA
 
363
            if ($content) {
 
364
                # lets strip the whitespace here, and *ONLY* here
 
365
                $content =~ s/\s+/ /gs if (!$spacepreserve);
 
366
                $result .= $content;
 
367
            }
 
368
        } elsif ( "$type" ne "1" ) {
 
369
            # We've got another element
 
370
            $result .= "<$type";
 
371
            $result .= getAttributeString(@{$content}[0], 0); # no nested translatable elements
 
372
            if ($content) {
 
373
                my $subresult = getXMLstring($content, $spacepreserve);
 
374
                if ($subresult) {
 
375
                    $result .= ">".$subresult . "</$type>";
 
376
                } else {
 
377
                    $result .= "/>";
 
378
                }
 
379
            } else {
 
380
                $result .= "/>";
 
381
            }
 
382
        }
 
383
        $index += 2;
 
384
    }
 
385
    return $result;
 
386
}
 
387
 
 
388
# Verbatim copy from intltool-merge.in.in, except for MULTIPLE_OUTPUT handling removed
 
389
# Translate list of nodes if necessary
 
390
sub translate_subnodes
 
391
{
 
392
    my $fh = shift;
 
393
    my $content = shift;
 
394
    my $language = shift || "";
 
395
    my $singlelang = shift || 0;
 
396
    my $spacepreserve = shift || 0;
 
397
 
 
398
    my @nodes = @{ $content };
 
399
 
 
400
    my $count = scalar(@nodes);
 
401
    my $index = 0;
 
402
    while ($index < $count) {
 
403
        my $type = $nodes[$index];
 
404
        my $rest = $nodes[$index+1];
 
405
        traverse($fh, $type, $rest, $language, $spacepreserve);
 
406
        $index += 2;
 
407
    }
 
408
}
 
409
 
 
410
# Based on traverse() in intltool-merge.in.in
 
411
sub traverse
 
412
{
 
413
    my $fh = shift; # unused, to allow us to sync code between -merge and -extract
 
414
    my $nodename = shift;
 
415
    my $content = shift;
 
416
    my $language = shift || "";
 
417
    my $spacepreserve = shift || 0;
 
418
 
 
419
    if ($nodename && "$nodename" eq "1") {
 
420
        $XMLCOMMENT = $content;
 
421
    } elsif ($nodename) {
 
422
        # element
 
423
        my @all = @{ $content };
 
424
        my $attrs = shift @all;
 
425
        my $translate = 0;
 
426
        my $outattr = getAttributeString($attrs, 1, $language, \$translate);
 
427
 
 
428
        if ($nodename =~ /^_/) {
 
429
            $translate = 1;
 
430
            $nodename =~ s/^_//;
 
431
        }
 
432
        my $lookup = '';
 
433
 
 
434
        $spacepreserve = 0 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?default["']?$/));
 
435
        $spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/));
 
436
 
 
437
        if ($translate) {
 
438
            $lookup = getXMLstring($content, $spacepreserve);
 
439
            if (!$spacepreserve) {
 
440
                $lookup =~ s/^\s+//s;
 
441
                $lookup =~ s/\s+$//s;
 
442
            }
 
443
 
 
444
            if ($lookup && $translate != 2) {
 
445
                $comments{$lookup} = $XMLCOMMENT if $XMLCOMMENT;
 
446
                $messages{$lookup} = [];
 
447
            } elsif ($translate == 2) {
 
448
                translate_subnodes($fh, \@all, $language, 1, $spacepreserve);
 
449
            }
 
450
        } else {
 
451
            $XMLCOMMENT = "";
 
452
            my $count = scalar(@all);
 
453
            if ($count > 0) {
 
454
                my $index = 0;
 
455
                while ($index < $count) {
 
456
                    my $type = $all[$index];
 
457
                    my $rest = $all[$index+1];
 
458
                    traverse($fh, $type, $rest, $language, $spacepreserve);
 
459
                    $index += 2;
 
460
                }
 
461
            }
 
462
        }
 
463
        $XMLCOMMENT = "";
 
464
    }
 
465
}
 
466
 
 
467
 
 
468
# Verbatim copy from intltool-merge.in.in, $fh for compatibility
 
469
sub parseTree
 
470
{
 
471
    my $fh        = shift;
 
472
    my $ref       = shift;
 
473
    my $language  = shift || "";
 
474
 
 
475
    my $name = shift @{ $ref };
 
476
    my $cont = shift @{ $ref };
 
477
 
 
478
    while (!$name || "$name" eq "1") {
 
479
        $name = shift @{ $ref };
 
480
        $cont = shift @{ $ref };
 
481
    }
 
482
 
 
483
    my $spacepreserve = 0;
 
484
    my $attrs = @{$cont}[0];
 
485
    $spacepreserve = 1 if ((exists $attrs->{"xml:space"}) && ($attrs->{"xml:space"} =~ /^["']?preserve["']?$/));
 
486
 
 
487
    traverse($fh, $name, $cont, $language, $spacepreserve);
 
488
}
 
489
 
 
490
# Verbatim copy from intltool-merge.in.in
 
491
sub intltool_tree_comment
 
492
{
 
493
    my $expat = shift;
 
494
    my $data  = $expat->original_string();
 
495
    my $clist = $expat->{Curlist};
 
496
    my $pos   = $#$clist;
 
497
 
 
498
    $data =~ s/^<!--//s;
 
499
    $data =~ s/-->$//s;
 
500
    push @$clist, 1 => $data;
 
501
}
 
502
 
 
503
# Verbatim copy from intltool-merge.in.in
 
504
sub intltool_tree_cdatastart
 
505
{
 
506
    my $expat    = shift;
 
507
    my $clist = $expat->{Curlist};
 
508
    my $pos   = $#$clist;
 
509
 
 
510
    push @$clist, 0 => $expat->original_string();
 
511
}
 
512
 
 
513
# Verbatim copy from intltool-merge.in.in
 
514
sub intltool_tree_cdataend
 
515
{
 
516
    my $expat    = shift;
 
517
    my $clist = $expat->{Curlist};
 
518
    my $pos   = $#$clist;
 
519
 
 
520
    $clist->[$pos] .= $expat->original_string();
 
521
}
 
522
 
 
523
# Verbatim copy from intltool-merge.in.in
 
524
sub intltool_tree_char
 
525
{
 
526
    my $expat = shift;
 
527
    my $text  = shift;
 
528
    my $clist = $expat->{Curlist};
 
529
    my $pos   = $#$clist;
 
530
 
 
531
    # Use original_string so that we retain escaped entities
 
532
    # in CDATA sections.
 
533
    #
 
534
    if ($pos > 0 and $clist->[$pos - 1] eq '0') {
 
535
        $clist->[$pos] .= $expat->original_string();
 
536
    } else {
 
537
        push @$clist, 0 => $expat->original_string();
 
538
    }
 
539
}
 
540
 
 
541
# Verbatim copy from intltool-merge.in.in
 
542
sub intltool_tree_start
 
543
{
 
544
    my $expat    = shift;
 
545
    my $tag      = shift;
 
546
    my @origlist = ();
 
547
 
 
548
    # Use original_string so that we retain escaped entities
 
549
    # in attribute values.  We must convert the string to an
 
550
    # @origlist array to conform to the structure of the Tree
 
551
    # Style.
 
552
    #
 
553
    my @original_array = split /\x/, $expat->original_string();
 
554
    my $source         = $expat->original_string();
 
555
 
 
556
    # Remove leading tag.
 
557
    #
 
558
    $source =~ s|^\s*<\s*(\S+)||s;
 
559
 
 
560
    # Grab attribute key/value pairs and push onto @origlist array.
 
561
    #
 
562
    while ($source)
 
563
    {
 
564
       if ($source =~ /^\s*([\w:-]+)\s*[=]\s*["]/)
 
565
       {
 
566
           $source =~ s|^\s*([\w:-]+)\s*[=]\s*["]([^"]*)["]||s;
 
567
           push @origlist, $1;
 
568
           push @origlist, '"' . $2 . '"';
 
569
       }
 
570
       elsif ($source =~ /^\s*([\w:-]+)\s*[=]\s*[']/)
 
571
       {
 
572
           $source =~ s|^\s*([\w:-]+)\s*[=]\s*[']([^']*)[']||s;
 
573
           push @origlist, $1;
 
574
           push @origlist, "'" . $2 . "'";
 
575
       }
 
576
       else
 
577
       {
 
578
           last;
 
579
       }
 
580
    }
 
581
 
 
582
    my $ol = [ { @origlist } ];
 
583
 
 
584
    push @{ $expat->{Lists} }, $expat->{Curlist};
 
585
    push @{ $expat->{Curlist} }, $tag => $ol;
 
586
    $expat->{Curlist} = $ol;
 
587
}
 
588
 
 
589
# Copied from intltool-merge.in.in and added comment handler.
 
590
sub readXml
 
591
{
 
592
    my $xmldoc = shift || return;
 
593
    my $ret = eval 'require XML::Parser';
 
594
    if(!$ret) {
 
595
        die "You must have XML::Parser installed to run $0\n\n";
 
596
    }
 
597
    my $xp = new XML::Parser(Style => 'Tree');
 
598
    $xp->setHandlers(Char => \&intltool_tree_char);
 
599
    $xp->setHandlers(Start => \&intltool_tree_start);
 
600
    $xp->setHandlers(CdataStart => \&intltool_tree_cdatastart);
 
601
    $xp->setHandlers(CdataEnd => \&intltool_tree_cdataend);
 
602
 
 
603
    ## differences from intltool-merge.in.in
 
604
    $xp->setHandlers(Comment => \&intltool_tree_comment);
 
605
    ## differences end here from intltool-merge.in.in
 
606
 
 
607
    my $tree = $xp->parse($xmldoc);
 
608
    #print_var($tree);
 
609
 
 
610
# <foo><!-- comment --><head id="a">Hello <em>there</em></head><bar>Howdy<ref/></bar>do</foo>
 
611
# would be:
 
612
# [foo, [{}, 1, "comment", head, [{id => "a"}, 0, "Hello ",  em, [{}, 0, "there"]], bar, 
 
613
# [{}, 0, "Howdy",  ref, [{}]], 0, "do" ] ]
 
614
 
 
615
    return $tree;
284
616
}
285
617
 
286
618
sub type_schemas {
385
717
    return @list;
386
718
}
387
719
 
 
720
sub type_quoted {
 
721
    while ($input =~ /\"(([^\"]|\\\")*[^\\\"])\"/g) {
 
722
        my $message = $1;
 
723
        my $before = $`;
 
724
        $message =~ s/\\\"/\"/g;
 
725
        $before =~ s/[^\n]//g;
 
726
        $messages{$message} = [];
 
727
        $loc{$message} = length ($before) + 2;
 
728
    }
 
729
}
 
730
 
388
731
sub type_glade {
389
732
    ### For translatable Glade XML files ###
390
733
 
394
737
        # Glade sometimes uses tags that normally mark translatable things for
395
738
        # little bits of non-translatable content. We work around this by not
396
739
        # translating strings that only includes something like label4 or window1.
397
 
        $messages{entity_decode($2)} = [] unless $2 =~ /^(window|label)[0-9]+$/;
 
740
        $messages{entity_decode($2)} = [] unless $2 =~ /^(window|label|dialog)[0-9]+$/;
398
741
    }
399
742
    
400
743
    while ($input =~ /<items>(..[^<]*)<\/items>/sg) {
404
747
    }
405
748
 
406
749
    ## handle new glade files
407
 
    while ($input =~ /<(property|atkproperty)\s+[^>]*translatable\s*=\s*"yes"[^>]*>([^<]+)<\/\1>/sg) {
408
 
        $messages{entity_decode($2)} = [] unless $2 =~ /^(window|label)[0-9]+$/;
 
750
    while ($input =~ /<(property|atkproperty)\s+[^>]*translatable\s*=\s*"yes"(?:\s+[^>]*comments\s*=\s*"([^"]*)")?[^>]*>([^<]+)<\/\1>/sg) {
 
751
        $messages{entity_decode($3)} = [] unless $3 =~ /^(window|label)[0-9]+$/;
 
752
        if (defined($2) and !($3 =~ /^(window|label)[0-9]+$/)) {
 
753
           $comments{entity_decode($3)} = entity_decode($2) ;
 
754
        }
409
755
    }
410
756
    while ($input =~ /<atkaction\s+action_name="([^>]*)"\s+description="([^>]+)"\/>/sg) {
411
757
        $messages{entity_decode_minimal($2)} = [];
413
759
}
414
760
 
415
761
sub type_scheme {
416
 
    while ($input =~ /_\w*\(?"((?:[^"\\]+|\\.)*)"\)?/sg) {
417
 
        $messages{$1} = [];
 
762
    my ($line, $i, $state, $str, $trcomment, $char);
 
763
    for $line (split(/\n/, $input)) {
 
764
        $i = 0;
 
765
        $state = 0; # 0 - nothing, 1 - string, 2 - translatable string
 
766
        while ($i < length($line)) {
 
767
            if (substr($line,$i,1) eq "\"") {
 
768
                if ($state == 2) {
 
769
                    $comments{$str} = $trcomment if ($trcomment);
 
770
                    $messages{$str} = [];
 
771
                    $str = '';
 
772
                    $state = 0; $trcomment = "";
 
773
                } elsif ($state == 1) {
 
774
                    $str = '';
 
775
                    $state = 0; $trcomment = "";
 
776
                } else {
 
777
                    $state = 1;
 
778
                    $str = '';
 
779
                    if ($i>0 && substr($line,$i-1,1) eq '_') {
 
780
                        $state = 2;
 
781
                    }
 
782
                }
 
783
            } elsif (!$state) {
 
784
                if (substr($line,$i,1) eq ";") {
 
785
                    $trcomment = substr($line,$i+1);
 
786
                    $trcomment =~ s/^;*\s*//;
 
787
                    $i = length($line);
 
788
                } elsif ($trcomment && substr($line,$i,1) !~ /\s|\(|\)|_/) {
 
789
                    $trcomment = "";
 
790
                }
 
791
            } else {
 
792
                if (substr($line,$i,1) eq "\\") {
 
793
                    $char = substr($line,$i+1,1);
 
794
                    if ($char ne "\"" && $char ne "\\") {
 
795
                       $str = $str . "\\";
 
796
                    }
 
797
                    $i++;
 
798
                }
 
799
                $str = $str . substr($line,$i,1);
 
800
            }
 
801
            $i++;
 
802
        }
418
803
    }
419
804
}
420
805