← Back to branch summary

~ubuntu-branches/ubuntu/wily/gnomad2/wily

« back to all changes in this revision

Viewing changes to intltool-extract.in

  • Committer: Bazaar Package Importer
  • Author(s): martin f. krafft
  • Date: 2006-10-07 17:54:56 UTC
  • mfrom: (1.1.4 upstream) (2.1.1 etch)
  • Revision ID: james.westby@ubuntu.com-20061007175456-o2l26brr97j7ex6c
Tags: 2.8.8-1.1
http://bugs.debian.org/390390
* Non-maintainer upload.
* Use $(CURDIR) instead of $(PWD) in debian/rules (closes: #390390).
* Added version to debhelper build-dependency to match debian/compat.

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.27.1";
 
35
my $VERSION      = "0.35.0";
36
36
 
37
37
## Loaded modules
38
38
use strict; 
46
46
my $VERSION_ARG = "0";
47
47
my $UPDATE_ARG  = "0";
48
48
my $QUIET_ARG   = "0";
 
49
my $SRCDIR_ARG  = ".";
49
50
 
50
51
my $FILE;
51
52
my $OUTFILE;
53
54
my $gettext_type = "";
54
55
my $input;
55
56
my %messages = ();
 
57
my %loc = ();
 
58
my %count = ();
 
59
my %comments = ();
 
60
my $strcount = 0;
 
61
 
 
62
my $XMLCOMMENT = "";
56
63
 
57
64
## Use this instead of \w for XML files to handle more possible characters.
58
65
my $w = "[-A-Za-z0-9._:]";
68
75
            "version|v"  => \$VERSION_ARG,
69
76
            "update"     => \$UPDATE_ARG,
70
77
            "quiet|q"    => \$QUIET_ARG,
 
78
            "srcdir=s"   => \$SRCDIR_ARG,
71
79
            ) or &error;
72
80
 
73
81
&split_on_argument;
109
117
}   
110
118
 
