← Back to branch summary

~ubuntu-branches/ubuntu/precise/gnomeradio/precise-updates

« back to all changes in this revision

Viewing changes to intltool-extract.in

  • Committer: Bazaar Package Importer
  • Author(s): Francesco Namuri
  • Date: 2008-05-12 00:36:27 UTC
  • mfrom: (2.1.5 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080512003627-m4r405wwqc2e3xgv
Tags: 1.7-6
http://bugs.debian.org/468796
http://bugs.debian.org/462891
* debian/changelog: sync with the one from ubuntu.
* debian/patches/prefs.c.patch: fixed. In 1.7-6 I've uploaded a wrong
  version of the patch, now it's the right one that Cesare Tirabassi
  has included in the ubuntu's package. (Closes: #468796, #462891)

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.0";
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
 
186
188
    &convert;
187
189
 
188
190
    open OUT, ">$OUTFILE";
 
191
    binmode (OUT) if $^O eq 'MSWin32';
189
192
    &msg_write;
190
193
    close OUT;
191
194
 
266
269
 
267
270
sub type_xml {
268
271
    ### 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
 
    }
 
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;
285
610
}
286
611
 
287
612
sub type_schemas {