Lines 22-57
use Modern::Perl;
Link Here
|
22 |
use C4::Context; |
22 |
use C4::Context; |
23 |
# WARNING: Any other tested YAML library fails to work properly in this |
23 |
# WARNING: Any other tested YAML library fails to work properly in this |
24 |
# script content |
24 |
# script content |
25 |
use YAML::Syck qw( Dump LoadFile DumpFile ); |
25 |
use YAML::Syck qw( LoadFile DumpFile ); |
26 |
use Locale::PO; |
26 |
use Locale::PO; |
27 |
use FindBin qw( $Bin ); |
27 |
use FindBin qw( $Bin ); |
28 |
use File::Basename; |
28 |
use File::Basename; |
29 |
use File::Find; |
|
|
30 |
use File::Path qw( make_path ); |
29 |
use File::Path qw( make_path ); |
31 |
use File::Copy; |
30 |
use File::Copy; |
32 |
use File::Slurp; |
|
|
33 |
use File::Spec; |
34 |
use File::Temp qw( tempdir tempfile ); |
35 |
use Template::Parser; |
36 |
use PPI; |
37 |
|
38 |
|
31 |
|
39 |
$YAML::Syck::ImplicitTyping = 1; |
32 |
$YAML::Syck::ImplicitTyping = 1; |
40 |
|
33 |
|
41 |
|
|
|
42 |
# Default file header for .po syspref files |
43 |
my $default_pref_po_header = Locale::PO->new(-msgid => '', -msgstr => |
44 |
"Project-Id-Version: PACKAGE VERSION\\n" . |
45 |
"PO-Revision-Date: YEAR-MO-DA HO:MI +ZONE\\n" . |
46 |
"Last-Translator: FULL NAME <EMAIL\@ADDRESS>\\n" . |
47 |
"Language-Team: Koha Translate List <koha-translate\@lists.koha-community.org>\\n" . |
48 |
"MIME-Version: 1.0\\n" . |
49 |
"Content-Type: text/plain; charset=UTF-8\\n" . |
50 |
"Content-Transfer-Encoding: 8bit\\n" . |
51 |
"Plural-Forms: nplurals=2; plural=(n > 1);\\n" |
52 |
); |
53 |
|
54 |
|
55 |
sub set_lang { |
34 |
sub set_lang { |
56 |
my ($self, $lang) = @_; |
35 |
my ($self, $lang) = @_; |
57 |
|
36 |
|
Lines 60-66
sub set_lang {
Link Here
|
60 |
"/prog/$lang/modules/admin/preferences"; |
39 |
"/prog/$lang/modules/admin/preferences"; |
61 |
} |
40 |
} |
62 |
|
41 |
|
63 |
|
|
|
64 |
sub new { |
42 |
sub new { |
65 |
my ($class, $lang, $pref_only, $verbose) = @_; |
43 |
my ($class, $lang, $pref_only, $verbose) = @_; |
66 |
|
44 |
|
Lines 75-106
sub new {
Link Here
|
75 |
$self->{verbose} = $verbose; |
53 |
$self->{verbose} = $verbose; |
76 |
$self->{process} = "$Bin/tmpl_process3.pl " . ($verbose ? '' : '-q'); |
54 |
$self->{process} = "$Bin/tmpl_process3.pl " . ($verbose ? '' : '-q'); |
77 |
$self->{path_po} = "$Bin/po"; |
55 |
$self->{path_po} = "$Bin/po"; |
78 |
$self->{po} = { '' => $default_pref_po_header }; |
56 |
$self->{po} = {}; |
79 |
$self->{domain} = 'Koha'; |
57 |
$self->{domain} = 'Koha'; |
80 |
$self->{cp} = `which cp`; |
|
|
81 |
$self->{msgmerge} = `which msgmerge`; |
82 |
$self->{msgfmt} = `which msgfmt`; |
58 |
$self->{msgfmt} = `which msgfmt`; |
83 |
$self->{msginit} = `which msginit`; |
|
|
84 |
$self->{msgattrib} = `which msgattrib`; |
85 |
$self->{xgettext} = `which xgettext`; |
86 |
$self->{sed} = `which sed`; |
87 |
$self->{po2json} = "$Bin/po2json"; |
59 |
$self->{po2json} = "$Bin/po2json"; |
88 |
$self->{gzip} = `which gzip`; |
60 |
$self->{gzip} = `which gzip`; |
89 |
$self->{gunzip} = `which gunzip`; |
61 |
$self->{gunzip} = `which gunzip`; |
90 |
chomp $self->{cp}; |
|
|
91 |
chomp $self->{msgmerge}; |
92 |
chomp $self->{msgfmt}; |
62 |
chomp $self->{msgfmt}; |
93 |
chomp $self->{msginit}; |
|
|
94 |
chomp $self->{msgattrib}; |
95 |
chomp $self->{xgettext}; |
96 |
chomp $self->{sed}; |
97 |
chomp $self->{gzip}; |
63 |
chomp $self->{gzip}; |
98 |
chomp $self->{gunzip}; |
64 |
chomp $self->{gunzip}; |
99 |
|
65 |
|
100 |
unless ($self->{xgettext}) { |
|
|
101 |
die "Missing 'xgettext' executable. Have you installed the gettext package?\n"; |
102 |
} |
103 |
|
104 |
# Get all .pref file names |
66 |
# Get all .pref file names |
105 |
opendir my $fh, $self->{path_pref_en}; |
67 |
opendir my $fh, $self->{path_pref_en}; |
106 |
my @pref_files = grep { /\.pref$/ } readdir($fh); |
68 |
my @pref_files = grep { /\.pref$/ } readdir($fh); |
Lines 175-181
sub new {
Link Here
|
175 |
bless $self, $class; |
137 |
bless $self, $class; |
176 |
} |
138 |
} |
177 |
|
139 |
|
178 |
|
|
|
179 |
sub po_filename { |
140 |
sub po_filename { |
180 |
my $self = shift; |
141 |
my $self = shift; |
181 |
my $suffix = shift; |
142 |
my $suffix = shift; |
Lines 186-347
sub po_filename {
Link Here
|
186 |
return $trans_file; |
147 |
return $trans_file; |
187 |
} |
148 |
} |
188 |
|
149 |
|
|
|
150 |
sub get_trans_text { |
151 |
my ($self, $msgctxt, $msgid) = @_; |
189 |
|
152 |
|
190 |
sub po_append { |
153 |
my $key = ($msgctxt // '') . ";$msgid"; |
191 |
my ($self, $id, $comment) = @_; |
|
|
192 |
my $po = $self->{po}; |
193 |
my $p = $po->{$id}; |
194 |
if ( $p ) { |
195 |
$p->comment( $p->comment . "\n" . $comment ); |
196 |
} |
197 |
else { |
198 |
$po->{$id} = Locale::PO->new( |
199 |
-comment => $comment, |
200 |
-msgid => $id, |
201 |
-msgstr => '' |
202 |
); |
203 |
} |
204 |
} |
205 |
|
206 |
|
154 |
|
207 |
sub add_prefs { |
155 |
my $po = $self->{po}->{$key}; |
208 |
my ($self, $comment, $prefs) = @_; |
156 |
if ($po) { |
|
|
157 |
my $msgstr = Locale::PO->dequote($po->msgstr); |
209 |
|
158 |
|
210 |
for my $pref ( @$prefs ) { |
159 |
return $msgstr || $msgid; |
211 |
my $pref_name = ''; |
|
|
212 |
for my $element ( @$pref ) { |
213 |
if ( ref( $element) eq 'HASH' ) { |
214 |
$pref_name = $element->{pref}; |
215 |
last; |
216 |
} |
217 |
} |
218 |
for my $element ( @$pref ) { |
219 |
if ( ref( $element) eq 'HASH' ) { |
220 |
while ( my ($key, $value) = each(%$element) ) { |
221 |
next unless $key eq 'choices' or $key eq 'multiple'; |
222 |
next unless ref($value) eq 'HASH'; |
223 |
for my $ckey ( keys %$value ) { |
224 |
my $id = $self->{file} . "#$pref_name# " . $value->{$ckey}; |
225 |
$self->po_append( $id, $comment ); |
226 |
} |
227 |
} |
228 |
} |
229 |
elsif ( $element ) { |
230 |
$self->po_append( $self->{file} . "#$pref_name# $element", $comment ); |
231 |
} |
232 |
} |
233 |
} |
160 |
} |
234 |
} |
|
|
235 |
|
161 |
|
236 |
|
162 |
return $msgid; |
237 |
sub get_trans_text { |
|
|
238 |
my ($self, $id) = @_; |
239 |
|
240 |
my $po = $self->{po}->{$id}; |
241 |
return unless $po; |
242 |
return Locale::PO->dequote($po->msgstr); |
243 |
} |
163 |
} |
244 |
|
164 |
|
|
|
165 |
sub get_translated_tab_content { |
166 |
my ($self, $tab, $tab_content) = @_; |
245 |
|
167 |
|
246 |
sub update_tab_prefs { |
168 |
if ( ref($tab_content) eq 'ARRAY' ) { |
247 |
my ($self, $pref, $prefs) = @_; |
169 |
return $self->get_translated_prefs($tab, $tab_content); |
248 |
|
|
|
249 |
for my $p ( @$prefs ) { |
250 |
my $pref_name = ''; |
251 |
next unless $p; |
252 |
for my $element ( @$p ) { |
253 |
if ( ref( $element) eq 'HASH' ) { |
254 |
$pref_name = $element->{pref}; |
255 |
last; |
256 |
} |
257 |
} |
258 |
for my $i ( 0..@$p-1 ) { |
259 |
my $element = $p->[$i]; |
260 |
if ( ref( $element) eq 'HASH' ) { |
261 |
while ( my ($key, $value) = each(%$element) ) { |
262 |
next unless $key eq 'choices' or $key eq 'multiple'; |
263 |
next unless ref($value) eq 'HASH'; |
264 |
for my $ckey ( keys %$value ) { |
265 |
my $id = $self->{file} . "#$pref_name# " . $value->{$ckey}; |
266 |
my $text = $self->get_trans_text( $id ); |
267 |
$value->{$ckey} = $text if $text; |
268 |
} |
269 |
} |
270 |
} |
271 |
elsif ( $element ) { |
272 |
my $id = $self->{file} . "#$pref_name# $element"; |
273 |
my $text = $self->get_trans_text( $id ); |
274 |
$p->[$i] = $text if $text; |
275 |
} |
276 |
} |
277 |
} |
170 |
} |
278 |
} |
|
|
279 |
|
171 |
|
|
|
172 |
my $translated_tab_content = { |
173 |
map { |
174 |
my $section = $_; |
175 |
my $sysprefs = $tab_content->{$section}; |
176 |
my $context = "$tab > $section"; |
280 |
|
177 |
|
281 |
sub get_po_from_prefs { |
178 |
$self->get_trans_text($tab, $section) => $self->get_translated_prefs($context, $sysprefs); |
282 |
my $self = shift; |
179 |
} keys %$tab_content |
|
|
180 |
}; |
283 |
|
181 |
|
284 |
for my $file ( @{$self->{pref_files}} ) { |
182 |
return $translated_tab_content; |
285 |
my $pref = LoadFile( $self->{path_pref_en} . "/$file" ); |
|
|
286 |
$self->{file} = $file; |
287 |
# Entries for tab titles |
288 |
$self->po_append( $self->{file}, $_ ) for keys %$pref; |
289 |
while ( my ($tab, $tab_content) = each %$pref ) { |
290 |
if ( ref($tab_content) eq 'ARRAY' ) { |
291 |
$self->add_prefs( $tab, $tab_content ); |
292 |
next; |
293 |
} |
294 |
while ( my ($section, $sysprefs) = each %$tab_content ) { |
295 |
my $comment = "$tab > $section"; |
296 |
$self->po_append( $self->{file} . " " . $section, $comment ); |
297 |
$self->add_prefs( $comment, $sysprefs ); |
298 |
} |
299 |
} |
300 |
} |
301 |
} |
183 |
} |
302 |
|
184 |
|
|
|
185 |
sub get_translated_prefs { |
186 |
my ($self, $context, $sysprefs) = @_; |
303 |
|
187 |
|
304 |
sub save_po { |
188 |
my $translated_prefs = [ |
305 |
my $self = shift; |
189 |
map { |
|
|
190 |
my ($pref_elt) = grep { ref($_) eq 'HASH' && exists $_->{pref} } @$_; |
191 |
my $pref_name = $pref_elt ? $pref_elt->{pref} : ''; |
306 |
|
192 |
|
307 |
# Create file header if it doesn't already exist |
193 |
my $translated_syspref = [ |
308 |
my $po = $self->{po}; |
194 |
map { |
309 |
$po->{''} ||= $default_pref_po_header; |
195 |
$self->get_translated_pref("$context > $pref_name", $_ ); |
|
|
196 |
} @$_ |
197 |
]; |
310 |
|
198 |
|
311 |
# Write .po entries into a file put in Koha standard po directory |
199 |
$translated_syspref; |
312 |
Locale::PO->save_file_fromhash( $self->po_filename("-pref.po"), $po ); |
200 |
} @$sysprefs |
313 |
say "Saved in file: ", $self->po_filename("-pref.po") if $self->{verbose}; |
201 |
]; |
314 |
} |
|
|
315 |
|
202 |
|
|
|
203 |
return $translated_prefs; |
204 |
} |
316 |
|
205 |
|
317 |
sub get_po_merged_with_en { |
206 |
sub get_translated_pref { |
318 |
my $self = shift; |
207 |
my ($self, $context, $syspref) = @_; |
319 |
|
208 |
|
320 |
# Get po from current 'en' .pref files |
209 |
unless (ref($syspref)) { |
321 |
$self->get_po_from_prefs(); |
210 |
return $self->get_trans_text($context, $syspref // ''); |
322 |
my $po_current = $self->{po}; |
211 |
} |
323 |
|
212 |
|
324 |
# Get po from previous generation |
213 |
my $translated_pref = { |
325 |
my $po_previous = Locale::PO->load_file_ashash( $self->po_filename("-pref.po") ); |
214 |
map { |
|
|
215 |
my $key = $_; |
216 |
my $value = $syspref->{$key}; |
326 |
|
217 |
|
327 |
for my $id ( keys %$po_current ) { |
218 |
my $translated_value = $value; |
328 |
my $po = $po_previous->{Locale::PO->quote($id)}; |
219 |
if (($key eq 'choices' || $key eq 'multiple') && ref($value) eq 'HASH') { |
329 |
next unless $po; |
220 |
$translated_value = { |
330 |
my $text = Locale::PO->dequote( $po->msgstr ); |
221 |
map { |
331 |
$po_current->{$id}->msgstr( $text ); |
222 |
$_ => $self->get_trans_text($context, $value->{$_}) |
332 |
} |
223 |
} keys %$value |
333 |
} |
224 |
} |
|
|
225 |
} |
334 |
|
226 |
|
|
|
227 |
$key => $translated_value |
228 |
} keys %$syspref |
229 |
}; |
335 |
|
230 |
|
336 |
sub update_prefs { |
231 |
return $translated_pref; |
337 |
my $self = shift; |
|
|
338 |
print "Update '", $self->{lang}, |
339 |
"' preferences .po file from 'en' .pref files\n" if $self->{verbose}; |
340 |
$self->get_po_merged_with_en(); |
341 |
$self->save_po(); |
342 |
} |
232 |
} |
343 |
|
233 |
|
344 |
|
|
|
345 |
sub install_prefs { |
234 |
sub install_prefs { |
346 |
my $self = shift; |
235 |
my $self = shift; |
347 |
|
236 |
|
Lines 350-394
sub install_prefs {
Link Here
|
350 |
exit; |
239 |
exit; |
351 |
} |
240 |
} |
352 |
|
241 |
|
353 |
# Get the language .po file merged with last modified 'en' preferences |
242 |
my @po_entries = @{ Locale::PO->load_file_asarray($self->po_filename("-pref.po"), 'utf8') }; |
354 |
$self->get_po_merged_with_en(); |
243 |
$self->{po} = { map { |
|
|
244 |
my $msgctxt = $_->msgctxt ? Locale::PO->dequote($_->msgctxt) : ''; |
245 |
my $msgid = Locale::PO->dequote($_->msgid); |
246 |
|
247 |
"$msgctxt;$msgid" => $_; |
248 |
} @po_entries }; |
355 |
|
249 |
|
356 |
for my $file ( @{$self->{pref_files}} ) { |
250 |
for my $file ( @{$self->{pref_files}} ) { |
357 |
my $pref = LoadFile( $self->{path_pref_en} . "/$file" ); |
251 |
my $pref = LoadFile( $self->{path_pref_en} . "/$file" ); |
358 |
$self->{file} = $file; |
252 |
|
359 |
# First, keys are replaced (tab titles) |
253 |
my $translated_pref = { |
360 |
$pref = do { |
254 |
map { |
361 |
my %pref = map { |
255 |
my $tab = $_; |
362 |
$self->get_trans_text( $self->{file} ) || $_ => $pref->{$_} |
256 |
my $tab_content = $pref->{$tab}; |
363 |
} keys %$pref; |
257 |
|
364 |
\%pref; |
258 |
$self->get_trans_text(undef, $tab) => $self->get_translated_tab_content($tab, $tab_content); |
|
|
259 |
} keys %$pref |
365 |
}; |
260 |
}; |
366 |
while ( my ($tab, $tab_content) = each %$pref ) { |
261 |
|
367 |
if ( ref($tab_content) eq 'ARRAY' ) { |
262 |
|
368 |
$self->update_tab_prefs( $pref, $tab_content ); |
|
|
369 |
next; |
370 |
} |
371 |
while ( my ($section, $sysprefs) = each %$tab_content ) { |
372 |
$self->update_tab_prefs( $pref, $sysprefs ); |
373 |
} |
374 |
my $ntab = {}; |
375 |
for my $section ( keys %$tab_content ) { |
376 |
my $id = $self->{file} . " $section"; |
377 |
my $text = $self->get_trans_text($id); |
378 |
my $nsection = $text ? $text : $section; |
379 |
if( exists $ntab->{$nsection} ) { |
380 |
# When translations collide (see BZ 18634) |
381 |
push @{$ntab->{$nsection}}, @{$tab_content->{$section}}; |
382 |
} else { |
383 |
$ntab->{$nsection} = $tab_content->{$section}; |
384 |
} |
385 |
} |
386 |
$pref->{$tab} = $ntab; |
387 |
} |
388 |
my $file_trans = $self->{po_path_lang} . "/$file"; |
263 |
my $file_trans = $self->{po_path_lang} . "/$file"; |
389 |
print "Write $file\n" if $self->{verbose}; |
264 |
print "Write $file\n" if $self->{verbose}; |
390 |
open my $fh, ">", $file_trans; |
265 |
DumpFile($file_trans, $translated_pref); |
391 |
print $fh Dump($pref); |
|
|
392 |
} |
266 |
} |
393 |
} |
267 |
} |
394 |
|
268 |
|
Lines 429-608
sub install_tmpl {
Link Here
|
429 |
} |
303 |
} |
430 |
} |
304 |
} |
431 |
|
305 |
|
432 |
|
|
|
433 |
sub update_tmpl { |
434 |
my ($self, $files) = @_; |
435 |
|
436 |
say "Update templates" if $self->{verbose}; |
437 |
for my $trans ( @{$self->{interface}} ) { |
438 |
my @files = @$files; |
439 |
my @nomarc = (); |
440 |
print |
441 |
" Update templates '$trans->{name}'\n", |
442 |
" From: $trans->{dir}/en/\n", |
443 |
" To : $self->{path_po}/$self->{lang}$trans->{suffix}\n" |
444 |
if $self->{verbose}; |
445 |
|
446 |
my $trans_dir = join("/en/ -i ",split(" ",$trans->{dir}))."/en/"; # multiple source dirs |
447 |
# if processing MARC po file, only use corresponding files |
448 |
my $marc = ( $trans->{name} =~ /MARC/ )?"-m \"$trans->{name}\"":""; # for MARC translations |
449 |
# if not processing MARC po file, ignore all MARC files |
450 |
@nomarc = ( 'marc21', 'unimarc', 'normarc' ) if ( $trans->{name} !~ /MARC/ ); # hardcoded MARC variants |
451 |
|
452 |
system |
453 |
"$self->{process} update " . |
454 |
"-i $trans_dir " . |
455 |
"-s $self->{path_po}/$self->{lang}$trans->{suffix} -r " . |
456 |
"$marc " . |
457 |
( @files ? ' -f ' . join ' -f ', @files : '') . |
458 |
( @nomarc ? ' -n ' . join ' -n ', @nomarc : ''); |
459 |
} |
460 |
} |
461 |
|
462 |
|
463 |
sub create_prefs { |
464 |
my $self = shift; |
465 |
|
466 |
if ( -e $self->po_filename("-pref.po") ) { |
467 |
say "Preferences .po file already exists. Delete it if you want to recreate it."; |
468 |
return; |
469 |
} |
470 |
$self->get_po_from_prefs(); |
471 |
$self->save_po(); |
472 |
} |
473 |
|
474 |
sub get_po_from_target { |
475 |
my $self = shift; |
476 |
my $target = shift; |
477 |
|
478 |
my $po; |
479 |
my $po_head = new Locale::PO; |
480 |
$po_head->{msgid} = "\"\""; |
481 |
$po_head->{msgstr} = "". |
482 |
"Project-Id-Version: Koha Project - Installation files\\n" . |
483 |
"PO-Revision-Date: YEAR-MO-DA HO:MI +ZONE\\n" . |
484 |
"Last-Translator: FULL NAME <EMAIL\@ADDRESS>\\n" . |
485 |
"Language-Team: Koha Translation Team\\n" . |
486 |
"Language: ".$self->{lang}."\\n" . |
487 |
"MIME-Version: 1.0\\n" . |
488 |
"Content-Type: text/plain; charset=UTF-8\\n" . |
489 |
"Content-Transfer-Encoding: 8bit\\n"; |
490 |
|
491 |
my @dirs = @{ $target->{dirs} }; |
492 |
my $intradir = $self->{context}->config('intranetdir'); |
493 |
for my $dir ( @dirs ) { # each dir |
494 |
opendir( my $dh, "$intradir/$dir" ) or die ("Can't open $intradir/$dir"); |
495 |
my @filelist = grep { $_ =~ m/\.yml/ } readdir($dh); # Just yaml files |
496 |
close($dh); |
497 |
for my $file ( @filelist ) { # each file |
498 |
my $yaml = LoadFile( "$intradir/$dir/$file" ); |
499 |
my @tables = @{ $yaml->{'tables'} }; |
500 |
my $tablec; |
501 |
for my $table ( @tables ) { # each table |
502 |
$tablec++; |
503 |
my $table_name = ( keys %$table )[0]; |
504 |
my @translatable = @{ $table->{$table_name}->{translatable} }; |
505 |
my @rows = @{ $table->{$table_name}->{rows} }; |
506 |
my @multiline = @{ $table->{$table_name}->{'multiline'} }; # to check multiline values |
507 |
my $rowc; |
508 |
for my $row ( @rows ) { # each row |
509 |
$rowc++; |
510 |
for my $field ( @translatable ) { # each field |
511 |
if ( @multiline and grep { $_ eq $field } @multiline ) { # multiline fields, only notices ATM |
512 |
my $mulc; |
513 |
foreach my $line ( @{$row->{$field}} ) { |
514 |
$mulc++; |
515 |
next if ( $line =~ /^(\s*<.*?>\s*$|^\s*\[.*?\]\s*|\s*)$/ ); # discard pure html, TT, empty |
516 |
$line =~ s/(<<.*?>>|\[\%.*?\%\]|<.*?>)/\%s/g; # put placeholders |
517 |
next if ( $line =~ /^(\s|%s|-|[[:punct:]]|\(|\))*$/ or length($line) < 2 ); # discard non strings |
518 |
if ( not $po->{ $line } ) { |
519 |
my $msg = new Locale::PO( |
520 |
-msgid => $line, -msgstr => '', |
521 |
-reference => "$dir/$file:$table_name:$tablec:row:$rowc:mul:$mulc" ); |
522 |
$po->{ $line } = $msg; |
523 |
} |
524 |
} |
525 |
} else { |
526 |
if ( defined $row->{$field} and length($row->{$field}) > 1 # discard null values and small strings |
527 |
and not $po->{ $row->{$field} } ) { |
528 |
my $msg = new Locale::PO( |
529 |
-msgid => $row->{$field}, -msgstr => '', |
530 |
-reference => "$dir/$file:$table_name:$tablec:row:$rowc" ); |
531 |
$po->{ $row->{$field} } = $msg; |
532 |
} |
533 |
} |
534 |
} |
535 |
} |
536 |
} |
537 |
my $desccount; |
538 |
for my $description ( @{ $yaml->{'description'} } ) { |
539 |
$desccount++; |
540 |
if ( length($description) > 1 and not $po->{ $description } ) { |
541 |
my $msg = new Locale::PO( |
542 |
-msgid => $description, -msgstr => '', |
543 |
-reference => "$dir/$file:description:$desccount" ); |
544 |
$po->{ $description } = $msg; |
545 |
} |
546 |
} |
547 |
} |
548 |
} |
549 |
$po->{''} = $po_head if ( $po ); |
550 |
|
551 |
return $po; |
552 |
} |
553 |
|
554 |
sub create_installer { |
555 |
my $self = shift; |
556 |
return unless ( $self->{installer} ); |
557 |
|
558 |
say "Create installer translation files\n" if $self->{verbose}; |
559 |
|
560 |
my @targets = @{ $self->{installer} }; # each installer target (common,marc21,unimarc) |
561 |
|
562 |
for my $target ( @targets ) { |
563 |
if ( -e $self->po_filename( $target->{suffix} ) ) { |
564 |
say "$self->{lang}$target->{suffix} file already exists. Delete it if you want to recreate it."; |
565 |
return; |
566 |
} |
567 |
} |
568 |
|
569 |
for my $target ( @targets ) { |
570 |
my $po = get_po_from_target( $self, $target ); |
571 |
# create output file only if there is something to write |
572 |
if ( $po ) { |
573 |
my $po_file = $self->po_filename( $target->{suffix} ); |
574 |
Locale::PO->save_file_fromhash( $po_file, $po ); |
575 |
say "Saved in file: ", $po_file if $self->{verbose}; |
576 |
} |
577 |
} |
578 |
} |
579 |
|
580 |
sub update_installer { |
581 |
my $self = shift; |
582 |
return unless ( $self->{installer} ); |
583 |
|
584 |
say "Update installer translation files\n" if $self->{verbose}; |
585 |
|
586 |
my @targets = @{ $self->{installer} }; # each installer target (common,marc21,unimarc) |
587 |
|
588 |
for my $target ( @targets ) { |
589 |
return unless ( -e $self->po_filename( $target->{suffix} ) ); |
590 |
my $po = get_po_from_target( $self, $target ); |
591 |
# update file only if there is something to update |
592 |
if ( $po ) { |
593 |
my ( $fh, $po_temp ) = tempfile(); |
594 |
binmode( $fh, ":encoding(UTF-8)" ); |
595 |
Locale::PO->save_file_fromhash( $po_temp, $po ); |
596 |
my $po_file = $self->po_filename( $target->{suffix} ); |
597 |
eval { |
598 |
my $st = system($self->{msgmerge}." ".($self->{verbose}?'':'-q'). |
599 |
" -s $po_file $po_temp -o - | ".$self->{msgattrib}." --no-obsolete -o $po_file"); |
600 |
}; |
601 |
say "Updated file: ", $po_file if $self->{verbose}; |
602 |
} |
603 |
} |
604 |
} |
605 |
|
606 |
sub translate_yaml { |
306 |
sub translate_yaml { |
607 |
my $self = shift; |
307 |
my $self = shift; |
608 |
my $target = shift; |
308 |
my $target = shift; |
Lines 716-750
sub install_installer {
Link Here
|
716 |
} |
416 |
} |
717 |
} |
417 |
} |
718 |
|
418 |
|
719 |
sub create_tmpl { |
|
|
720 |
my ($self, $files) = @_; |
721 |
|
722 |
say "Create templates\n" if $self->{verbose}; |
723 |
for my $trans ( @{$self->{interface}} ) { |
724 |
my @files = @$files; |
725 |
my @nomarc = (); |
726 |
print |
727 |
" Create templates .po files for '$trans->{name}'\n", |
728 |
" From: $trans->{dir}/en/\n", |
729 |
" To : $self->{path_po}/$self->{lang}$trans->{suffix}\n" |
730 |
if $self->{verbose}; |
731 |
|
732 |
my $trans_dir = join("/en/ -i ",split(" ",$trans->{dir}))."/en/"; # multiple source dirs |
733 |
# if processing MARC po file, only use corresponding files |
734 |
my $marc = ( $trans->{name} =~ /MARC/ )?"-m \"$trans->{name}\"":""; # for MARC translations |
735 |
# if not processing MARC po file, ignore all MARC files |
736 |
@nomarc = ( 'marc21', 'unimarc', 'normarc' ) if ( $trans->{name} !~ /MARC/ ); # hardcoded MARC variants |
737 |
|
738 |
system |
739 |
"$self->{process} create " . |
740 |
"-i $trans_dir " . |
741 |
"-s $self->{path_po}/$self->{lang}$trans->{suffix} -r " . |
742 |
"$marc " . |
743 |
( @files ? ' -f ' . join ' -f ', @files : '') . |
744 |
( @nomarc ? ' -n ' . join ' -n ', @nomarc : ''); |
745 |
} |
746 |
} |
747 |
|
748 |
sub locale_name { |
419 |
sub locale_name { |
749 |
my $self = shift; |
420 |
my $self = shift; |
750 |
|
421 |
|
Lines 758-1007
sub locale_name {
Link Here
|
758 |
return $locale; |
429 |
return $locale; |
759 |
} |
430 |
} |
760 |
|
431 |
|
761 |
sub create_messages { |
|
|
762 |
my $self = shift; |
763 |
|
764 |
my $pot = "$Bin/$self->{domain}.pot"; |
765 |
my $po = "$self->{path_po}/$self->{lang}-messages.po"; |
766 |
my $js_pot = "$self->{domain}-js.pot"; |
767 |
my $js_po = "$self->{path_po}/$self->{lang}-messages-js.po"; |
768 |
|
769 |
unless ( -f $pot && -f $js_pot ) { |
770 |
$self->extract_messages(); |
771 |
} |
772 |
|
773 |
say "Create messages ($self->{lang})" if $self->{verbose}; |
774 |
my $locale = $self->locale_name(); |
775 |
system "$self->{msginit} -i $pot -o $po -l $locale --no-translator 2> /dev/null"; |
776 |
warn "Problems creating $pot ".$? if ( $? == -1 ); |
777 |
system "$self->{msginit} -i $js_pot -o $js_po -l $locale --no-translator 2> /dev/null"; |
778 |
warn "Problems creating $js_pot ".$? if ( $? == -1 ); |
779 |
|
780 |
# If msginit failed to correctly set Plural-Forms, set a default one |
781 |
system "$self->{sed} --in-place " |
782 |
. "--expression='s/Plural-Forms: nplurals=INTEGER; plural=EXPRESSION/Plural-Forms: nplurals=2; plural=(n != 1)/' " |
783 |
. "$po $js_po"; |
784 |
} |
785 |
|
786 |
sub update_messages { |
787 |
my $self = shift; |
788 |
|
789 |
my $pot = "$Bin/$self->{domain}.pot"; |
790 |
my $po = "$self->{path_po}/$self->{lang}-messages.po"; |
791 |
my $js_pot = "$self->{domain}-js.pot"; |
792 |
my $js_po = "$self->{path_po}/$self->{lang}-messages-js.po"; |
793 |
|
794 |
unless ( -f $pot && -f $js_pot ) { |
795 |
$self->extract_messages(); |
796 |
} |
797 |
|
798 |
if ( -f $po && -f $js_pot ) { |
799 |
say "Update messages ($self->{lang})" if $self->{verbose}; |
800 |
system "$self->{msgmerge} --backup=off --quiet -U $po $pot"; |
801 |
system "$self->{msgmerge} --backup=off --quiet -U $js_po $js_pot"; |
802 |
} else { |
803 |
$self->create_messages(); |
804 |
} |
805 |
} |
806 |
|
807 |
sub extract_messages_from_templates { |
808 |
my ($self, $tempdir, $type, @files) = @_; |
809 |
|
810 |
my $htdocs = $type eq 'intranet' ? 'intrahtdocs' : 'opachtdocs'; |
811 |
my $dir = $self->{context}->config($htdocs); |
812 |
my @keywords = qw(t tx tn txn tnx tp tpx tnp tnpx); |
813 |
my $parser = Template::Parser->new(); |
814 |
|
815 |
foreach my $file (@files) { |
816 |
say "Extract messages from $file" if $self->{verbose}; |
817 |
my $template = read_file(File::Spec->catfile($dir, $file)); |
818 |
|
819 |
# No need to process a file that doesn't use the i18n.inc file. |
820 |
next unless $template =~ /i18n\.inc/; |
821 |
|
822 |
my $data = $parser->parse($template); |
823 |
unless ($data) { |
824 |
warn "Error at $file : " . $parser->error(); |
825 |
next; |
826 |
} |
827 |
|
828 |
my $destfile = $type eq 'intranet' ? |
829 |
File::Spec->catfile($tempdir, 'koha-tmpl', 'intranet-tmpl', $file) : |
830 |
File::Spec->catfile($tempdir, 'koha-tmpl', 'opac-tmpl', $file); |
831 |
|
832 |
make_path(dirname($destfile)); |
833 |
open my $fh, '>', $destfile; |
834 |
|
835 |
my @blocks = ($data->{BLOCK}, values %{ $data->{DEFBLOCKS} }); |
836 |
foreach my $block (@blocks) { |
837 |
my $document = PPI::Document->new(\$block); |
838 |
|
839 |
# [% t('foo') %] is compiled to |
840 |
# $output .= $stash->get(['t', ['foo']]); |
841 |
# We try to find all nodes corresponding to keyword (here 't') |
842 |
my $nodes = $document->find(sub { |
843 |
my ($topnode, $element) = @_; |
844 |
|
845 |
# Filter out non-valid keywords |
846 |
return 0 unless ($element->isa('PPI::Token::Quote::Single')); |
847 |
return 0 unless (grep {$element->content eq qq{'$_'}} @keywords); |
848 |
|
849 |
# keyword (e.g. 't') should be the first element of the arrayref |
850 |
# passed to $stash->get() |
851 |
return 0 if $element->sprevious_sibling; |
852 |
|
853 |
return 0 unless $element->snext_sibling |
854 |
&& $element->snext_sibling->snext_sibling |
855 |
&& $element->snext_sibling->snext_sibling->isa('PPI::Structure::Constructor'); |
856 |
|
857 |
# Check that it's indeed a call to $stash->get() |
858 |
my $statement = $element->statement->parent->statement->parent->statement; |
859 |
return 0 unless grep { $_->isa('PPI::Token::Symbol') && $_->content eq '$stash' } $statement->children; |
860 |
return 0 unless grep { $_->isa('PPI::Token::Operator') && $_->content eq '->' } $statement->children; |
861 |
return 0 unless grep { $_->isa('PPI::Token::Word') && $_->content eq 'get' } $statement->children; |
862 |
|
863 |
return 1; |
864 |
}); |
865 |
|
866 |
next unless $nodes; |
867 |
|
868 |
# Write the Perl equivalent of calls to t* functions family, so |
869 |
# xgettext can extract the strings correctly |
870 |
foreach my $node (@$nodes) { |
871 |
my @args = map { |
872 |
$_->significant && !$_->isa('PPI::Token::Operator') ? $_->content : () |
873 |
} $node->snext_sibling->snext_sibling->find_first('PPI::Statement')->children; |
874 |
|
875 |
my $keyword = $node->content; |
876 |
$keyword =~ s/^'t(.*)'$/__$1/; |
877 |
|
878 |
# Only keep required args to have a clean output |
879 |
my @required_args = shift @args; |
880 |
push @required_args, shift @args if $keyword =~ /n/; |
881 |
push @required_args, shift @args if $keyword =~ /p/; |
882 |
|
883 |
say $fh "$keyword(" . join(', ', @required_args) . ");"; |
884 |
} |
885 |
|
886 |
} |
887 |
|
888 |
close $fh; |
889 |
} |
890 |
|
891 |
return $tempdir; |
892 |
} |
893 |
|
894 |
sub extract_messages { |
895 |
my $self = shift; |
896 |
|
897 |
say "Extract messages into POT file" if $self->{verbose}; |
898 |
|
899 |
my $intranetdir = $self->{context}->config('intranetdir'); |
900 |
my $opacdir = $self->{context}->config('opacdir'); |
901 |
|
902 |
# Find common ancestor directory |
903 |
my @intranetdirs = File::Spec->splitdir($intranetdir); |
904 |
my @opacdirs = File::Spec->splitdir($opacdir); |
905 |
my @basedirs; |
906 |
while (@intranetdirs and @opacdirs) { |
907 |
my ($dir1, $dir2) = (shift @intranetdirs, shift @opacdirs); |
908 |
last if $dir1 ne $dir2; |
909 |
push @basedirs, $dir1; |
910 |
} |
911 |
my $basedir = File::Spec->catdir(@basedirs); |
912 |
|
913 |
my @files_to_scan; |
914 |
my @directories_to_scan = ('.'); |
915 |
my @blacklist = map { File::Spec->catdir(@intranetdirs, $_) } qw(blib koha-tmpl skel tmp t); |
916 |
while (@directories_to_scan) { |
917 |
my $dir = shift @directories_to_scan; |
918 |
opendir DIR, File::Spec->catdir($basedir, $dir) or die "Unable to open $dir: $!"; |
919 |
foreach my $entry (readdir DIR) { |
920 |
next if $entry =~ /^\./; |
921 |
my $relentry = File::Spec->catfile($dir, $entry); |
922 |
my $abspath = File::Spec->catfile($basedir, $relentry); |
923 |
if (-d $abspath and not grep { $_ eq $relentry } @blacklist) { |
924 |
push @directories_to_scan, $relentry; |
925 |
} elsif (-f $abspath and $relentry =~ /\.(pl|pm)$/) { |
926 |
push @files_to_scan, $relentry; |
927 |
} |
928 |
} |
929 |
} |
930 |
|
931 |
my $intrahtdocs = $self->{context}->config('intrahtdocs'); |
932 |
my $opachtdocs = $self->{context}->config('opachtdocs'); |
933 |
|
934 |
my @intranet_tt_files; |
935 |
find(sub { |
936 |
if ($File::Find::dir =~ m|/en/| && $_ =~ m/\.(tt|inc)$/) { |
937 |
my $filename = $File::Find::name; |
938 |
$filename =~ s|^$intrahtdocs/||; |
939 |
push @intranet_tt_files, $filename; |
940 |
} |
941 |
}, $intrahtdocs); |
942 |
|
943 |
my @opac_tt_files; |
944 |
find(sub { |
945 |
if ($File::Find::dir =~ m|/en/| && $_ =~ m/\.(tt|inc)$/) { |
946 |
my $filename = $File::Find::name; |
947 |
$filename =~ s|^$opachtdocs/||; |
948 |
push @opac_tt_files, $filename; |
949 |
} |
950 |
}, $opachtdocs); |
951 |
|
952 |
my $tempdir = tempdir('Koha-translate-XXXX', TMPDIR => 1, CLEANUP => 1); |
953 |
$self->extract_messages_from_templates($tempdir, 'intranet', @intranet_tt_files); |
954 |
$self->extract_messages_from_templates($tempdir, 'opac', @opac_tt_files); |
955 |
|
956 |
@intranet_tt_files = map { File::Spec->catfile('koha-tmpl', 'intranet-tmpl', $_) } @intranet_tt_files; |
957 |
@opac_tt_files = map { File::Spec->catfile('koha-tmpl', 'opac-tmpl', $_) } @opac_tt_files; |
958 |
my @tt_files = grep { -e File::Spec->catfile($tempdir, $_) } @intranet_tt_files, @opac_tt_files; |
959 |
|
960 |
push @files_to_scan, @tt_files; |
961 |
|
962 |
my $xgettext_common_args = "--force-po --from-code=UTF-8 " |
963 |
. "--package-name=Koha --package-version='' " |
964 |
. "-k -k__ -k__x -k__n:1,2 -k__nx:1,2 -k__xn:1,2 -k__p:1c,2 " |
965 |
. "-k__px:1c,2 -k__np:1c,2,3 -k__npx:1c,2,3 -kN__ -kN__n:1,2 " |
966 |
. "-kN__p:1c,2 -kN__np:1c,2,3 "; |
967 |
my $xgettext_cmd = "$self->{xgettext} -L Perl $xgettext_common_args " |
968 |
. "-o $Bin/$self->{domain}.pot -D $tempdir -D $basedir"; |
969 |
$xgettext_cmd .= " $_" foreach (@files_to_scan); |
970 |
|
971 |
if (system($xgettext_cmd) != 0) { |
972 |
die "system call failed: $xgettext_cmd"; |
973 |
} |
974 |
|
975 |
my @js_dirs = ( |
976 |
"$intrahtdocs/prog/js", |
977 |
"$opachtdocs/bootstrap/js", |
978 |
); |
979 |
|
980 |
my @js_files; |
981 |
find(sub { |
982 |
if ($_ =~ m/\.js$/) { |
983 |
my $filename = $File::Find::name; |
984 |
$filename =~ s|^$intranetdir/||; |
985 |
push @js_files, $filename; |
986 |
} |
987 |
}, @js_dirs); |
988 |
|
989 |
$xgettext_cmd = "$self->{xgettext} -L JavaScript $xgettext_common_args " |
990 |
. "-o $Bin/$self->{domain}-js.pot -D $intranetdir"; |
991 |
$xgettext_cmd .= " $_" foreach (@js_files); |
992 |
|
993 |
if (system($xgettext_cmd) != 0) { |
994 |
die "system call failed: $xgettext_cmd"; |
995 |
} |
996 |
|
997 |
my $replace_charset_cmd = "$self->{sed} --in-place " . |
998 |
"--expression='s/charset=CHARSET/charset=UTF-8/' " . |
999 |
"$Bin/$self->{domain}.pot $Bin/$self->{domain}-js.pot"; |
1000 |
if (system($replace_charset_cmd) != 0) { |
1001 |
die "system call failed: $replace_charset_cmd"; |
1002 |
} |
1003 |
} |
1004 |
|
1005 |
sub install_messages { |
432 |
sub install_messages { |
1006 |
my ($self) = @_; |
433 |
my ($self) = @_; |
1007 |
|
434 |
|
Lines 1012-1019
sub install_messages {
Link Here
|
1012 |
my $js_pofile = "$self->{path_po}/$self->{lang}-messages-js.po"; |
439 |
my $js_pofile = "$self->{path_po}/$self->{lang}-messages-js.po"; |
1013 |
|
440 |
|
1014 |
unless ( -f $pofile && -f $js_pofile ) { |
441 |
unless ( -f $pofile && -f $js_pofile ) { |
1015 |
$self->create_messages(); |
442 |
die "PO files for language '$self->{lang}' do not exist"; |
1016 |
} |
443 |
} |
|
|
444 |
|
1017 |
say "Install messages ($locale)" if $self->{verbose}; |
445 |
say "Install messages ($locale)" if $self->{verbose}; |
1018 |
make_path($modir); |
446 |
make_path($modir); |
1019 |
system "$self->{msgfmt} -o $mofile $pofile"; |
447 |
system "$self->{msgfmt} -o $mofile $pofile"; |
Lines 1035-1047
sub install_messages {
Link Here
|
1035 |
} |
463 |
} |
1036 |
} |
464 |
} |
1037 |
|
465 |
|
1038 |
sub remove_pot { |
|
|
1039 |
my $self = shift; |
1040 |
|
1041 |
unlink "$Bin/$self->{domain}.pot"; |
1042 |
unlink "$Bin/$self->{domain}-js.pot"; |
1043 |
} |
1044 |
|
1045 |
sub compress { |
466 |
sub compress { |
1046 |
my ($self, $files) = @_; |
467 |
my ($self, $files) = @_; |
1047 |
my @langs = $self->{lang} ? ($self->{lang}) : $self->get_all_langs(); |
468 |
my @langs = $self->{lang} ? ($self->{lang}) : $self->get_all_langs(); |
Lines 1074-1084
sub install {
Link Here
|
1074 |
my ($self, $files) = @_; |
495 |
my ($self, $files) = @_; |
1075 |
return unless $self->{lang}; |
496 |
return unless $self->{lang}; |
1076 |
$self->uncompress(); |
497 |
$self->uncompress(); |
1077 |
$self->install_tmpl($files) unless $self->{pref_only}; |
498 |
|
1078 |
$self->install_prefs(); |
499 |
if ($self->{pref_only}) { |
1079 |
$self->install_messages(); |
500 |
$self->install_prefs(); |
1080 |
$self->remove_pot(); |
501 |
} else { |
1081 |
$self->install_installer(); |
502 |
$self->install_tmpl($files); |
|
|
503 |
$self->install_prefs(); |
504 |
$self->install_messages(); |
505 |
$self->install_installer(); |
506 |
} |
1082 |
} |
507 |
} |
1083 |
|
508 |
|
1084 |
|
509 |
|
Lines 1087-1123
sub get_all_langs {
Link Here
|
1087 |
opendir( my $dh, $self->{path_po} ); |
512 |
opendir( my $dh, $self->{path_po} ); |
1088 |
my @files = grep { $_ =~ /-pref.(po|po.gz)$/ } |
513 |
my @files = grep { $_ =~ /-pref.(po|po.gz)$/ } |
1089 |
readdir $dh; |
514 |
readdir $dh; |
1090 |
@files = map { $_ =~ s/-pref.(po|po.gz)$//; $_ } @files; |
515 |
@files = map { $_ =~ s/-pref.(po|po.gz)$//r } @files; |
1091 |
} |
|
|
1092 |
|
1093 |
|
1094 |
sub update { |
1095 |
my ($self, $files) = @_; |
1096 |
my @langs = $self->{lang} ? ($self->{lang}) : $self->get_all_langs(); |
1097 |
for my $lang ( @langs ) { |
1098 |
$self->set_lang( $lang ); |
1099 |
$self->uncompress(); |
1100 |
$self->update_tmpl($files) unless $self->{pref_only}; |
1101 |
$self->update_prefs(); |
1102 |
$self->update_messages(); |
1103 |
$self->update_installer(); |
1104 |
} |
1105 |
$self->remove_pot(); |
1106 |
} |
516 |
} |
1107 |
|
517 |
|
1108 |
|
|
|
1109 |
sub create { |
1110 |
my ($self, $files) = @_; |
1111 |
return unless $self->{lang}; |
1112 |
$self->create_tmpl($files) unless $self->{pref_only}; |
1113 |
$self->create_prefs(); |
1114 |
$self->create_messages(); |
1115 |
$self->remove_pot(); |
1116 |
$self->create_installer(); |
1117 |
} |
1118 |
|
1119 |
|
1120 |
|
1121 |
1; |
518 |
1; |
1122 |
|
519 |
|
1123 |
|
520 |
|