111
119
sub place_local {
 
120
    $FILE        = $ARGV[0];
112
121
    $OUTFILE     = fileparse($FILE, ());
113
122
    if (!-e "tmp/") { 
114
123
        system("mkdir tmp/"); 
152
161
                    (conflicts with --update)
153
162
      --update      Writes output into the same directory the source file 
154
163
                    reside (conflicts with --local)
 
164
      --srcdir      Root of the source tree
155
165
  -v, --version     Output version information and exit
156
166
  -h, --help        Display this help and exit
157
167
  -q, --quiet       Quiet mode
175
185
sub extract {
176
186
    &determine_type;
177
187
 
178
 
    &convert ($FILE);
 
188
    &convert;
179
189
 
180
190
    open OUT, ">$OUTFILE";
 
191
    binmode (OUT) if $^O eq 'MSWin32';
181
192
    &msg_write;
182
193
    close OUT;
183
194
 
184
195
    print "Wrote $OUTFILE\n" unless $QUIET_ARG;
185
196
}
186
197
 
187
 
sub convert($) {
 
198
sub convert {
188
199
 
189
200
    ## Reading the file
190
201
    {
191
202
        local (*IN);
192
203
        local $/; #slurp mode
193
 
        open (IN, "<$FILE") || die "can't open $FILE: $!";
 
204
        open (IN, "<$SRCDIR_ARG/$FILE") || die "can't open $SRCDIR_ARG/$FILE: $!";
194
205
        $input = <IN>;
195
206
    }
196
207
 
258
269
 
259
270
sub type_xml {
260
271
    ### For generic translatable XML files ###
261
 
        
262
 
    while ($input =~ /\s_$w+\s*=\s*\"([^"]+)\"/sg) { # "
263
 
        $messages{entity_decode_minimal($1)} = [];
264
 
    }
265
 
 
266
 
    while ($input =~ /<_($w+)(?: xml:space="($w+)")?>(.+?)<\/_\1>/sg) {
267
 
        $_ = $3;
268
 
        if (!defined($2) || $2 ne "preserve") {
269
 
            s/\s+/ /g;
270
 
            s/^ //;
271
 
            s/ $//;
272
 
        }
273
 
        $messages{entity_decode_minimal($_)} = [];
274
 
    }
 
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;
275
610
}
276
611
 
277
612
sub type_schemas {
280
615
    # FIXME: We should handle escaped < (less than)
281
616
    while ($input =~ /
282
617
                      <locale\ name="C">\s*
283
 
                          (<default>\s*(.*?)\s*<\/default>\s*)?
284
 
                          (<short>\s*(.*?)\s*<\/short>\s*)?
285
 
                          (<long>\s*(.*?)\s*<\/long>\s*)?
 
618
                          (<default>\s*(?:<!--([^>]*?)-->\s*)?(.*?)\s*<\/default>\s*)?
 
619
                          (<short>\s*(?:<!--([^>]*?)-->\s*)?(.*?)\s*<\/short>\s*)?
 
620
                          (<long>\s*(?:<!--([^>]*?)-->\s*)?(.*?)\s*<\/long>\s*)?
286
621
                      <\/locale>
287
622
                     /sgx) {
288
 
        my @totranslate = ($2,$4,$6);
 
623
        my @totranslate = ($3,$6,$9);
 
624
        my @eachcomment = ($2,$5,$8);
289
625
        foreach (@totranslate) {
 
626
            my $currentcomment = shift @eachcomment;
290
627
            next if !$_;
291
 
        s/\s+/ /g;
292
 
        $messages{entity_decode_minimal($_)} = [];
 
628
            s/\s+/ /g;
 
629
            $messages{entity_decode_minimal($_)} = [];
 
630
            $comments{entity_decode_minimal($_)} = $currentcomment if (defined($currentcomment));
293
631
        }
294
632
    }
295
633
}
297
635
sub type_rfc822deb {
298
636
    ### For rfc822-style Debian configuration files ###
299
637
 
300
 
    while ($input =~ /(?:^|\n)_[^:]+:\s*(.*?)(?=\n\S|$)/sg) {
301
 
        my @str_list = rfc822deb_split($1);
302
 
        for my $str (@str_list) {
303
 
            #   As rfc822deb is for configuration files, duplicates
304
 
            #   should never happen.  Developers must use the
305
 
            #   [] construct to make msgid unique, see also intltool-merge
306
 
            print STDERR "Warning: msgid multiply defined:\n  $str\n"
307
 
                if defined($messages{$str});
 
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++;
308
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;
309
661
        }
 
662
        $lineno += ($text =~ s/\n//g);
310
663
    }
311
664
}
312
665
 
318
671
    #       and paragraphs are separated by a single dot on a line
319
672
    # This routine returns an array of all paragraphs, and reformat
320
673
    # them.
 
674
    # When first argument is 2, the string is a comma separated list of
 
675
    # values.
 
676
    my $type = shift;
321
677
    my $text = shift;
322
 
    $text =~ s/^ //mg;
 
678
    $text =~ s/^[ \t]//mg;
 
679
    return (split(/, */, $text, 0)) if $type ne 1;
323
680
    return ($text) if $text !~ /\n/;
324
681
 
325
682
    $text =~ s/([^\n]*)\n//;
326
683
    my @list = ($1);
327
684
    my $str = '';
328
 
    for my $line (split (/\n/, $text)) {
 
685
    for my $line (split (/\n/, $text))
 
686
    {
329
687
        chomp $line;
330
 
        $line =~ /\s+$/;
331
 
        if ($line =~ /^\.$/) {
 
688
        if ($line =~ /^\.\s*$/)
 
689
        {
332
690
            #  New paragraph
333
691
            $str =~ s/\s*$//;
334
692
            push(@list, $str);
335
693
            $str = '';
336
 
        } elsif ($line =~ /^\s/) {
 
694
        }
 
695
        elsif ($line =~ /^\s/)
 
696
        {
337
697
            #  Line which must not be reformatted
338
698
            $str .= "\n" if length ($str) && $str !~ /\n$/;
 
699
            $line =~ s/\s+$//;
339
700
            $str .= $line."\n";
340
 
        } else {
 
701
        }
 
702
        else
 
703
        {
341
704
            #  Continuation line, remove newline
342
 
            $str .= " " if length ($str) && $str !~ /[\n ]$/;
 
705
            $str .= " " if length ($str) && $str !~ /\n$/;
343
706
            $str .= $line;
344
707
        }
345
708
    }
357
720
        # Glade sometimes uses tags that normally mark translatable things for
358
721
        # little bits of non-translatable content. We work around this by not
359
722
        # translating strings that only includes something like label4 or window1.
360
 
        $messages{entity_decode($2)} = [] unless $2 =~ /^(window|label)[0-9]+$/;
 
723
        $messages{entity_decode($2)} = [] unless $2 =~ /^(window|label|dialog)[0-9]+$/;
361
724
    }
362
725
    
363
726
    while ($input =~ /<items>(..[^<]*)<\/items>/sg) {
367
730
    }
368
731
 
369
732
    ## handle new glade files
370
 
    while ($input =~ /<(property|atkproperty)\s+[^>]*translatable\s*=\s*"yes"[^>]*>([^<]+)<\/\1>/sg) {
371
 
        $messages{entity_decode($2)} = [] unless $2 =~ /^(window|label)[0-9]+$/;
 
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
        }
372
738
    }
373
739
    while ($input =~ /<atkaction\s+action_name="([^>]*)"\s+description="([^>]+)"\/>/sg) {
374
740
        $messages{entity_decode_minimal($2)} = [];
376
742
}
377
743
 
378
744
sub type_scheme {
379
 
    while ($input =~ /_\w*\(?"((?:[^"\\]+|\\.)*)"\)?/sg) {
380
 
        $messages{$1} = [];
 
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
        }
381
786
    }
382
787
}
383
788
 
384
789
sub msg_write {
385
 
    for my $message (sort keys %messages) { 
 
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};
386
814
        print OUT "/* xgettext:no-c-format */\n" if $message =~ /%/;
387
815
        
388
816
        my @lines = split (/\n/, $message, -1);
389
 
        for (my $n = 0; $n < @lines; $n++) {
390
 
            if ($n == 0) { 
 
817
        for (my $n = 0; $n < @lines; $n++)
 
818
        {
 
819
            if ($n == 0)
 
820
            {
391
821
                print OUT "char *s = N_(\""; 
392
 
            } else {  
393
 
                print OUT "             \""; 
394
 
            }
 
822
            }
 
823
            else
 
824
            {  
 
825
                print OUT "             \""; 
 
826
            }
395
827
 
396
828
            print OUT escape($lines[$n]);
397
829
 
398
 
            if ($n < @lines - 1) { 
399
 
                print OUT "\\n\"\n"; 
400
 
            } else { 
401
 
                print OUT "\");\n";  
 
830
            if ($n < @lines - 1)
 
831
            {
 
832
                print OUT "\\n\"\n"; 
 
833
            }
 
834
            else
 
835
            {
 
836
                print OUT "\");\n";  
402
837
            }
403
838
        }
404
839
    }