Skip to content
GitLab
Commit d8eaa041 authored by IKEDA Soji's avatar IKEDA Soji
Browse files

Refactoring.

parent 07f890a8
Show whitespace changes
Inline Side-by-side
support/xgettext.pl
View file @ d8eaa041
......@@ -5,6 +5,7 @@
use strict;
use warnings;
use Cwd qw();
use English; # FIXME: Avoid $MATCH usage
use Getopt::Long;
use Pod::Usage;
......@@ -29,11 +30,6 @@ my %type_of_entries;
my %Lexicon;
## All the strings, in the order they were found while parsing the files
my @ordered_strings = ();
## One occurence of each string, in the order they were found while parsing
## the files
my @unique_keys = ();
## A hash used for control when filling @unique_keys
my %unique_keys;
## Retrieving options.
my %opts;
......@@ -53,20 +49,16 @@ if ($opts{version}) {
exit;
}
# 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;
open $ifh, '<', $opts{'files-from'} or die "$opts{'files-from'}: $!\n";
open $ifh, '<', $opts{'files-from'}
or die sprintf "%s: %s\n", $opts{'files-from'}, $ERRNO;
my @files = grep { /\S/ and !/\A\s*#/ } split /\r\n|\r|\n/,
do { local $/; <$ifh> };
do { local $RS; <$ifh> };
my $cwd = Cwd::getcwd();
if ($opts{directory}) {
chdir $opts{directory} or die "$opts{directory}: $!\n";
chdir $opts{directory}
or die sprintf "%s: %s\n", $opts{directory}, $ERRNO;
}
@ARGV = map { (glob $_) } @files;
chdir $cwd;
......@@ -79,16 +71,16 @@ if ($opts{'files-from'}) {
my $cwd = Cwd::getcwd();
if ($opts{directory}) {
chdir $opts{directory} or die "$opts{directory}: $!\n";
chdir $opts{directory}
or die sprintf "%s: %s\n", $opts{directory}, $ERRNO;
}
foreach my $file (@ARGV) {
next if $file =~ /\.po.?$/i; # Don't parse po files
next if $file =~ m{ [.] po.? \z }ix; # Don't parse po files
my $filename = $file;
printf STDOUT "Processing $file...\n";
printf STDOUT "Processing %s...\n", $file;
unless (-f $file) {
print STDERR "Cannot open $file\n";
printf STDERR "Cannot open %s\n", $file;
next;
}
......@@ -98,53 +90,230 @@ foreach my $file (@ARGV) {
next;
}
open my $fh, '<', $file or die "$file: $!\n";
$_ = do { local $/; <$fh> };
open my $fh, '<', $file or die sprintf "%s: %s\n", $file, $ERRNO;
$_ = do { local $RS; <$fh> };
close $fh;
$filename =~ s!^./!!;
my $line;
# Template Toolkit: [%|loc(...)%]...[%END%]
$line = 1;
pos($_) = 0;
while (
m!\G.*?\[%[-=~+]?\s*\|\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*$//;
if ($file =~ m{ [.] (pm | pl | fcgi) ([.]in)? \z }x) {
load_perl($file, $_);
}
add_expression(
{ expression => $str,
filename => $filename,
line => $line,
vars => $vars,
(($this_tag eq 'locdt') ? (type => 'date') : ())
if ($file =~ m{ [.] tt2 \z }x) {
load_tt2($file, $_, $opts{t});
}
);
if ($file =~ m{ / scenari / | [.] task \z | / comment [.] tt2 \z }x) {
load_title($file, $_);
}
}
chdir $cwd;
## Transfers all data from %file to %Lexicon, removing duplicates in the
## process.
my $index = 0;
my @ordered_bis;
my %ordered_hash;
foreach my $str (@ordered_strings) {
my $ostr = $str;
my $entry = $file{$str};
my $lexi = $Lexicon{$ostr} // '';
## Skip meta information (specific to Sympa)
next if $str =~ /^_\w+\_$/;
$str =~ s/"/\\"/g;
$lexi =~ s/\\/\\\\/g;
$lexi =~ s/"/\\"/g;
unless ($ordered_hash{$str}) {
$ordered_bis[$index] = $str;
$index++;
$ordered_hash{$str} = 1;
}
$Lexicon{$str} ||= '';
next if $ostr eq $str;
$Lexicon{$str} ||= $lexi;
unless ($file{$str}) { $file{$str} = $entry; }
delete $file{$ostr};
delete $Lexicon{$ostr};
}
exit unless %Lexicon;
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 sprintf "%s: %s\n", $output_file, $ERRNO;
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 sprintf "%s: %s\n", $output_file, $ERRNO;
}
select $pot;
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"
"Report-Msgid-Bugs-To: \n"
"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"
"Language: \n"
"MIME-Version: 1.0\n"
"Content-Type: text/plain; charset=CHARSET\n"
"Content-Transfer-Encoding: 8bit\n"
.
foreach my $entry (@ordered_bis) {
my %f = (map { ("$_->[0]:$_->[1]" => 1) } @{$file{$entry}});
my $f = join(' ', sort keys %f);
$f = " $f" if length $f;
my $nospace = $entry;
$nospace =~ s/ +$//;
if (!$Lexicon{$entry} and $Lexicon{$nospace}) {
$Lexicon{$entry} =
$Lexicon{$nospace} . (' ' x (length($entry) - length($nospace)));
}
my %seen;
## Print code/templates references
print "\n#:$f\n";
## Print variables if any
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}++;
}
## If the entry is a date format, add a developper comment to help
## translators
if ($type_of_entries{$entry} and $type_of_entries{$entry} eq 'date') {
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";
} elsif ($type_of_entries{$entry}
and $type_of_entries{$entry} eq 'printf') {
print "#. This entry is a sprintf format\n";
print
"#. Check the sprintf manpage for format details : http://perldoc.perl.org/functions/sprintf.html\n";
}
print "msgid ";
output($entry);
print "msgstr ";
output($Lexicon{$entry});
}
## Add expressions to list of expressions to translate
## parameters : expression, filename, line, vars
sub add_expression {
my $param = shift;
push @ordered_strings, $param->{expression};
push @{$file{$param->{expression}}},
[$param->{filename}, $param->{line}, $param->{vars}];
$type_of_entries{$param->{expression}} = $param->{type}
if $param->{type};
}
sub load_tt2 {
my $filename = shift;
my $_ = shift;
my $filters = shift;
# Initiliazing filter names 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 $tt2_filters = join('|', @{$filters || []}) || 'locdt|loc';
my ($tag_s, $tag_e);
if ($filename eq 'default/mhonarc-ressources.tt2') {
# Template Toolkit with ($tag$%...%$tag$) in mhonarc-ressources.tt2
# (<=6.2.60; OBSOLETED)
($tag_s, $tag_e) = (qr{[(]\$tag\$%}, qr{%\$tag\$[)]});
} elsif ($filename eq 'default/mhonarc_rc.tt2') {
# Template Toolkit with <%...%> in mhonarc_rc.tt2 (6.2.61b.1 or later)
($tag_s, $tag_e) = (qr{<%}, qr{%>});
} elsif ($filename =~ /[.]tt2\z/) {
# Template Toolkit with [%...%]
($tag_s, $tag_e) = (qr{[[]%}, qr{%[]]});
} else {
die 'bug in logic. Ask developer';
}
my $line;
# Template Toolkit: [% "..." | loc(...) %]
$line = 1;
pos $_ = 0;
pos($_) = 0;
while (
m{
\G .*?
\[ % [-=~+]? \s*
(?: \' ((?:\\.|[^'\\])*) \' | \" ((?:\\.|[^"\\])*) \" ) \s*
(?:
# Short style: [% "..." | loc(...) %]
$tag_s [-=~+]? \s*
(?:
\'
((?: \\. | [^'\\])*)
\'
|
\"
((?: \\. | [^"\\])*)
\"
) \s*
\| \s*
($tt2_filters)
(.*?)
\s* [-=~+]? $tag_e
|
# Enclosing style: [%|loc(...)%]...[%END%]
$tag_s [-=~+]? \s*
\| \s*
($available_tags)
($tt2_filters)
(.*?)
\s* [-=~+]? % \]
}sgx
\s* [-=~+]? $tag_e
(.*?)
$tag_s [-=~+]? \s*
END
\s* [-=~+]? $tag_e
)
}gsx
) {
my $str = $1 || $2;
my $this_tag = $3;
my $vars = $4;
$line += (() = ($& =~ /\n/g));
my $is_short = $3;
my ($this_tag, $vars, $str) =
$is_short ? ($3, $4, $1 // $2) : ($5, $6, $7);
$line += (() = ($MATCH =~ /\n/g)); # cryptocontext!
if ($is_short) {
$str =~ s{\\(.)}{
($1 eq 't') ? "\t" :
($1 eq 'n') ? "\n" :
......@@ -152,53 +321,11 @@ foreach my $file (@ARGV) {
$1
}eg;
$vars =~ s/^\s*[(](.*?)[)].*/$1/ or $vars = '';
add_expression(
{ expression => $str,
filename => $filename,
line => $line,
vars => $vars,
(($this_tag eq 'locdt') ? (type => 'date') : ())
}
);
}
# Template Toolkit with ($tag$%|loc%$tag$)...($tag$%END%$tag$) in
# mhonarc-ressources.tt2 (<=6.2.60; OBSOLETED)
$line = 1;
pos($_) = 0;
while (
m!\G.*?\(\$tag\$%\s*\|($available_tags)(.*?)\s*%\$tag\$\)(.*?)\(\$tag\$%[-=~+]?\s*END\s*[-=~+]?%\$tag\$\)!sg
) {
my ($this_tag, $vars, $str) = ($1, $2, $3);
$line += (() = ($& =~ /\n/g)); # cryptocontext!
} else {
$str =~ s/\\\'/\'/g;
$vars =~ s/^\s*\(//;
$vars =~ s/\)\s*$//;
add_expression(
{ expression => $str,
filename => $filename,
line => $line,
vars => $vars,
(($this_tag eq 'locdt') ? (type => 'date') : ())
}
);
}
# 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*$//;
add_expression(
{ expression => $str,
......@@ -209,49 +336,33 @@ foreach my $file (@ARGV) {
}
);
}
}
}
# Sympa variables (gettext_comment, gettext_id and gettext_unit)
$line = 1;
pos($_) = 0;
while (
/\G.*?(\'?)(gettext_comment|gettext_id|gettext_unit)\1\s*=>\s*\"((\\.|[^\"])+)\"/sg
) {
my $str = $3;
$line += (() = ($& =~ /\n/g)); # cryptocontext!
$str =~ s{(\\.)}{eval "\"$1\""}esg;
sub load_perl {
my $filename = shift;
my $_ = shift;
add_expression(
{ expression => $str,
filename => $filename,
line => $line
}
);
}
my $line;
# Sympa variables (gettext_comment, gettext_id and gettext_unit)
$line = 1;
pos($_) = 0;
while (
/\G.*?(\'?)(gettext_comment|gettext_id|gettext_unit)\1\s*=>\s*\'((\\.|[^\'])+)\'/sg
m{
\G .*?
([\"\']?)
(gettext_comment | gettext_id | gettext_unit)
\1
\s* => \s*
(?:
(\") ((?: \\. | [^\"])+) \"
| (\') ((?: \\. | [^\'])+) \'
)
}gsx
) {
my $str = $3;
$line += (() = ($& =~ /\n/g)); # cryptocontext!
$str =~ s{(\\.)}{eval "'$1'"}esg;
add_expression(
{ expression => $str,
filename => $filename,
line => $line
}
);
}
# Sympa scenarios variables (title.gettext)
$line = 1;
pos($_) = 0;
while (/\G.*?title[.]gettext\s*([^\n]+)/sg) {
my $str = $1;
$line += (() = ($& =~ /\n/g)); # cryptocontext!
my ($quot, $str) = ($3 // $5, $4 // $6);
$line += (() = ($MATCH =~ /\n/g)); # cryptocontext!
$str =~ s{(\\.)}{eval "$quot$1$quot"}esg;
add_expression(
{ expression => $str,
......@@ -262,7 +373,6 @@ foreach my $file (@ARGV) {
}
# Perl source file
if ($file =~ /[.](pm|pl|fcgi)([.]in)?\z/) {
my $state = 0;
my $str;
my $vars;
......@@ -270,7 +380,7 @@ foreach my $file (@ARGV) {
pos($_) = 0;
my $orig = 1 + (() = ((my $__ = $_) =~ /\n/g));
PARSER: {
PARSER: {
$_ = substr $_, pos $_ if pos $_;
my $line = $orig - (() = ((my $__ = $_) =~ /\n/g));
# maketext or loc or _
......@@ -422,146 +532,36 @@ foreach my $file (@ARGV) {
unless ($state == NUL) {
my $post = $_;
$post =~ s/\A(\s*.*\n.*\n.*)\n(.|\n)+\z/$1\n.../;
warn sprintf "Warning: incomplete state just before ---\n%s\n",
$post;
}
}
}
chdir $cwd;
## Transfers all data from %file to %Lexicon, removing duplicates in the
## process.
my $index = 0;
my @ordered_bis;
my %ordered_hash;
foreach my $str (@ordered_strings) {
my $ostr = $str;
my $entry = $file{$str};
my $lexi = $Lexicon{$ostr} // '';
## Skip meta information (specific to Sympa)
next if $str =~ /^_\w+\_$/;
$str =~ s/"/\\"/g;
$lexi =~ s/\\/\\\\/g;
$lexi =~ s/"/\\"/g;
unless ($ordered_hash{$str}) {
$ordered_bis[$index] = $str;
$index++;
$ordered_hash{$str} = 1;
}
$Lexicon{$str} ||= '';
next if $ostr eq $str;
$Lexicon{$str} ||= $lexi;
unless ($file{$str}) { $file{$str} = $entry; }
delete $file{$ostr};
delete $Lexicon{$ostr};
}
exit unless %Lexicon;
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;
warn sprintf "Warning: incomplete state just before ---\n%s\n", $post;
}
1 while chomp $out;
seek $pot, 0, 0;
truncate $pot, 0;
} else {
open $pot, '>', $output_file or die "$output_file: $!\n";
}
select $pot;
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"
"Report-Msgid-Bugs-To: \n"
"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"
"Language: \n"
"MIME-Version: 1.0\n"
"Content-Type: text/plain; charset=CHARSET\n"
"Content-Transfer-Encoding: 8bit\n"
.
foreach my $entry (@ordered_bis) {
my %f = (map { ("$_->[0]:$_->[1]" => 1) } @{$file{$entry}});
my $f = join(' ', sort keys %f);
$f = " $f" if length $f;
my $nospace = $entry;
$nospace =~ s/ +$//;
sub load_title {
my $filename = shift;
my $_ = shift;
if (!$Lexicon{$entry} and $Lexicon{$nospace}) {
$Lexicon{$entry} =
$Lexicon{$nospace} . (' ' x (length($entry) - length($nospace)));
}
my %seen;
my $line;
## Print code/templates references
print "\n#:$f\n";
# Titles in scenarios, tasks and comment.tt2 (title.gettext)
$line = 1;
pos($_) = 0;
while (
m{
\G .*?
title [.] gettext \s*
([^\n]+)
}gsx
) {
my $str = $1;
$line += (() = ($MATCH =~ /\n/g)); # cryptocontext!
## Print variables if any
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}++;
add_expression(
{ expression => $str,
filename => $filename,
line => $line
}
## If the entry is a date format, add a developper comment to help
## translators
if ($type_of_entries{$entry} and $type_of_entries{$entry} eq 'date') {
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";
} elsif ($type_of_entries{$entry}
and $type_of_entries{$entry} eq 'printf') {
print "#. This entry is a sprintf format\n";
print
"#. Check the sprintf manpage for format details : http://perldoc.perl.org/functions/sprintf.html\n";
);
}
print "msgid ";