xgettext.pl 22.2 KB
Newer Older
1
#!/usr/bin/env perl
2
3
# -*- indent-tabs-mode: nil; -*-
# vim:ft=perl:et:sw=4
4

salaun's avatar
salaun committed
5
use strict;
6
7
use warnings;
use Cwd qw();
8
use Getopt::Long;
salaun's avatar
salaun committed
9
use Pod::Usage;
10

11
12
13
14
15
16
17
18
use constant NUL   => 0;
use constant BEG   => 1;
use constant PAR   => 2;
use constant QUO1  => 3;
use constant QUO2  => 4;
use constant QUO3  => 5;
use constant BEGM  => 6;
use constant PARM  => 7;
19
20
use constant QUOM1 => 8;
use constant QUOM2 => 9;
21
use constant COMM  => 10;
salaun's avatar
salaun committed
22

23
24
## A hash that will contain the strings to translate and their meta
## informations.
25
my %file;
26
## conatins informations if a string is a date string.
27
my %type_of_entries;
28
## Contains unique occurences of each string
29
my %Lexicon;
30
## All the strings, in the order they were found while parsing the files
31
my @ordered_strings = ();
32
33
## One occurence of each string, in the order they were found while parsing
## the files
34
my @unique_keys = ();
35
## A hash used for control when filling @unique_keys
36
my %unique_keys;
37
38

## Retrieving options.
39
my %opts;
40
41
42
43
44
45
46
47
48
49
50
51
52
53
GetOptions(
    \%opts,                 'add-comments|c:s',
    'copyright-holder=s',   'default-domain|d=s',
    'directory|D=s',        'files-from|f=s',
    'help|h',               'keyword|k:s@',
    'msgid-bugs-address=s', "output|o=s",
    'package-name=s',       'package-version=s',
    'version|v',            't=s@',
) or pod2usage(-verbose => 1, -exitval => 1);

$opts{help} and pod2usage(-verbose => 2, -exitval => 0);
if ($opts{version}) {
    print "sympa-6\n";
    exit;
54
55
}

56
57
58
59
60
61
62
63
# Initiliazing tags with defaults if necessary.
# Defaults stored separately because GetOptions append arguments to defaults.
# Building the string to insert into the regexp that will search strings to
# extract.
my $available_tags = join('|', @{$opts{t} || []}) || 'locdt|loc';

