Lines 22-39
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 ); |
25 |
use YAML::Syck qw( Dump 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; |
29 |
use File::Find; |
30 |
use File::Path qw( make_path ); |
30 |
use File::Path qw( make_path ); |
|
|
31 |
use File::Copy; |
31 |
use File::Slurp; |
32 |
use File::Slurp; |
32 |
use File::Spec; |
33 |
use File::Spec; |
33 |
use File::Temp qw( tempdir ); |
34 |
use File::Temp qw( tempdir tempfile ); |
34 |
use Template::Parser; |
35 |
use Template::Parser; |
35 |
use PPI; |
36 |
use PPI; |
36 |
|
37 |
|
|
|
38 |
|
37 |
$YAML::Syck::ImplicitTyping = 1; |
39 |
$YAML::Syck::ImplicitTyping = 1; |
38 |
|
40 |
|
39 |
|
41 |
|
Lines 79-84
sub new {
Link Here
|
79 |
$self->{msgmerge} = `which msgmerge`; |
81 |
$self->{msgmerge} = `which msgmerge`; |
80 |
$self->{msgfmt} = `which msgfmt`; |
82 |
$self->{msgfmt} = `which msgfmt`; |
81 |
$self->{msginit} = `which msginit`; |
83 |
$self->{msginit} = `which msginit`; |
|
|
84 |
$self->{msgattrib} = `which msgattrib`; |
82 |
$self->{xgettext} = `which xgettext`; |
85 |
$self->{xgettext} = `which xgettext`; |
83 |
$self->{sed} = `which sed`; |
86 |
$self->{sed} = `which sed`; |
84 |
$self->{po2json} = "$Bin/po2json"; |
87 |
$self->{po2json} = "$Bin/po2json"; |
Lines 88-93
sub new {
Link Here
|
88 |
chomp $self->{msgmerge}; |
91 |
chomp $self->{msgmerge}; |
89 |
chomp $self->{msgfmt}; |
92 |
chomp $self->{msgfmt}; |
90 |
chomp $self->{msginit}; |
93 |
chomp $self->{msginit}; |
|
|
94 |
chomp $self->{msgattrib}; |
91 |
chomp $self->{xgettext}; |
95 |
chomp $self->{xgettext}; |
92 |
chomp $self->{sed}; |
96 |
chomp $self->{sed}; |
93 |
chomp $self->{gzip}; |
97 |
chomp $self->{gzip}; |
Lines 145-160
sub new {
Link Here
|
145 |
}; |
149 |
}; |
146 |
} |
150 |
} |
147 |
|
151 |
|
|
|
152 |
# EN YAML installer files |
153 |
push @{$self->{installer}}, { |
154 |
name => "YAML installer files", |
155 |
dirs => [ 'installer/data/mysql/en/mandatory', |
156 |
'installer/data/mysql/en/optional'], |
157 |
suffix => "-installer.po", |
158 |
}; |
159 |
|
160 |
# EN MARC21 YAML installer files |
161 |
push @{$self->{installer}}, { |
162 |
name => "MARC21 YAML installer files", |
163 |
dirs => [ 'installer/data/mysql/en/marcflavour/marc21/mandatory', |
164 |
'installer/data/mysql/en/marcflavour/marc21/optional'], |
165 |
suffix => "-installer-MARC21.po", |
166 |
}; |
167 |
|
168 |
# EN UNIMARC YAML installer files |
169 |
push @{$self->{installer}}, { |
170 |
name => "UNIMARC YAML installer files", |
171 |
dirs => [ 'installer/data/mysql/en/marcflavour/unimarc/mandatory', ], |
172 |
suffix => "-installer-UNIMARC.po", |
173 |
}; |
174 |
|
148 |
bless $self, $class; |
175 |
bless $self, $class; |
149 |
} |
176 |
} |
150 |
|
177 |
|
151 |
|
178 |
|
152 |
sub po_filename { |
179 |
sub po_filename { |
153 |
my $self = shift; |
180 |
my $self = shift; |
|
|
181 |
my $suffix = shift; |
154 |
|
182 |
|
155 |
my $context = C4::Context->new; |
183 |
my $context = C4::Context->new; |
156 |
my $trans_path = $Bin . '/po'; |
184 |
my $trans_path = $Bin . '/po'; |
157 |
my $trans_file = "$trans_path/" . $self->{lang} . "-pref.po"; |
185 |
my $trans_file = "$trans_path/" . $self->{lang} . $suffix; |
158 |
return $trans_file; |
186 |
return $trans_file; |
159 |
} |
187 |
} |
160 |
|
188 |
|
Lines 281-288
sub save_po {
Link Here
|
281 |
$po->{''} ||= $default_pref_po_header; |
309 |
$po->{''} ||= $default_pref_po_header; |
282 |
|
310 |
|
283 |
# Write .po entries into a file put in Koha standard po directory |
311 |
# Write .po entries into a file put in Koha standard po directory |
284 |
Locale::PO->save_file_fromhash( $self->po_filename, $po ); |
312 |
Locale::PO->save_file_fromhash( $self->po_filename("-pref.po"), $po ); |
285 |
say "Saved in file: ", $self->po_filename if $self->{verbose}; |
313 |
say "Saved in file: ", $self->po_filename("-pref.po") if $self->{verbose}; |
286 |
} |
314 |
} |
287 |
|
315 |
|
288 |
|
316 |
|
Lines 294-300
sub get_po_merged_with_en {
Link Here
|
294 |
my $po_current = $self->{po}; |
322 |
my $po_current = $self->{po}; |
295 |
|
323 |
|
296 |
# Get po from previous generation |
324 |
# Get po from previous generation |
297 |
my $po_previous = Locale::PO->load_file_ashash( $self->po_filename ); |
325 |
my $po_previous = Locale::PO->load_file_ashash( $self->po_filename("-pref.po") ); |
298 |
|
326 |
|
299 |
for my $id ( keys %$po_current ) { |
327 |
for my $id ( keys %$po_current ) { |
300 |
my $po = $po_previous->{Locale::PO->quote($id)}; |
328 |
my $po = $po_previous->{Locale::PO->quote($id)}; |
Lines 435-441
sub update_tmpl {
Link Here
|
435 |
sub create_prefs { |
463 |
sub create_prefs { |
436 |
my $self = shift; |
464 |
my $self = shift; |
437 |
|
465 |
|
438 |
if ( -e $self->po_filename ) { |
466 |
if ( -e $self->po_filename("-pref.po") ) { |
439 |
say "Preferences .po file already exists. Delete it if you want to recreate it."; |
467 |
say "Preferences .po file already exists. Delete it if you want to recreate it."; |
440 |
return; |
468 |
return; |
441 |
} |
469 |
} |
Lines 443-448
sub create_prefs {
Link Here
|
443 |
$self->save_po(); |
471 |
$self->save_po(); |
444 |
} |
472 |
} |
445 |
|
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 ( length($row->{$field}) > 1 # discard 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 { |
607 |
my $self = shift; |
608 |
my $target = shift; |
609 |
my $srcyml = shift; |
610 |
|
611 |
my $po_file = $self->po_filename( $target->{suffix} ); |
612 |
return $srcyml unless ( -e $po_file ); |
613 |
|
614 |
my $po_ref = Locale::PO->load_file_ashash( $po_file ); |
615 |
|
616 |
my $dstyml = LoadFile( $srcyml ); |
617 |
|
618 |
# translate fields in table rows |
619 |
my @tables = @{ $dstyml->{'tables'} }; |
620 |
for my $table ( @tables ) { # each table |
621 |
my $table_name = ( keys %$table )[0]; |
622 |
my @translatable = @{ $table->{$table_name}->{translatable} }; |
623 |
my @rows = @{ $table->{$table_name}->{rows} }; |
624 |
my @multiline = @{ $table->{$table_name}->{'multiline'} }; # to check multiline values |
625 |
for my $row ( @rows ) { # each row |
626 |
for my $field ( @translatable ) { # each translatable field |
627 |
if ( @multiline and grep { $_ eq $field } @multiline ) { # multiline fields, only notices ATM |
628 |
foreach my $line ( @{$row->{$field}} ) { |
629 |
next if ( $line =~ /^(\s*<.*?>\s*$|^\s*\[.*?\]\s*|\s*)$/ ); # discard pure html, TT, empty |
630 |
my @ttvar; |
631 |
while ( $line =~ s/(<<.*?>>|\[\%.*?\%\]|<.*?>)/\%s/ ) { # put placeholders, save matches |
632 |
my $var = $1; |
633 |
push @ttvar, $var; |
634 |
} |
635 |
|
636 |
if ( $line =~ /^(\s|%s|-|[[:punct:]]|\(|\))*$/ ) { # ignore non strings |
637 |
while ( @ttvar ) { # restore placeholders |
638 |
my $var = shift @ttvar; |
639 |
$line =~ s/\%s/$var/; |
640 |
} |
641 |
next; |
642 |
} else { |
643 |
my $po = $po_ref->{"\"$line\""}; # quoted key |
644 |
if ( $po and not defined( $po->fuzzy() ) # not fuzzy |
645 |
and length( $po->msgid() ) > 2 # not empty msgid |
646 |
and length( $po->msgstr() ) > 2 ) { # not empty msgstr |
647 |
$line = $po->dequote( $po->msgstr() ); |
648 |
} |
649 |
while ( @ttvar ) { # restore placeholders |
650 |
my $var = shift @ttvar; |
651 |
$line =~ s/\%s/$var/; |
652 |
} |
653 |
} |
654 |
} |
655 |
} else { |
656 |
my $po = $po_ref->{"\"$row->{$field}\""}; # quoted key |
657 |
if ( $po and not defined( $po->fuzzy() ) # not fuzzy |
658 |
and length( $po->msgid() ) > 2 # not empty msgid |
659 |
and length( $po->msgstr() ) > 2 ) { # not empty msgstr |
660 |
$row->{$field} = $po->dequote( $po->msgstr() ); |
661 |
} |
662 |
} |
663 |
} |
664 |
} |
665 |
} |
666 |
|
667 |
# translate descriptions |
668 |
for my $description ( @{ $dstyml->{'description'} } ) { |
669 |
my $po = $po_ref->{"\"$description\""}; |
670 |
if ( $po and not defined( $po->fuzzy() ) |
671 |
and length( $po->msgid() ) > 2 |
672 |
and length( $po->msgstr() ) > 2 ) { |
673 |
$description = $po->dequote( $po->msgstr() ); |
674 |
} |
675 |
} |
676 |
|
677 |
return $dstyml; |
678 |
} |
679 |
|
680 |
sub install_installer { |
681 |
my $self = shift; |
682 |
return unless ( $self->{installer} ); |
683 |
|
684 |
my $intradir = $self->{context}->config('intranetdir'); |
685 |
my $db_scheme = $self->{context}->config('db_scheme'); |
686 |
my $langdir = "$intradir/installer/data/$db_scheme/$self->{lang}"; |
687 |
if ( -d $langdir ) { |
688 |
say "$self->{lang} installer dir $langdir already exists.\nDelete it if you want to recreate it."; |
689 |
return; |
690 |
} |
691 |
|
692 |
say "Install installer files\n" if $self->{verbose}; |
693 |
|
694 |
for my $target ( @{ $self->{installer} } ) { |
695 |
return unless ( -e $self->po_filename( $target->{suffix} ) ); |
696 |
for my $dir ( @{ $target->{dirs} } ) { |
697 |
( my $tdir = "$dir" ) =~ s|/en/|/$self->{lang}/|; |
698 |
make_path("$intradir/$tdir"); |
699 |
|
700 |
opendir( my $dh, "$intradir/$dir" ) or die ("Can't open $intradir/$dir"); |
701 |
my @files = grep { ! /^\.+$/ } readdir($dh); |
702 |
close($dh); |
703 |
|
704 |
for my $file ( @files ) { |
705 |
if ( $file =~ /yml$/ ) { |
706 |
my $translated_yaml = translate_yaml( $self, $target, "$intradir/$dir/$file" ); |
707 |
open(my $fh, ">:encoding(UTF-8)", "$intradir/$tdir/$file"); |
708 |
DumpFile( $fh, $translated_yaml ); |
709 |
close($fh); |
710 |
} else { |
711 |
File::Copy::copy( "$intradir/$dir/$file", "$intradir/$tdir/$file" ); |
712 |
} |
713 |
} |
714 |
} |
715 |
} |
716 |
} |
446 |
|
717 |
|
447 |
sub create_tmpl { |
718 |
sub create_tmpl { |
448 |
my ($self, $files) = @_; |
719 |
my ($self, $files) = @_; |
Lines 806-811
sub install {
Link Here
|
806 |
$self->install_prefs(); |
1077 |
$self->install_prefs(); |
807 |
$self->install_messages(); |
1078 |
$self->install_messages(); |
808 |
$self->remove_pot(); |
1079 |
$self->remove_pot(); |
|
|
1080 |
$self->install_installer(); |
809 |
} |
1081 |
} |
810 |
|
1082 |
|
811 |
|
1083 |
|
Lines 827-832
sub update {
Link Here
|
827 |
$self->update_tmpl($files) unless $self->{pref_only}; |
1099 |
$self->update_tmpl($files) unless $self->{pref_only}; |
828 |
$self->update_prefs(); |
1100 |
$self->update_prefs(); |
829 |
$self->update_messages(); |
1101 |
$self->update_messages(); |
|
|
1102 |
$self->update_installer(); |
830 |
} |
1103 |
} |
831 |
$self->remove_pot(); |
1104 |
$self->remove_pot(); |
832 |
} |
1105 |
} |
Lines 839-844
sub create {
Link Here
|
839 |
$self->create_prefs(); |
1112 |
$self->create_prefs(); |
840 |
$self->create_messages(); |
1113 |
$self->create_messages(); |
841 |
$self->remove_pot(); |
1114 |
$self->remove_pot(); |
|
|
1115 |
$self->create_installer(); |
842 |
} |
1116 |
} |
843 |
|
1117 |
|
844 |
|
1118 |
|
845 |
- |
|
|