Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in
Toggle navigation
Menu
Open sidebar
Projets publics
Sympa
Commits
d8eaa041
Commit
d8eaa041
authored
Apr 11, 2021
by
IKEDA Soji
Browse files
Refactoring.
parent
07f890a8
Changes
1
Hide 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
"
;
print
f
STDERR
"
Cannot open
%s
\n
",
$file
;
next
;
}
...
...
@@ -98,333 +90,20 @@ 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*$//
;
add_expression
(
{
expression
=>
$str
,
filename
=>
$filename
,
line
=>
$line
,
vars
=>
$vars
,
((
$this_tag
eq
'
locdt
')
?
(
type
=>
'
date
')
:
())
}
);
}
# Template Toolkit: [% "..." | loc(...) %]
$line
=
1
;
pos
$_
=
0
;
while
(
m{
\G .*?
\[ % [-=~+]? \s*
(?: \' ((?:\\.|[^'\\])*) \' | \" ((?:\\.|[^"\\])*) \" ) \s*
\| \s*
($available_tags)
(.*?)
\s* [-=~+]? % \]
}sgx
)
{
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
=
'';
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!
$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
,
filename
=>
$filename
,
line
=>
$line
,
vars
=>
$vars
,
((
$this_tag
eq
'
locdt
')
?
(
type
=>
'
date
')
:
())
}
);
}
}
# 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
;
add_expression
(
{
expression
=>
$str
,
filename
=>
$filename
,
line
=>
$line
}
);
if
(
$file
=~
m{ [.] (pm | pl | fcgi) ([.]in)? \z }x
)
{
load_perl
(
$file
,
$_
);
}
$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
;
add_expression
(
{
expression
=>
$str
,
filename
=>
$filename
,
line
=>
$line
}
);
if
(
$file
=~
m{ [.] tt2 \z }x
)
{
load_tt2
(
$file
,
$_
,
$opts
{
t
});
}
# Sympa scenarios variables (title.gettext)
$line
=
1
;
pos
(
$_
)
=
0
;
while
(
/\G.*?title[.]gettext\s*([^\n]+)/sg
)
{
my
$str
=
$
1
;
$line
+=
(()
=
(
$&
=~
/\n/g
));
# cryptocontext!
add_expression
(
{
expression
=>
$str
,
filename
=>
$filename
,
line
=>
$line
}
);
}
# Perl source file
if
(
$file
=~
/[.](pm|pl|fcgi)([.]in)?\z/
)
{
my
$state
=
0
;
my
$str
;
my
$vars
;
my
$type
;
pos
(
$_
)
=
0
;
my
$orig
=
1
+
(()
=
((
my
$
__
=
$_
)
=~
/\n/g
));
PARSER:
{
$_
=
substr
$_
,
pos
$_
if
pos
$_
;
my
$line
=
$orig
-
(()
=
((
my
$
__
=
$_
)
=~
/\n/g
));
# maketext or loc or _
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
';
}
else
{
$state
=
BEG
;
undef
$type
;
}
redo
;
}
if
((
$state
==
BEG
or
$state
==
BEGM
)
and
m/^([\s\t\n]*)/cg
)
{
redo
;
}
# begin ()
if
(
$state
==
BEG
and
m/^([\S\(])/cg
)
{
$state
=
(
$
1
eq
'
(
')
?
PAR
:
NUL
;
redo
;
}
if
(
$state
==
BEGM
and
m/^([\(])/cg
)
{
$state
=
PARM
;
redo
;
}
# begin or end of string
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
;
}
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
;
}
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
;
}
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
;
}
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
;
}
if
(
$state
==
BEGM
)
{
$state
=
NUL
;
redo
;
}
# end ()
if
(
(
$state
==
PAR
and
m/^\s*[\)]/cg
)
or
(
$state
==
PARM
and
m/^\s*[\)]/cg
)
or
(
$state
==
COMM
and
m/^\s*,/cg
))
{
$state
=
NUL
;
$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
;
undef
$str
;
undef
$vars
;
redo
;
}
# a line of vars
if
(
$state
==
PAR
and
m/^([^\)]*)/cg
)
{
$vars
.=
$
1
.
"
\n
";
redo
;
}
if
(
$state
==
PARM
and
m/^([^\)]*)/cg
)
{
$vars
.=
$
1
.
"
\n
";
redo
;
}
}
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
;
}
if
(
$file
=~
m{ / scenari / | [.] task \z | / comment [.] tt2 \z }x
)
{
load_title
(
$file
,
$_
);
}
}
...
...
@@ -470,7 +149,8 @@ my $output_file =
my
$out
;
my
$pot
;
if
(
-
r
$output_file
)
{
open
$pot
,
'
+<
',
$output_file
or
die
"
$output_file
: $!
\n
";
open
$pot
,
'
+<
',
$output_file
or
die
sprintf
"
%s: %s
\n
",
$output_file
,
$ERRNO
;
while
(
<
$pot
>
)
{
if
(
1
..
/^$/
)
{
$out
.=
$_
;
next
}
last
;
...
...
@@ -481,7 +161,8 @@ if (-r $output_file) {
seek
$pot
,
0
,
0
;
truncate
$pot
,
0
;
}
else
{
open
$pot
,
'
>
',
$output_file
or
die
"
$output_file
: $!
\n
";
open
$pot
,
'
>
',
$output_file
or
die
sprintf
"
%s: %s
\n
",
$output_file
,
$ERRNO
;
}
select
$pot
;
...
...
@@ -556,7 +237,7 @@ foreach my $entry (@ordered_bis) {
sub
add_expression
{
my
$param
=
shift
;
@ordered_strings
=
(
@ordered_strings
,
$param
->
{
expression
}
)
;
push
@ordered_strings
,
$param
->
{
expression
};
push
@
{
$file
{
$param
->
{
expression
}}},
[
$param
->
{
filename
},
$param
->
{
line
},
$param
->
{
vars
}];
$type_of_entries
{
$param
->
{
expression
}}
=
$param
->
{
type
}
...
...
@@ -564,6 +245,325 @@ sub add_expression {
}
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
;
$line
=
1
;
pos
(
$_
)
=
0
;
while
(
m{
\G .*?
(?:
# Short style: [% "..." | loc(...) %]
$tag_s [-=~+]? \s*
(?:
\'
((?: \\. | [^'\\])*)
\'
|
\"
((?: \\. | [^"\\])*)
\"
) \s*
\| \s*
($tt2_filters)
(.*?)
\s* [-=~+]? $tag_e
|
# Enclosing style: [%|loc(...)%]...[%END%]
$tag_s [-=~+]? \s*
\| \s*
($tt2_filters)
(.*?)
\s* [-=~+]? $tag_e
(.*?)
$tag_s [-=~+]? \s*
END
\s* [-=~+]? $tag_e
)
}gsx
)
{
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" :
($1 eq 'r') ? "\r" :
$1
}eg
;
$vars
=~
s/^\s*[(](.*?)[)].*/$1/
or
$vars
=
'';
}
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
')
:
())
}
);
}
}
sub
load_perl
{
my
$filename
=
shift
;
my
$_
=
shift
;
my
$line
;
# Sympa variables (gettext_comment, gettext_id and gettext_unit)
$line
=
1
;
pos
(
$_
)
=
0
;
while
(
m{
\G .*?
([\"\']?)
(gettext_comment | gettext_id | gettext_unit)
\1
\s* => \s*
(?:
(\") ((?: \\. | [^\"])+) \"
| (\') ((?: \\. | [^\'])+) \'
)
}gsx
)
{
my
(
$quot
,
$str
)
=
(
$
3
//
$
5
,
$
4
//
$
6
);
$line
+=
(()
=
(
$MATCH
=~
/\n/g
));
# cryptocontext!
$str
=~
s{(\\.)}{eval "$quot$1$quot"}esg
;
add_expression
(
{
expression
=>
$str
,
filename
=>
$filename
,
line
=>
$line
}
);
}
# Perl source file
my
$state
=
0
;
my
$str
;
my
$vars
;
my
$type
;
pos
(
$_
)
=
0
;
my
$orig
=
1
+
(()
=
((
my
$
__
=
$_
)
=~
/\n/g
));
PARSER:
{
$_
=
substr
$_
,
pos
$_
if
pos
$_
;
my
$line
=
$orig
-
(()
=
((
my
$
__
=
$_
)
=~
/\n/g
));
# maketext or loc or _
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
';
}
else
{
$state
=
BEG
;
undef
$type
;
}
redo
;
}
if
((
$state
==
BEG
or
$state
==
BEGM
)
and
m/^([\s\t\n]*)/cg
)
{
redo
;
}
# begin ()
if
(
$state
==
BEG
and
m/^([\S\(])/cg
)
{
$state
=
(
$
1
eq
'
(
')
?
PAR
:
NUL
;
redo
;
}
if
(
$state
==
BEGM
and
m/^([\(])/cg
)
{
$state
=
PARM
;
redo
;
}
# begin or end of string
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
;