if ($opts{'files-from'}) {
    my $ifh;
64
    open $ifh, '<', $opts{'files-from'} or die "$opts{'files-from'}: $!\n";
65
66
67
    my @files = grep { /\S/ and !/\A\s*#/ } split /\r\n|\r|\n/,
        do { local $/; <$ifh> };
    my $cwd = Cwd::getcwd();
IKEDA Soji's avatar
IKEDA Soji committed
68
69
    if ($opts{directory}) {
        chdir $opts{directory} or die "$opts{directory}: $!\n";
70
    }
71
72
73
74
    @ARGV = map { (glob $_) } @files;
    chdir $cwd;
} elsif (not @ARGV) {
    @ARGV = ('-');
75
}
salaun's avatar
salaun committed
76

77
78
79
80
81
82
83
## Ordering files to present the most interresting strings to translate first.
my %files_to_parse;
foreach my $file_to_parse (@ARGV) {
    $files_to_parse{$file_to_parse} = 1;
}
my %favoured_files;
my @ordered_files;
84
85
86
87
88
89
90
91
92
93
my @planned_ordered_files = (
    "../web_tt2/help.tt2",       "../web_tt2/help_introduction.tt2",
    "../web_tt2/help_user.tt2",  "../web_tt2/help_admin.tt2",
    "../web_tt2/home.tt2",       "../web_tt2/login.tt2",
    "../web_tt2/main.tt2",       "../web_tt2/title.tt2",
    "../web_tt2/menu.tt2",       "../web_tt2/login_menu.tt2",
    "../web_tt2/your_lists.tt2", "../web_tt2/footer.tt2",
    "../web_tt2/list_menu.tt2",  "../web_tt2/list_panel.tt2",
    "../web_tt2/admin.tt2",      "../web_tt2/list_admin_menu.tt2"
);
94
95
foreach my $file (@planned_ordered_files) {
    if ($files_to_parse{$file}) {
96
        @ordered_files = (@ordered_files, $file);
97
98
    }
}
99
100
my @ordered_directories =
    ("../web_tt2", "../mail_tt2", "../src/etc/scenari", "../src/etc");
101
102
103
104
105
106
107

foreach my $file (@ordered_files) {
    $favoured_files{$file} = 1;
}
## Sorting by directories
foreach my $dir (@ordered_directories) {
    foreach my $file (@ARGV) {
108
109
110
111
112
113
        unless ($favoured_files{$file}) {
            if ($file =~ /^$dir/g) {
                @ordered_files = (@ordered_files, $file);
                $favoured_files{$file} = 1;
            }
        }
114
115
    }
}
116

117
118
## Sorting by files
foreach my $file (@ARGV) {
119
120
    unless ($favoured_files{$file}) {
        @ordered_files = (@ordered_files, $file);
121
122
123
    }
}

124
125
126
## Gathering strings in the source files.
## They will finally be stored into %file

127
my $cwd = Cwd::getcwd();
IKEDA Soji's avatar
IKEDA Soji committed
128
129
if ($opts{directory}) {
    chdir $opts{directory} or die "$opts{directory}: $!\n";
130
131
}

132
foreach my $file (@ordered_files) {
IKEDA Soji's avatar
IKEDA Soji committed
133
134
    next if $file =~ /\.po.?$/i;    # Don't parse po files

salaun's avatar
salaun committed
135
    my $filename = $file;
136
    printf STDOUT "Processing $file...\n";
sympa-authors's avatar
Fixes    
sympa-authors committed
137
    unless (-f $file) {
138
139
        print STDERR "Cannot open $file\n";
        next;
sympa-authors's avatar
Fixes    
sympa-authors committed
140
    }
141
142
143
144
145
146
147

    # cpanfile
    if ($file eq 'cpanfile') {
        CPANFile::load();
        next;
    }

148
149
150
    open my $fh, '<', $file or die "$file: $!\n";
    $_ = do { local $/; <$fh> };
    close $fh;
151
    $filename =~ s!^./!!;
152
    my $line;
salaun's avatar
salaun committed
153

154
    # Template Toolkit: [%|loc(...)%]...[%END%]
155
156
157
    $line = 1;
    pos($_) = 0;
    while (
158
        m!\G.*?\[%[-=~+]?\s*\|\s*($available_tags)(.*?)\s*[-=~+]?%\](.*?)\[%[-=~+]?\s*END\s*[-=~+]?%\]!sg
159
    ) {
160
161
        my ($this_tag, $vars, $str) = ($1, $2, $3);
        $line += (() = ($& =~ /\n/g));    # cryptocontext!
162
        $str =~ s/\\\'/\'/g;
163
164
        $vars =~ s/^\s*\(//;
        $vars =~ s/\)\s*$//;
IKEDA Soji's avatar
IKEDA Soji committed
165
166
167
168
169
170
171
172
173

        add_expression(
            {   expression => $str,
                filename   => $filename,
                line       => $line,
                vars       => $vars,
                (($this_tag eq 'locdt') ? (type => 'date') : ())
            }
        );
salaun's avatar
salaun committed
174
    }
175

176
    # Template Toolkit: [% "..." | loc(...) %]
177
    $line = 1;
178
    pos $_ = 0;
179
180
    while (
        m{
181
182
        \G .*?
        \[ % [-=~+]? \s*
IKEDA Soji's avatar
IKEDA Soji committed
183
        (?: \' ((?:\\.|[^'\\])*) \' | \" ((?:\\.|[^"\\])*) \" ) \s*
184
185
186
187
        \| \s*
        ($available_tags)
        (.*?)
        \s* [-=~+]? % \]
188
189
    }sgx
    ) {
190
191
192
193
194
195
196
197
198
199
200
201
202
        my $str      = $1 || $2;
        my $this_tag = $3;
        my $vars     = $4;

        $line += (() = ($& =~ /\n/g));
        $str =~ s{\\(.)}{
            ($1 eq 't') ? "\t" :
            ($1 eq 'n') ? "\n" :
            ($1 eq 'r') ? "\r" :
            $1
        }eg;
        $vars =~ s/^\s*[(](.*?)[)].*/$1/ or $vars = '';

IKEDA Soji's avatar
IKEDA Soji committed
203
204
205
206
207
208
209
210
        add_expression(
            {   expression => $str,
                filename   => $filename,
                line       => $line,
                vars       => $vars,
                (($this_tag eq 'locdt') ? (type => 'date') : ())
            }
        );
211
212
    }

