line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Locale::Maketext::Test; |
2
|
6
|
|
|
6
|
|
120908
|
use strict; |
|
6
|
|
|
|
|
10
|
|
|
6
|
|
|
|
|
130
|
|
3
|
6
|
|
|
6
|
|
18
|
use warnings; |
|
6
|
|
|
|
|
7
|
|
|
6
|
|
|
|
|
104
|
|
4
|
|
|
|
|
|
|
|
5
|
6
|
|
|
6
|
|
711
|
use 5.014; |
|
6
|
|
|
|
|
12
|
|
6
|
6
|
|
|
6
|
|
2985
|
use utf8; |
|
6
|
|
|
|
|
49
|
|
|
6
|
|
|
|
|
23
|
|
7
|
|
|
|
|
|
|
|
8
|
6
|
|
|
6
|
|
2547
|
use Try::Tiny; |
|
6
|
|
|
|
|
12468
|
|
|
6
|
|
|
|
|
239
|
|
9
|
6
|
|
|
6
|
|
29
|
use File::Spec; |
|
6
|
|
|
|
|
9
|
|
|
6
|
|
|
|
|
91
|
|
10
|
6
|
|
|
6
|
|
2730
|
use Test::MockModule; |
|
6
|
|
|
|
|
19222
|
|
|
6
|
|
|
|
|
140
|
|
11
|
6
|
|
|
6
|
|
2426
|
use Locale::Maketext::ManyPluralForms; |
|
6
|
|
|
|
|
71285
|
|
|
6
|
|
|
|
|
33
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
# ABSTRACT: Locale::Maketext::Test |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
=encoding UTF-8 |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
=head1 NAME |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
Locale::Maketext::Test |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
=cut |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
our $VERSION = '0.05'; |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
=head1 SYNOPSIS |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
use Locale::Maketext::Test; |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
my $foo = Locale::Maketext::Test->new(directory => '/tmp/locales'); # it will look for files like id.po, ru.po |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
### optional parameters |
32
|
|
|
|
|
|
|
# languages => ['en', 'de'] - to test specific languages in directory, else it will pick all po files in directory |
33
|
|
|
|
|
|
|
# ideally these languages should be as per https://en.wikipedia.org/wiki/List_of_ISO_639-1_codes format |
34
|
|
|
|
|
|
|
# debug => 1 - if you want to check warnings add debug flag else it will output errors only |
35
|
|
|
|
|
|
|
# auto => 1 set only when you want to fallback in case a key is missing from lexicons |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
# start test |
38
|
|
|
|
|
|
|
my $response = $foo->testlocales(); |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
# no errors or warnings if |
41
|
|
|
|
|
|
|
$response->{status} eq 1; |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
# something is wrong when |
44
|
|
|
|
|
|
|
$response->{status} eq 0; |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
# check for errors and warnings in case status is 0 |
47
|
|
|
|
|
|
|
$response->{errors} = {id => [qw(error1 error2)], ru => [qw(error1 error2)]}; |
48
|
|
|
|
|
|
|
# warnings are only present when debug is set to 1 |
49
|
|
|
|
|
|
|
$response->{warnings} = {id => [qw(warn1 warn2)], ru => [qw(warn1 warn2)]}; |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
=head1 DESCRIPTION |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
This reads all message ids from the specified PO files and tries to |
54
|
|
|
|
|
|
|
translate them into the destination language. PO files can be specified either |
55
|
|
|
|
|
|
|
as file name (extension .po) or by providing the language. In the latter case |
56
|
|
|
|
|
|
|
the PO file is found in the directory given by the directory option. |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
=head2 TYPES OF ERRORS FOUND |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
=head3 unknown %func() calls |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
Translations can contain function calls in the form of %func(parameters). |
63
|
|
|
|
|
|
|
These functions must be defined in our code. Sometimes translators try |
64
|
|
|
|
|
|
|
to translate the function name which then calls an undefined function. |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
=head3 incorrect number of %plural() parameters |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
Different languages have different numbers of plural forms. |
69
|
|
|
|
|
|
|
Some, like Malay, don't have any plural forms. Some, like English or French, |
70
|
|
|
|
|
|
|
have just 2 forms, singular and one plural. Others like Arabic or Russian have |
71
|
|
|
|
|
|
|
more forms. Whenever a translator uses the %plural() function, he must specify |
72
|
|
|
|
|
|
|
the correct number of plural forms as parameters. |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
=head3 incorrect usage of %d in %plural() parameters |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
In some languages, like English or German, singular is applicable only to the |
77
|
|
|
|
|
|
|
quantity of 1. That means the German translator could come up for instance |
78
|
|
|
|
|
|
|
with the following valid %plural call: |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
%plural(%5,ein Stein,%d Steine) |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
In other languages, like French or Russian, this would be an error. French uses |
83
|
|
|
|
|
|
|
singular also for 0 quantities. So, if the French translator calls: |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
%plural(%5,une porte,%d portes) |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
and in the actual call the quantity of 0 is passed the output is still "une porte". |
88
|
|
|
|
|
|
|
In Russian the problem is even more critical because singular is used for instance |
89
|
|
|
|
|
|
|
also for the quantity of 121. |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
Thus, this test checks if a) the target language is similar to English in having only |
92
|
|
|
|
|
|
|
2 plural forms, singular and one plural, and in applying singular only to the quantity |
93
|
|
|
|
|
|
|
of 1. If both of these conditions are met %plural calls like the above are allowed. |
94
|
|
|
|
|
|
|
Otherwise, if at least one of the parameters passed to %plural contains a %d, |
95
|
|
|
|
|
|
|
all of the parameters must contain the %d as well. |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
That means the following 2 %plural calls are allowed in Russian: |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
%plural(%3,%d книга,%d книги,%d книг) |
100
|
|
|
|
|
|
|
%3 %plural(%3,книга,книги,книг) |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
while this is forbidden: |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
%plural(%3,одна книга,%d книги,%d книг) |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
=head1 SUBROUTINES/METHODS |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
=head2 debug |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
set this if you need to check warnings along with errors |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
=cut |
113
|
|
|
|
|
|
|
|
114
|
6
|
|
|
6
|
|
3175
|
use Moose; |
|
6
|
|
|
|
|
1760685
|
|
|
6
|
|
|
|
|
46
|
|
115
|
6
|
|
|
6
|
|
31900
|
use namespace::autoclean; |
|
6
|
|
|
|
|
32555
|
|
|
6
|
|
|
|
|
16
|
|
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
has debug => ( |
118
|
|
|
|
|
|
|
is => 'ro', |
119
|
|
|
|
|
|
|
isa => 'Bool', |
120
|
|
|
|
|
|
|
default => 0 |
121
|
|
|
|
|
|
|
); |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
=head2 directory |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
directory where locales files are located |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
=cut |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
has directory => ( |
130
|
|
|
|
|
|
|
is => 'ro', |
131
|
|
|
|
|
|
|
isa => 'Str', |
132
|
|
|
|
|
|
|
required => 1 |
133
|
|
|
|
|
|
|
); |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
=head2 languages |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
language array, set this if you want to test specific language only in specified directory |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
=cut |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
has languages => ( |
142
|
|
|
|
|
|
|
is => 'rw', |
143
|
|
|
|
|
|
|
isa => 'ArrayRef[Str]', |
144
|
|
|
|
|
|
|
default => sub { [] }); |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
=head2 auto |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
flag to fallback when a key is missing from lexicons |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
# if this is not set then maketext will output errors if |
151
|
|
|
|
|
|
|
# translations is marked as fuzzy or is missing |
152
|
|
|
|
|
|
|
# read more about it here https://metacpan.org/pod/Locale::Maketext::Lexicon |
153
|
|
|
|
|
|
|
Locale::Maketext::Lexicon->import({ _auto => 1 }) |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
=cut |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
has auto => ( |
158
|
|
|
|
|
|
|
is => 'ro', |
159
|
|
|
|
|
|
|
isa => 'Bool', |
160
|
|
|
|
|
|
|
default => 0 |
161
|
|
|
|
|
|
|
); |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
has _status => ( |
164
|
|
|
|
|
|
|
is => 'rw', |
165
|
|
|
|
|
|
|
isa => 'HashRef', |
166
|
|
|
|
|
|
|
lazy => 1, |
167
|
|
|
|
|
|
|
init_arg => undef, |
168
|
|
|
|
|
|
|
default => sub { |
169
|
|
|
|
|
|
|
{ |
170
|
|
|
|
|
|
|
status => 1, |
171
|
|
|
|
|
|
|
errors => {}, |
172
|
|
|
|
|
|
|
warnings => {}}; |
173
|
|
|
|
|
|
|
}); |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
=head2 BUILD |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
=cut |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
sub BUILD { |
180
|
6
|
|
|
6
|
1
|
11
|
my $self = shift; |
181
|
|
|
|
|
|
|
|
182
|
6
|
100
|
|
|
|
10
|
unless (scalar @{$self->languages}) { |
|
6
|
|
|
|
|
208
|
|
183
|
1
|
|
|
|
|
1
|
my @lang = (); |
184
|
1
|
50
|
|
|
|
29
|
if (opendir my $dh, $self->directory) { |
185
|
1
|
|
|
|
|
14
|
while (readdir $dh) { |
186
|
5
|
100
|
|
|
|
18
|
if (my ($x) = ($_ =~ /^(\w+)\.po$/)) { |
187
|
3
|
|
|
|
|
7
|
push @lang, $x; |
188
|
|
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
} |
190
|
1
|
|
|
|
|
3
|
@lang = sort @lang; |
191
|
|
|
|
|
|
|
} |
192
|
1
|
|
|
|
|
27
|
$self->languages(\@lang); |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
|
195
|
6
|
|
|
|
|
160
|
return Locale::Maketext::ManyPluralForms->import({ |
196
|
|
|
|
|
|
|
'_decode' => 1, |
197
|
|
|
|
|
|
|
'_auto' => $self->auto, |
198
|
|
|
|
|
|
|
'*' => ['Gettext' => File::Spec->rel2abs($self->directory) . '/*.po']}); |
199
|
|
|
|
|
|
|
} |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
=head2 testlocales |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
test po files in directory specified |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
=cut |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
sub testlocales { |
208
|
6
|
|
|
6
|
1
|
71
|
my $self = shift; |
209
|
|
|
|
|
|
|
|
210
|
6
|
|
|
|
|
9
|
foreach my $lang (@{$self->languages}) { |
|
6
|
|
|
|
|
157
|
|
211
|
8
|
|
|
|
|
692
|
my $po = $self->_get_po($lang); |
212
|
7
|
|
|
|
|
19
|
my $lg = $po->{header}->{language}; |
213
|
7
|
|
|
|
|
1007
|
my $hnd = Locale::Maketext::ManyPluralForms->get_handle($lg); |
214
|
7
|
|
|
|
|
11707
|
$hnd->plural(1, 'test %d'); |
215
|
|
|
|
|
|
|
|
216
|
7
|
|
|
|
|
873
|
my $plural_sub = $hnd->{_plural}; |
217
|
|
|
|
|
|
|
|
218
|
7
|
|
|
|
|
10
|
my $nplurals = 2; # default |
219
|
7
|
50
|
|
|
|
80
|
$nplurals = $1 if $po->{header}->{'plural-forms'} =~ /\bnplurals=(\d+);/; |
220
|
7
|
|
|
|
|
9
|
my @plural; |
221
|
|
|
|
|
|
|
|
222
|
7
|
|
66
|
|
|
51
|
for (my ($i, $j) = (0, $nplurals); $i < 10000 && $j > 0; $i++) { |
223
|
13
|
|
|
|
|
204
|
my $pos = $plural_sub->($i); |
224
|
13
|
50
|
|
|
|
53
|
unless (defined $plural[$pos]) { |
225
|
13
|
|
|
|
|
14
|
$plural[$pos] = $i; |
226
|
13
|
|
|
|
|
50
|
$j--; |
227
|
|
|
|
|
|
|
} |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
# $lang_plural_is_like_english==1 means the language has exactly 2 plural forms |
231
|
|
|
|
|
|
|
# and singular is applied only to the quantity of 1. That means something like |
232
|
|
|
|
|
|
|
# %plural(%d,ein Stern,%d Sterne) is allowed. In French for instance, singular is |
233
|
|
|
|
|
|
|
# also applied to the quantity of 0. In that case the singular form should also |
234
|
|
|
|
|
|
|
# contain a %d sequence. |
235
|
7
|
|
|
|
|
14
|
my $lang_plural_is_like_english = ($nplurals == 2); |
236
|
7
|
100
|
|
|
|
15
|
if ($lang_plural_is_like_english) { |
237
|
4
|
|
|
|
|
14
|
for (my $i = 0; $i <= 100_000; $i++) { |
238
|
400004
|
100
|
|
|
|
1417492
|
next if $i == 1; |
239
|
400000
|
50
|
|
|
|
5633122
|
if ($plural_sub->($i) == 0) { |
240
|
0
|
|
|
|
|
0
|
$lang_plural_is_like_english = 0; |
241
|
0
|
|
|
|
|
0
|
last; |
242
|
|
|
|
|
|
|
} |
243
|
|
|
|
|
|
|
} |
244
|
|
|
|
|
|
|
} |
245
|
|
|
|
|
|
|
|
246
|
7
|
|
|
|
|
26
|
my $ln; |
247
|
|
|
|
|
|
|
|
248
|
7
|
|
|
|
|
88
|
$plural_sub = $hnd->can('plural'); |
249
|
7
|
|
|
|
|
77
|
my $mock = Test::MockModule->new(ref($hnd), no_auto => 1); |
250
|
|
|
|
|
|
|
$mock->mock( |
251
|
|
|
|
|
|
|
plural => sub { |
252
|
|
|
|
|
|
|
# The plural call should provide exactly the number of forms required by the language |
253
|
1
|
50
|
|
1
|
|
229
|
push @{$self->_status->{errors}->{$lg}}, |
|
1
|
|
|
|
|
25
|
|
254
|
1
|
|
|
|
|
5
|
$self->_format_message($ln, "\%plural() requires $nplurals parameters for this language (provided: @{[@_ - 2]})") |
255
|
|
|
|
|
|
|
unless @_ == $nplurals + 2; |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
# %plural() can be used like |
258
|
|
|
|
|
|
|
# |
259
|
|
|
|
|
|
|
# %plural(%3,word,words) |
260
|
|
|
|
|
|
|
# |
261
|
|
|
|
|
|
|
# or like |
262
|
|
|
|
|
|
|
# |
263
|
|
|
|
|
|
|
# %plural(%3,%d word,%d words) |
264
|
|
|
|
|
|
|
# |
265
|
|
|
|
|
|
|
# In the first case we are only looking for the correct plural form |
266
|
|
|
|
|
|
|
# providing the actual quantity elsewhere. |
267
|
|
|
|
|
|
|
# |
268
|
|
|
|
|
|
|
# The code below checks that either all parameters of the current call contain %d |
269
|
|
|
|
|
|
|
# or none of them. That means something like %plural(%15,one word,%d words) is an |
270
|
|
|
|
|
|
|
# error as singular is in many languages also applied to other quantities than 1. |
271
|
|
|
|
|
|
|
|
272
|
1
|
|
|
|
|
2
|
my $found_percent_d = 0; |
273
|
1
|
|
|
|
|
3
|
my @no_percent_d; |
274
|
1
|
|
|
|
|
3
|
for (my $i = 2; $i < @_; $i++) { |
275
|
2
|
50
|
|
|
|
5
|
if ($_[$i] =~ /%d/) { |
276
|
2
|
|
|
|
|
5
|
$found_percent_d++; |
277
|
|
|
|
|
|
|
} else { |
278
|
|
|
|
|
|
|
# $i==2 means it's the singular parameter. This one is allowed to not contain |
279
|
|
|
|
|
|
|
# %d if the language is like English |
280
|
0
|
0
|
0
|
|
|
0
|
push @no_percent_d, $i - 1 unless ($i == 2 and $lang_plural_is_like_english); |
281
|
|
|
|
|
|
|
} |
282
|
|
|
|
|
|
|
} |
283
|
1
|
50
|
|
|
|
2
|
if ($found_percent_d) { |
284
|
1
|
50
|
|
|
|
3
|
if (@no_percent_d > 1) { |
|
|
50
|
|
|
|
|
|
285
|
0
|
|
|
|
|
0
|
my $s = join(', ', @no_percent_d[0 .. $#no_percent_d - 1]) . ' and ' . $no_percent_d[-1]; |
286
|
0
|
|
|
|
|
0
|
push @{$self->_status->{errors}->{$lg}}, $self->_format_message($ln, "\%plural() parameters $s miss %d"); |
|
0
|
|
|
|
|
0
|
|
287
|
|
|
|
|
|
|
} elsif (@no_percent_d == 1) { |
288
|
0
|
|
|
|
|
0
|
push @{$self->_status->{errors}->{$lg}}, $self->_format_message($ln, "\%plural() parameter $no_percent_d[0] misses %d"); |
|
0
|
|
|
|
|
0
|
|
289
|
|
|
|
|
|
|
} |
290
|
|
|
|
|
|
|
} |
291
|
|
|
|
|
|
|
|
292
|
1
|
|
|
|
|
4
|
goto $plural_sub; |
293
|
7
|
|
|
|
|
329
|
}); |
294
|
|
|
|
|
|
|
|
295
|
7
|
|
|
|
|
455
|
for my $test (@{$po->{ids}}) { |
|
7
|
|
|
|
|
29
|
|
296
|
21
|
|
|
|
|
535
|
$ln = $test->[3]; |
297
|
21
|
|
|
|
|
21
|
my $i = 0; |
298
|
21
|
|
|
|
|
19
|
my $j = 0; |
299
|
|
|
|
|
|
|
my @param = map { |
300
|
29
|
|
|
|
|
22
|
$j++; |
301
|
29
|
100
|
100
|
|
|
353
|
push @{$self->_status->{warnings}->{$lg}}, $self->_format_message($ln, "unused parameter \%$j") if (not defined $_ and $self->debug); |
|
2
|
|
|
|
|
46
|
|
302
|
29
|
100
|
100
|
|
|
96
|
defined $_ && $_ eq 'text' ? 'text' . $i++ : 1; |
303
|
21
|
|
|
|
|
22
|
} @{$test->[1]}; |
|
21
|
|
|
|
|
42
|
|
304
|
|
|
|
|
|
|
try { |
305
|
21
|
|
|
21
|
|
669
|
local $SIG{__WARN__} = sub { die $_[0] }; |
|
0
|
|
|
|
|
0
|
|
306
|
21
|
|
|
|
|
101
|
$hnd->maketext($test->[0], @param); |
307
|
|
|
|
|
|
|
} |
308
|
|
|
|
|
|
|
catch { |
309
|
6
|
50
|
|
6
|
|
1122
|
if (/Can't locate object method "([^"]+)" via package/) { |
310
|
0
|
|
|
|
|
0
|
push @{$self->_status->{errors}->{$lg}}, $self->_format_message($ln, "Unknown directive \%$1()"); |
|
0
|
|
|
|
|
0
|
|
311
|
|
|
|
|
|
|
} else { |
312
|
6
|
|
|
|
|
7
|
push @{$self->_status->{errors}->{$lg}}, $self->_format_message($ln, "Unexpected error:\n$_"); |
|
6
|
|
|
|
|
208
|
|
313
|
|
|
|
|
|
|
} |
314
|
21
|
|
|
|
|
169
|
}; |
315
|
|
|
|
|
|
|
} |
316
|
|
|
|
|
|
|
} |
317
|
|
|
|
|
|
|
|
318
|
5
|
|
|
|
|
1964
|
return $self->_status; |
319
|
|
|
|
|
|
|
} |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
=pod |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
This returns hash with status, errors and warnings |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
{ |
326
|
|
|
|
|
|
|
status => 1/0, # 1 is success, 0 failure |
327
|
|
|
|
|
|
|
errors => { id => [error1, error2], ru => [error1, error2] }, |
328
|
|
|
|
|
|
|
warnings => { id => [warn1, warn2] } |
329
|
|
|
|
|
|
|
} |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
=cut |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
sub _cstring { |
334
|
49
|
|
|
49
|
|
1013
|
my %map = ( |
335
|
|
|
|
|
|
|
'a' => "\007", |
336
|
|
|
|
|
|
|
'b' => "\010", |
337
|
|
|
|
|
|
|
't' => "\011", |
338
|
|
|
|
|
|
|
'n' => "\012", |
339
|
|
|
|
|
|
|
'v' => "\013", |
340
|
|
|
|
|
|
|
'f' => "\014", |
341
|
|
|
|
|
|
|
'r' => "\015", |
342
|
|
|
|
|
|
|
); |
343
|
49
|
|
|
|
|
178
|
return $_[0] =~ s/ |
344
|
|
|
|
|
|
|
\\ |
345
|
|
|
|
|
|
|
(?: |
346
|
|
|
|
|
|
|
([0-7]{1,3}) |
347
|
|
|
|
|
|
|
| |
348
|
|
|
|
|
|
|
x([0-9a-fA-F]{1,2}) |
349
|
|
|
|
|
|
|
| |
350
|
|
|
|
|
|
|
([\\'"?abfvntr]) |
351
|
|
|
|
|
|
|
) |
352
|
84
|
50
|
33
|
|
|
386
|
/$1 ? chr(oct($1)) : $2 ? chr(hex($2)) : ($map{$3} || $3)/regx; |
|
|
50
|
|
|
|
|
|
353
|
|
|
|
|
|
|
} |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
sub _bstring { |
356
|
21
|
|
|
21
|
|
20
|
my @params; |
357
|
21
|
|
|
|
|
141
|
return $_[0] =~ s! |
358
|
|
|
|
|
|
|
(?> # matches %func(%N,parameters...) |
359
|
|
|
|
|
|
|
% |
360
|
|
|
|
|
|
|
(?<func>\w+) |
361
|
|
|
|
|
|
|
\( |
362
|
|
|
|
|
|
|
% |
363
|
|
|
|
|
|
|
(?<p0>[0-9]+) |
364
|
|
|
|
|
|
|
(?<prest>[^\)]*) |
365
|
|
|
|
|
|
|
\) |
366
|
|
|
|
|
|
|
) |
367
|
|
|
|
|
|
|
| |
368
|
|
|
|
|
|
|
(?> # matches %func(parameters) |
369
|
|
|
|
|
|
|
% |
370
|
|
|
|
|
|
|
(?<simplefunc>\w+) |
371
|
|
|
|
|
|
|
\( |
372
|
|
|
|
|
|
|
(?<simpleparm>[^\)]*) |
373
|
|
|
|
|
|
|
\) |
374
|
|
|
|
|
|
|
) |
375
|
|
|
|
|
|
|
| # matches %N |
376
|
|
|
|
|
|
|
% |
377
|
|
|
|
|
|
|
(?<simple>[0-9]+) |
378
|
|
|
|
|
|
|
| # [, ] and ~ should be escaped as ~[, ~] and ~~ |
379
|
|
|
|
|
|
|
(?<esc>[\[\]~]) |
380
|
|
|
|
|
|
|
! |
381
|
6
|
50
|
|
6
|
|
9085
|
if ($+{esc}) { |
|
6
|
50
|
|
|
|
1692
|
|
|
6
|
|
|
|
|
4347
|
|
|
17
|
|
|
|
|
107
|
|
382
|
0
|
|
|
|
|
0
|
"~$+{esc}"; |
383
|
|
|
|
|
|
|
} elsif ($+{simplefunc}) { |
384
|
0
|
|
|
|
|
0
|
"[$+{simplefunc},$+{simpleparm}]"; |
385
|
|
|
|
|
|
|
} else { |
386
|
17
|
100
|
|
|
|
81
|
my $pos = ($+{func} ? $+{p0} : $+{simple}) - 1; |
387
|
17
|
100
|
66
|
|
|
1039
|
$params[$pos] = $+{func} && $+{func} eq 'plural' ? 'plural' : ($params[$pos] // 'text'); |
|
|
|
50
|
|
|
|
|
388
|
17
|
100
|
|
|
|
148
|
$+{func} ? "[$+{func},_$+{p0}$+{prest}]" : "[_$+{simple}]"; |
389
|
|
|
|
|
|
|
} |
390
|
|
|
|
|
|
|
!regx, \@params; |
391
|
|
|
|
|
|
|
} |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
{ |
394
|
|
|
|
|
|
|
my @stack; |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
sub _nextline { |
397
|
242
|
100
|
|
242
|
|
362
|
return pop @stack if @stack; |
398
|
193
|
|
|
|
|
555
|
return scalar readline $_[0]; |
399
|
|
|
|
|
|
|
} |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
sub _unread { |
402
|
49
|
|
|
49
|
|
55
|
push @stack, @_; |
403
|
49
|
|
|
|
|
42
|
return; |
404
|
|
|
|
|
|
|
} |
405
|
|
|
|
|
|
|
} |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
sub _get_trans { |
408
|
28
|
|
|
28
|
|
24
|
my $f = shift; |
409
|
|
|
|
|
|
|
|
410
|
28
|
|
|
|
|
36
|
while (defined(my $l = _nextline($f))) { |
411
|
28
|
50
|
|
|
|
96
|
if ($l =~ /^\s*msgstr\s*"(.*)"/) { |
412
|
28
|
|
|
|
|
35
|
my $line = $1; |
413
|
28
|
|
|
|
|
36
|
while (defined($l = _nextline($f))) { |
414
|
105
|
100
|
|
|
|
216
|
if ($l =~ /^\s*"(.*)"/) { |
415
|
84
|
|
|
|
|
136
|
$line .= $1; |
416
|
|
|
|
|
|
|
} else { |
417
|
21
|
|
|
|
|
27
|
_unread($l); |
418
|
21
|
|
|
|
|
34
|
return _cstring($line); |
419
|
|
|
|
|
|
|
} |
420
|
|
|
|
|
|
|
} |
421
|
7
|
|
|
|
|
912
|
return _cstring($line); |
422
|
|
|
|
|
|
|
} |
423
|
|
|
|
|
|
|
} |
424
|
0
|
|
|
|
|
0
|
return; |
425
|
|
|
|
|
|
|
} |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
sub _get_po { |
428
|
8
|
|
|
8
|
|
18
|
my ($self, $lang, $header_only) = @_; |
429
|
|
|
|
|
|
|
|
430
|
8
|
50
|
|
|
|
27
|
unless ($lang =~ /\.po$/) { |
431
|
8
|
|
|
|
|
209
|
$lang = $self->directory . '/' . $lang . '.po'; |
432
|
|
|
|
|
|
|
} |
433
|
|
|
|
|
|
|
|
434
|
8
|
|
|
|
|
13
|
my (%header, @ids, $ln); |
435
|
8
|
|
|
|
|
12
|
my $first = 1; |
436
|
|
|
|
|
|
|
|
437
|
6
|
100
|
|
6
|
|
31
|
open my $f, '<:encoding(UTF-8)', $lang or die "Cannot open $lang: $!\n"; ## no critic (RequireBriefOpen) |
|
6
|
|
|
|
|
7
|
|
|
6
|
|
|
|
|
38
|
|
|
8
|
|
|
|
|
255
|
|
438
|
|
|
|
|
|
|
READ: |
439
|
7
|
|
|
|
|
39924
|
while (defined(my $l = _nextline($f))) { |
440
|
67
|
100
|
|
|
|
337
|
if ($l =~ /^\s*msgid\s*"(.*)"/) { |
441
|
28
|
|
|
|
|
42
|
my $line = $1; |
442
|
28
|
|
|
|
|
32
|
$ln = $.; |
443
|
28
|
|
|
|
|
33
|
while (defined($l = _nextline($f))) { |
444
|
28
|
50
|
|
|
|
119
|
if ($l =~ /^\s*"(.*)"/) { |
445
|
0
|
|
|
|
|
0
|
$line .= $1; |
446
|
|
|
|
|
|
|
} else { |
447
|
28
|
|
|
|
|
39
|
_unread($l); |
448
|
28
|
100
|
|
|
|
72
|
if ($first) { |
|
|
50
|
|
|
|
|
|
449
|
7
|
|
|
|
|
11
|
undef $first; |
450
|
7
|
|
|
|
|
19
|
%header = map { split /\s*:\s*/, lc($_), 2 } split /\n/, _get_trans($f); |
|
84
|
|
|
|
|
1271
|
|
451
|
7
|
50
|
|
|
|
34
|
last READ if $header_only; |
452
|
|
|
|
|
|
|
} elsif (length $line) { |
453
|
21
|
|
|
|
|
32
|
push @ids, [_bstring(_cstring($line)), _get_trans($f), $ln]; |
454
|
|
|
|
|
|
|
} |
455
|
28
|
|
|
|
|
70
|
last; |
456
|
|
|
|
|
|
|
} |
457
|
|
|
|
|
|
|
} |
458
|
|
|
|
|
|
|
} |
459
|
|
|
|
|
|
|
} |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
return { |
462
|
|
|
|
|
|
|
header => \%header, |
463
|
|
|
|
|
|
|
ids => \@ids, |
464
|
|
|
|
|
|
|
lang => $header{language}, |
465
|
7
|
|
|
|
|
121
|
file => $lang, |
466
|
|
|
|
|
|
|
}; |
467
|
|
|
|
|
|
|
} |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
sub _format_message { |
470
|
9
|
|
|
9
|
|
15
|
my ($self, $line, $message) = @_; |
471
|
9
|
|
|
|
|
208
|
$self->_status->{status} = 0; |
472
|
9
|
|
|
|
|
83
|
return "(line=$line): $message"; |
473
|
|
|
|
|
|
|
} |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
__PACKAGE__->meta->make_immutable; |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
=head1 AUTHOR |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
Binary.com, C<< <binary at cpan.org> >> |
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
=head1 BUGS |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
Please report any bugs or feature requests to C<bug-locale-maketext-test at rt.cpan.org>, or through |
484
|
|
|
|
|
|
|
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Locale-Maketext-Test>. I will be notified, and then you'll |
485
|
|
|
|
|
|
|
automatically be notified of progress on your bug as I make changes. |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
|
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
=head1 SUPPORT |
491
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
perldoc Locale::Maketext::Test |
495
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
|
497
|
|
|
|
|
|
|
You can also look for information at: |
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
=over 4 |
500
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker (report bugs here) |
502
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Locale-Maketext-Test> |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation |
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
L<http://annocpan.org/dist/Locale-Maketext-Test> |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
=item * CPAN Ratings |
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
L<http://cpanratings.perl.org/d/Locale-Maketext-Test> |
512
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
=item * Search CPAN |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
L<http://search.cpan.org/dist/Locale-Maketext-Test/> |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
=back |
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS |
521
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
=cut |
524
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
1; # End of Locale::Maketext::Test |