213
214
    # Template Toolkit with ($tag$%|loc%$tag$)...($tag$%END%$tag$) in
    # mhonarc-ressources.tt2 (<=6.2.60; OBSOLETED)
215
216
217
    $line = 1;
    pos($_) = 0;
    while (
218
        m!\G.*?\(\$tag\$%\s*\|($available_tags)(.*?)\s*%\$tag\$\)(.*?)\(\$tag\$%[-=~+]?\s*END\s*[-=~+]?%\$tag\$\)!sg
219
    ) {
220
221
        my ($this_tag, $vars, $str) = ($1, $2, $3);
        $line += (() = ($& =~ /\n/g));    # cryptocontext!
222
        $str =~ s/\\\'/\'/g;
223
224
        $vars =~ s/^\s*\(//;
        $vars =~ s/\)\s*$//;
IKEDA Soji's avatar
IKEDA Soji committed
225
226
227
228
229
230
231
232
233

        add_expression(
            {   expression => $str,
                filename   => $filename,
                line       => $line,
                vars       => $vars,
                (($this_tag eq 'locdt') ? (type => 'date') : ())
            }
        );
234
235
    }

236
237
238
239
240
241
242
243
244
245
246
247
248
    # Template Toolkit with <%|loc%>...<%END%> in mhonarc_rc.tt2 (6.2.61b.1 or
    # later)
    if ($file eq 'default/mhonarc_rc.tt2') {
        $line = 1;
        pos($_) = 0;
        while (
            m!\G.*?<%\s*\|($available_tags)(.*?)\s*%>(.*?)<%[-=~+]?\s*END\s*[-=~+]?%>!sg
        ) {
            my ($this_tag, $vars, $str) = ($1, $2, $3);
            $line += (() = ($& =~ /\n/g));    # cryptocontext!
            $str =~ s/\\\'/\'/g;
            $vars =~ s/^\s*\(//;
            $vars =~ s/\)\s*$//;
IKEDA Soji's avatar
IKEDA Soji committed
249
250
251
252
253
254
255
256
257

            add_expression(
                {   expression => $str,
                    filename   => $filename,
                    line       => $line,
                    vars       => $vars,
                    (($this_tag eq 'locdt') ? (type => 'date') : ())
                }
            );
258
259
260
        }
    }

261
262
263
264
    # Sympa variables (gettext_comment, gettext_id and gettext_unit)
    $line = 1;
    pos($_) = 0;
    while (
265
        /\G.*?(\'?)(gettext_comment|gettext_id|gettext_unit)\1\s*=>\s*\"((\\.|[^\"])+)\"/sg
266
    ) {
267
268
        my $str = $3;
        $line += (() = ($& =~ /\n/g));    # cryptocontext!
269
        $str =~ s{(\\.)}{eval "\"$1\""}esg;
IKEDA Soji's avatar
IKEDA Soji committed
270
271
272
273
274

        add_expression(
            {   expression => $str,
                filename   => $filename,
                line       => $line
275
276
277
278
279
280
281
            }
        );
    }

    $line = 1;
    pos($_) = 0;
    while (
282
        /\G.*?(\'?)(gettext_comment|gettext_id|gettext_unit)\1\s*=>\s*\'((\\.|[^\'])+)\'/sg
283
    ) {
284
285
        my $str = $3;
        $line += (() = ($& =~ /\n/g));    # cryptocontext!
286
        $str =~ s{(\\.)}{eval "'$1'"}esg;
IKEDA Soji's avatar
IKEDA Soji committed
287
288
289
290
291

        add_expression(
            {   expression => $str,
                filename   => $filename,
                line       => $line
292
293
294
295
296
297
298
            }
        );
    }

    # Sympa scenarios variables (title.gettext)
    $line = 1;
    pos($_) = 0;
299
    while (/\G.*?title[.]gettext\s*([^\n]+)/sg) {
300
301
        my $str = $1;
        $line += (() = ($& =~ /\n/g));    # cryptocontext!
IKEDA Soji's avatar
IKEDA Soji committed
302
303
304
305
306

        add_expression(
            {   expression => $str,
                filename   => $filename,
                line       => $line
307
308
309
            }
        );
    }
salaun's avatar
salaun committed
310
311

    # Perl source file
IKEDA Soji's avatar
IKEDA Soji committed
312
313
314
315
    my $state = 0;
    my $str;
    my $vars;
    my $type;
sikeda's avatar
sikeda committed
316

salaun's avatar
salaun committed
317
318
    pos($_) = 0;
    my $orig = 1 + (() = ((my $__ = $_) =~ /\n/g));
319
PARSER: {
IKEDA Soji's avatar
IKEDA Soji committed
320
        $_ = substr $_, pos $_ if pos $_;
321
322
        my $line = $orig - (() = ((my $__ = $_) =~ /\n/g));
        # maketext or loc or _
IKEDA Soji's avatar
IKEDA Soji committed
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
        if ($state == NUL
            and m/\b(
                translate
              | gettext(?:_strftime|_sprintf)?
              | maketext
              | __?
              | loc
              | x
            )/cgx
        ) {
            if ($1 eq 'gettext_strftime') {
                $state = BEGM;
                $type  = 'date';
            } elsif ($1 eq 'gettext_sprintf') {
                $state = BEGM;
                $type  = 'printf';
339
            } else {
IKEDA Soji's avatar
IKEDA Soji committed
340
341
                $state = BEG;
                undef $type;
342
343
            }
            redo;
IKEDA Soji's avatar
IKEDA Soji committed
344
345
346
347
        }
        if (($state == BEG or $state == BEGM) and m/^([\s\t\n]*)/cg) {
            redo;
        }
348
        # begin ()
IKEDA Soji's avatar
IKEDA Soji committed
349
350
351
352
353
354
        if ($state == BEG and m/^([\S\(])/cg) {
            $state = ($1 eq '(') ? PAR : NUL;
            redo;
        }
        if ($state == BEGM and m/^([\(])/cg) {
            $state = PARM;
355
            redo;
IKEDA Soji's avatar
IKEDA Soji committed
356
        }
357
358

        # begin or end of string
IKEDA Soji's avatar
IKEDA Soji committed
359
360
361
362
363
364
365
366
367
368
369
370
        if ($state == PAR and m/^\s*(\')/cg) {
            $state = QUO1;
            redo;
        }
        if ($state == QUO1 and m/^([^\']+)/cg) {
            $str .= $1;
            redo;
        }
        if ($state == QUO1 and m/^\'/cg) {
            $state = PAR;
            redo;
        }
371

IKEDA Soji's avatar
IKEDA Soji committed
372
373
374
375
376
377
378
379
380
381
382
383
        if ($state == PAR and m/^\s*\"/cg) {
            $state = QUO2;
            redo;
        }
        if ($state == QUO2 and m/^([^\"]+)/cg) {
            $str .= $1;
            redo;
        }
        if ($state == QUO2 and m/^\"/cg) {
            $state = PAR;
            redo;
        }
384

IKEDA Soji's avatar
IKEDA Soji committed
385
386
387
388
389
390
391
392
393
394
395
396
        if ($state == PAR and m/^\s*\`/cg) {
            $state = QUO3;
            redo;
        }
        if ($state == QUO3 and m/^([^\`]*)/cg) {
            $str .= $1;
            redo;
        }
        if ($state == QUO3 and m/^\`/cg) {
            $state = PAR;
            redo;
        }
397

IKEDA Soji's avatar
IKEDA Soji committed
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
        if ($state == BEGM and m/^(\')/cg) {
            $state = QUOM1;
            redo;
        }
        if ($state == PARM and m/^\s*(\')/cg) {
            $state = QUOM1;
            redo;
        }
        if ($state == QUOM1 and m/^([^\']+)/cg) {
            $str .= $1;
            redo;
        }
        if ($state == QUOM1 and m/^\'/cg) {
            $state = COMM;
            redo;
        }
414

IKEDA Soji's avatar
IKEDA Soji committed
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
        if ($state == BEGM and m/^(\")/cg) {
            $state = QUOM2;
            redo;
        }
        if ($state == PARM and m/^\s*(\")/cg) {
            $state = QUOM2;
            redo;
        }
        if ($state == QUOM2 and m/^([^\"]+)/cg) {
            $str .= $1;
            redo;
        }
        if ($state == QUOM2 and m/^\"/cg) {
            $state = COMM;
            redo;
        }
431

IKEDA Soji's avatar
IKEDA Soji committed
432
433
434
435
        if ($state == BEGM) {
            $state = NUL;
            redo;
        }
436
437

        # end ()
IKEDA Soji's avatar
IKEDA Soji committed
438
439
440
        if (   ($state == PAR and m/^\s*[\)]/cg)
            or ($state == PARM and m/^\s*[\)]/cg)
            or ($state == COMM and m/^\s*,/cg)) {
441
            $state = NUL;
IKEDA Soji's avatar
IKEDA Soji committed
442
443
444
445
446
447
448
449
450
451
            $vars =~ s/[\n\r]//g if $vars;

            add_expression(
                {   expression => $str,
                    filename   => $filename,
                    line       => $line - (() = $str =~ /\n/g),
                    vars       => $vars,
                    ($type ? (type => $type) : ())
                }
            ) if $str;
452
453
454
            undef $str;
            undef $vars;
            redo;
IKEDA Soji's avatar
IKEDA Soji committed
455
        }
456
457

        # a line of vars
IKEDA Soji's avatar
IKEDA Soji committed
458
459
460
461
462
463
464
465
        if ($state == PAR and m/^([^\)]*)/cg) {
            $vars .= $1 . "\n";
            redo;
        }
        if ($state == PARM and m/^([^\)]*)/cg) {
            $vars .= $1 . "\n";
            redo;
        }
466
467
468
    }

    unless ($state == NUL) {
469
470
471
        my $post = $_;
        $post =~ s/\A(\s*.*\n.*\n.*)\n(.|\n)+\z/$1\n.../;
        warn sprintf "Warning: incomplete state just before ---\n%s\n", $post;
salaun's avatar
salaun committed
472
473
474
    }
}

475
476
chdir $cwd;

477
478
## Transfers all data from %file to %Lexicon, removing duplicates in the
## process.
479
480
481
482
my $index = 0;
my @ordered_bis;
my %ordered_hash;
foreach my $str (@ordered_strings) {
483
    my $ostr  = $str;
salaun's avatar
salaun committed
484
    my $entry = $file{$str};
485
    my $lexi  = $Lexicon{$ostr} // '';
salaun's avatar
salaun committed
486

sympa-authors's avatar
sympa-authors committed
487
    ## Skip meta information (specific to Sympa)
IKEDA Soji's avatar
IKEDA Soji committed
488
    next if $str =~ /^_\w+\_$/;
sympa-authors's avatar
sympa-authors committed
489

490
    $str =~ s/"/\\"/g;
salaun's avatar
salaun committed
491
    $lexi =~ s/\\/\\\\/g;
492
    $lexi =~ s/"/\\"/g;
salaun's avatar
salaun committed
493

494
495
496
497
    unless ($ordered_hash{$str}) {
        $ordered_bis[$index] = $str;
        $index++;
        $ordered_hash{$str} = 1;
498
    }
salaun's avatar
salaun committed
499
500
501
502
    $Lexicon{$str} ||= '';
    next if $ostr eq $str;

    $Lexicon{$str} ||= $lexi;
503
504
505
    unless ($file{$str}) { $file{$str} = $entry; }
    delete $file{$ostr};
    delete $Lexicon{$ostr};
salaun's avatar
salaun committed
506
507
508
}
exit unless %Lexicon;

509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
my $output_file =
       $opts{output}
    || ($opts{'default-domain'} and $opts{'default-domain'} . '.pot')
    || "messages.po";

my $out;
my $pot;
if (-r $output_file) {
    open $pot, '+<', $output_file or die "$output_file: $!\n";
    while (<$pot>) {
        if (1 .. /^$/) { $out .= $_; next }
        last;
    }

    1 while chomp $out;

    seek $pot, 0, 0;
    truncate $pot, 0;
} else {
    open $pot, '>', $output_file or die "$output_file: $!\n";
}
select $pot;

salaun's avatar
salaun committed
532
533
534
535
536
537
538
539
540
541
print $out ? "$out\n" : (<< '.');
# SOME DESCRIPTIVE TITLE.
# Copyright (C) YEAR THE PACKAGE'S COPYRIGHT HOLDER
# This file is distributed under the same license as the PACKAGE package.
# FIRST AUTHOR <EMAIL@ADDRESS>, YEAR.
#
#, fuzzy
msgid ""
msgstr ""
"Project-Id-Version: PACKAGE VERSION\n"
542
"Report-Msgid-Bugs-To: \n"
salaun's avatar
salaun committed
543
544
545
546
"POT-Creation-Date: 2002-07-16 17:27+0800\n"
"PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n"
"Last-Translator: FULL NAME <EMAIL@ADDRESS>\n"
"Language-Team: LANGUAGE <LL@li.org>\n"
547
"Language: \n"
salaun's avatar
salaun committed
548
549
550
551
552
"MIME-Version: 1.0\n"
"Content-Type: text/plain; charset=CHARSET\n"
"Content-Transfer-Encoding: 8bit\n"
.

553
foreach my $entry (@ordered_bis) {
554
    my %f = (map { ("$_->[0]:$_->[1]" => 1) } @{$file{$entry}});
salaun's avatar
salaun committed
555
556
557
558
559
560
561
    my $f = join(' ', sort keys %f);
    $f = " $f" if length $f;

    my $nospace = $entry;
    $nospace =~ s/ +$//;

    if (!$Lexicon{$entry} and $Lexicon{$nospace}) {
562
563
        $Lexicon{$entry} =
            $Lexicon{$nospace} . (' ' x (length($entry) - length($nospace)));
salaun's avatar
salaun committed
564
565
566
    }

    my %seen;
567
568

    ## Print code/templates references
salaun's avatar
salaun committed
569
    print "\n#:$f\n";
570
571

    ## Print variables if any
572
573
574
575
576
    foreach my $entry (grep { $_->[2] } @{$file{$entry}}) {
        my ($file, $line, $var) = @{$entry};
        $var =~ s/^\s*,\s*//;
        $var =~ s/\s*$//;
        print "#. ($var)\n" unless !length($var) or $seen{$var}++;
salaun's avatar
salaun committed
577
578
    }

579
580
    ## If the entry is a date format, add a developper comment to help
    ## translators
581
    if ($type_of_entries{$entry} and $type_of_entries{$entry} eq 'date') {
582
583
584
        print "#. This entry is a date/time format\n";
        print
            "#. Check the strftime manpage for format details : http://docs.freebsd.org/info/gawk/gawk.info.Time_Functions.html\n";
585
586
    } elsif ($type_of_entries{$entry}
        and $type_of_entries{$entry} eq 'printf') {
587
588
589
        print "#. This entry is a sprintf format\n";
        print
            "#. Check the sprintf manpage for format details : http://perldoc.perl.org/functions/sprintf.html\n";
590
591
    }

592
593
594
595
    print "msgid ";
    output($entry);
    print "msgstr ";
    output($Lexicon{$entry});
salaun's avatar
salaun committed
596
597
}

598
599
600
601
## Add expressions to list of expressions to translate
## parameters : expression, filename, line, vars
sub add_expression {
    my $param = shift;
602

IKEDA Soji's avatar
IKEDA Soji committed
603
604
605
606
607
    @ordered_strings = (@ordered_strings, $param->{expression});
    push @{$file{$param->{expression}}},
        [$param->{filename}, $param->{line}, $param->{vars}];
    $type_of_entries{$param->{expression}} = $param->{type}
        if $param->{type};
608
609
610

}

salaun's avatar
salaun committed
611
sub output {
612
    my $str = shift // '';
salaun's avatar
salaun committed
613

614
615
616
    ## Normalize
    $str =~ s/\\n/\n/g;

salaun's avatar
salaun committed
617
    if ($str =~ /\n/) {
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
        print "\"\"\n";

        ## Avoid additional \n entries
        my @lines = split(/\n/, $str, -1);
        my @output_lines;

        ## Move empty lines to previous line as \n
        my $current_line;
        foreach my $i (0 .. $#lines) {
            if ($lines[$i] eq '') {
                if ($#output_lines < 0) {
                    $current_line .= '\n';
                    next;
                } else {
                    $output_lines[$#output_lines] .= '\n';
                    next;
                }
            } else {
                $current_line .= $lines[$i];
            }
            push @output_lines, $current_line;
            $current_line = '';
        }

        ## Add \n unless
        foreach my $i (0 .. $#output_lines) {
            if ($i == $#output_lines) {
                ## No additional \n
                print "\"$output_lines[$i]\"\n";
            } else {
                print "\"$output_lines[$i]\\n\"\n";
            }
        }

    } else {
        print "\"$str\"\n";
salaun's avatar
salaun committed
654
655
656
657
658
659
660
661
662
    }
}

sub escape {
    my $text = shift;
    $text =~ s/\b_(\d+)/%$1/;
    return $text;
}

663
664
665
666
## Dump a variable's content
sub dump_var {
    my ($var, $level, $fd) = @_;

IKEDA Soji's avatar
IKEDA Soji committed
667
    return undef unless $fd;
668
669

    if (ref($var)) {
670
671
672
        if (ref($var) eq 'ARRAY') {
            foreach my $index (0 .. $#{$var}) {
                print $fd "\t" x $level . $index . "\n";
IKEDA Soji's avatar
IKEDA Soji committed
673
                dump_var($var->[$index], $level + 1, $fd);
674
675
676
677
678
679
            }
        } elsif (ref($var) eq 'HASH'
            || ref($var) eq 'Scenario'
            || ref($var) eq 'List') {
            foreach my $key (sort keys %{$var}) {
                print $fd "\t" x $level . '_' . $key . '_' . "\n";
IKEDA Soji's avatar
IKEDA Soji committed
680
                dump_var($var->{$key}, $level + 1, $fd);
681
682
683
684
685
686
687
688
689
690
            }
        } else {
            printf $fd "\t" x $level . "'%s'" . "\n", ref($var);
        }
    } else {
        if (defined $var) {
            print $fd "\t" x $level . "'$var'" . "\n";
        } else {
            print $fd "\t" x $level . "UNDEF\n";
        }
691
692
693
    }
}

694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
package CPANFile;

use strict;
use warnings;
use lib qw(.);

my @entries;

sub feature {
    push @entries,
        {
        expression => $_[1],
        filename   => 'cpanfile',
        line       => [caller]->[2],
        };
}
sub on         { $_[1]->() }
sub recommends { }
sub requires   { }

sub load {
    do 'cpanfile';
    die unless @entries;
    foreach my $entry (@entries) {
        main::add_expression($entry);
    }
}

salaun's avatar
salaun committed
722
1;
723
724
725
__END__

=encoding utf-8
salaun's avatar
salaun committed
726

727
728
729
730
731
732
733
734
735
736
737
738
739
=head1 NAME

xgettext.pl - Extract gettext strings from Sympa source

=head1 SYNOPSIS

  xgettext.pl [ options ... ] [ inputfile ... ]

=head1 OPTIONS

=over

=item C<--default-domain> I<domain>, C<-d>I<domain>
salaun's avatar
salaun committed
740

741
742
743
Specifies domain.
If this option is specified but output file is not specified
(see C<--output>), C<I<domain>.pot> is used.
salaun's avatar
salaun committed
744

745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
=item C<--directory> I<path>, C<-D>I<path>

Specifies directory to search input files.

=item C<--files-from> I<path>, C<-f>I<path>

Get list of input files from the file.

=item C<-g>

B<Deprecated>.
Enables GNU gettext interoperability by printing C<#, maketext-format>
before each entry that has C<%> variables.

=item C<--help>, C<-h>

Shows this documentation and exits.

=item C<--output> I<outputfile>, C<-o>I<outputfile>

POT file name to be written or incrementally
updated C<-> means writing to F<STDOUT>.  If neither this option nor
C<--default-domain> option specified,
F<messages.po> is used.

=item C<-t>I<tag1> ...

Specifies which tag(s) must be used to extract Template Toolkit strings.
Default is C<loc> and C<locdt>.
Can be specified multiple times.

=item C<-u>

B<Deprecated>.
Disables conversion from Maketext format to Gettext
format -- i.e. it leaves all brackets alone.  This is useful if you are
also using the Gettext syntax in your program.

=item C<--version>, C<-v>

Prints "C<sympa-6>" and newline, and then exits.

=item C<--add-comments> [ I<tag> ] , C<-c>[ I<tag> ]

=item C<--copyright-holder> I<string>

=item C<--keyword> [ I<word> ], C<-k>[ I<word> ], ...

=item C<--msgid-bugs-address> I<address>

=item C<--package-name> I<name>

=item C<--package-version> I<version>

These options will do nothing.
They are prepared for compatibility to xgettext of GNU gettext.

=back

I<inputfile>... is the files to extract messages from, if C<--files-from>
option is not specified.

=head1 DESCRIPTION

This program extracts translatable strings from given input files, or
STDIN if none are given.

Currently the following formats of input files are supported:

=over

=item Perl source files

Valid localization function names are:
C<gettext>, C<gettext_sprintf> C<gettext_strftime>,
C<maketext>, C<translate>, C<loc> C<x>, C<_> and C<__>.
Hash keys C<gettext_comment>, C<gettext_id> and C<gettext_unit>
are also recognized.

=item Template Toolkit

Texts inside C<[%|loc%]...[%END%]> or C<[%|locdt%]...[%END%]>
are extracted, unless specified otherwise by C<-t> option.

The alternative format C<[%...|loc%]> is also recognized.

=item Scenario sources

Text content of C<title.gettext> line.

=back
salaun's avatar
salaun committed
836
837
838

=head1 SEE ALSO

839
840
841
842
843
844
845
846
847
848
849
L<Sympa::Language>, L<Sympa::Template>.

=head1 HISTORY

This script was initially based on F<xgettext.pl>
by Autrijus Tang E<lt>autrijus@autrijus.orgE<gt>
which was bundled in L<Locale-Maketext-Lexicon>.
Afterward, it has been drastically rewritten to be adopted to Sympa
and original code hardly remains.

Part of changes are as following:
salaun's avatar
salaun committed
850

851
=over
salaun's avatar
salaun committed
852

853
=item [O. Salaun] 12/08/02 :
salaun's avatar
salaun committed
854

855
856
857
858
Also look for gettext() in perl code.
No more escape '\' chars.
Extract gettext_comment, gettext_id and gettext_unit entries from List.pm.
Extract title.gettext entries from scenarios.
salaun's avatar
salaun committed
859

860
=item [D. Verdin] 05/11/2007 :
salaun's avatar
salaun committed
861

862
863
864
865
Strings ordered following the order in which files are read and
the order in which they appear in the files.
Switch to Getopt::Long to allow multiple value parameter.
Added 't' parameter the specifies which tags to explore in TT2.
salaun's avatar
salaun committed
866

867
=back
salaun's avatar
salaun committed
868
869

=cut