|
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 86-91
sub new {
Link Here
|
| 86 |
chomp $self->{msgmerge}; |
89 |
chomp $self->{msgmerge}; |
| 87 |
chomp $self->{msgfmt}; |
90 |
chomp $self->{msgfmt}; |
| 88 |
chomp $self->{msginit}; |
91 |
chomp $self->{msginit}; |
|
|
92 |
chomp $self->{msgattrib}; |
| 89 |
chomp $self->{xgettext}; |
93 |
chomp $self->{xgettext}; |
| 90 |
chomp $self->{sed}; |
94 |
chomp $self->{sed}; |
| 91 |
|
95 |
|
|
Lines 141-156
sub new {
Link Here
|
| 141 |
}; |
145 |
}; |
| 142 |
} |
146 |
} |
| 143 |
|
147 |
|
|
|
148 |
# EN YAML installer files |
| 149 |
push @{$self->{installer}}, { |
| 150 |
name => "YAML installer files", |
| 151 |
dirs => [ 'installer/data/mysql/en/mandatory', |
| 152 |
'installer/data/mysql/en/optional'], |
| 153 |
suffix => "-installer.po", |
| 154 |
}; |
| 155 |
|
| 156 |
# EN MARC21 YAML installer files |
| 157 |
push @{$self->{installer}}, { |
| 158 |
name => "MARC21 YAML installer files", |
| 159 |
dirs => [ 'installer/data/mysql/en/marcflavour/marc21/mandatory', |
| 160 |
'installer/data/mysql/en/marcflavour/marc21/optional'], |
| 161 |
suffix => "-installer-MARC21.po", |
| 162 |
}; |
| 163 |
|
| 164 |
# EN UNIMARC YAML installer files |
| 165 |
push @{$self->{installer}}, { |
| 166 |
name => "UNIMARC YAML installer files", |
| 167 |
dirs => [ 'installer/data/mysql/en/marcflavour/unimarc/mandatory', ], |
| 168 |
suffix => "-installer-UNIMARC.po", |
| 169 |
}; |
| 170 |
|
| 144 |
bless $self, $class; |
171 |
bless $self, $class; |
| 145 |
} |
172 |
} |
| 146 |
|
173 |
|
| 147 |
|
174 |
|
| 148 |
sub po_filename { |
175 |
sub po_filename { |
| 149 |
my $self = shift; |
176 |
my $self = shift; |
|
|
177 |
my $suffix = shift; |
| 150 |
|
178 |
|
| 151 |
my $context = C4::Context->new; |
179 |
my $context = C4::Context->new; |
| 152 |
my $trans_path = $Bin . '/po'; |
180 |
my $trans_path = $Bin . '/po'; |
| 153 |
my $trans_file = "$trans_path/" . $self->{lang} . "-pref.po"; |
181 |
my $trans_file = "$trans_path/" . $self->{lang} . $suffix; |
| 154 |
return $trans_file; |
182 |
return $trans_file; |
| 155 |
} |
183 |
} |
| 156 |
|
184 |
|
|
Lines 277-284
sub save_po {
Link Here
|
| 277 |
$po->{''} ||= $default_pref_po_header; |
305 |
$po->{''} ||= $default_pref_po_header; |
| 278 |
|
306 |
|
| 279 |
# Write .po entries into a file put in Koha standard po directory |
307 |
# Write .po entries into a file put in Koha standard po directory |
| 280 |
Locale::PO->save_file_fromhash( $self->po_filename, $po ); |
308 |
Locale::PO->save_file_fromhash( $self->po_filename("-pref.po"), $po ); |
| 281 |
say "Saved in file: ", $self->po_filename if $self->{verbose}; |
309 |
say "Saved in file: ", $self->po_filename("-pref.po") if $self->{verbose}; |
| 282 |
} |
310 |
} |
| 283 |
|
311 |
|
| 284 |
|
312 |
|
|
Lines 290-296
sub get_po_merged_with_en {
Link Here
|
| 290 |
my $po_current = $self->{po}; |
318 |
my $po_current = $self->{po}; |
| 291 |
|
319 |
|
| 292 |
# Get po from previous generation |
320 |
# Get po from previous generation |
| 293 |
my $po_previous = Locale::PO->load_file_ashash( $self->po_filename ); |
321 |
my $po_previous = Locale::PO->load_file_ashash( $self->po_filename("-pref.po") ); |
| 294 |
|
322 |
|
| 295 |
for my $id ( keys %$po_current ) { |
323 |
for my $id ( keys %$po_current ) { |
| 296 |
my $po = $po_previous->{Locale::PO->quote($id)}; |
324 |
my $po = $po_previous->{Locale::PO->quote($id)}; |
|
Lines 431-437
sub update_tmpl {
Link Here
|
| 431 |
sub create_prefs { |
459 |
sub create_prefs { |
| 432 |
my $self = shift; |
460 |
my $self = shift; |
| 433 |
|
461 |
|
| 434 |
if ( -e $self->po_filename ) { |
462 |
if ( -e $self->po_filename("-pref.po") ) { |
| 435 |
say "Preferences .po file already exists. Delete it if you want to recreate it."; |
463 |
say "Preferences .po file already exists. Delete it if you want to recreate it."; |
| 436 |
return; |
464 |
return; |
| 437 |
} |
465 |
} |
|
Lines 439-444
sub create_prefs {
Link Here
|
| 439 |
$self->save_po(); |
467 |
$self->save_po(); |
| 440 |
} |
468 |
} |
| 441 |
|
469 |
|
|
|
470 |
sub get_po_from_target { |
| 471 |
my $self = shift; |
| 472 |
my $target = shift; |
| 473 |
|
| 474 |
my $po; |
| 475 |
my $po_head = new Locale::PO; |
| 476 |
$po_head->{msgid} = "\"\""; |
| 477 |
$po_head->{msgstr} = "". |
| 478 |
"Project-Id-Version: Koha Project - Installation files\\n" . |
| 479 |
"PO-Revision-Date: YEAR-MO-DA HO:MI +ZONE\\n" . |
| 480 |
"Last-Translator: FULL NAME <EMAIL\@ADDRESS>\\n" . |
| 481 |
"Language-Team: Koha Translation Team\\n" . |
| 482 |
"Language: ".$self->{lang}."\\n" . |
| 483 |
"MIME-Version: 1.0\\n" . |
| 484 |
"Content-Type: text/plain; charset=UTF-8\\n" . |
| 485 |
"Content-Transfer-Encoding: 8bit\\n"; |
| 486 |
|
| 487 |
my @dirs = @{ $target->{dirs} }; |
| 488 |
my $intradir = $self->{context}->config('intranetdir'); |
| 489 |
for my $dir ( @dirs ) { # each dir |
| 490 |
opendir( my $dh, "$intradir/$dir" ) or die ("Can't open $intradir/$dir"); |
| 491 |
my @filelist = grep { $_ =~ m/\.yml/ } readdir($dh); # Just yaml files |
| 492 |
close($dh); |
| 493 |
for my $file ( @filelist ) { # each file |
| 494 |
my $yaml = LoadFile( "$intradir/$dir/$file" ); |
| 495 |
my @tables = @{ $yaml->{'tables'} }; |
| 496 |
my $tablec; |
| 497 |
for my $table ( @tables ) { # each table |
| 498 |
$tablec++; |
| 499 |
my $table_name = ( keys %$table )[0]; |
| 500 |
my @translatable = @{ $table->{$table_name}->{translatable} }; |
| 501 |
my @rows = @{ $table->{$table_name}->{rows} }; |
| 502 |
my @multiline = @{ $table->{$table_name}->{'multiline'} }; # to check multiline values |
| 503 |
my $rowc; |
| 504 |
for my $row ( @rows ) { # each row |
| 505 |
$rowc++; |
| 506 |
for my $field ( @translatable ) { # each field |
| 507 |
if ( @multiline and grep { $_ eq $field } @multiline ) { # multiline fields, only notices ATM |
| 508 |
my $mulc; |
| 509 |
foreach my $line ( @{$row->{$field}} ) { |
| 510 |
$mulc++; |
| 511 |
next if ( $line =~ /^(\s*<.*?>\s*$|^\s*\[.*?\]\s*|\s*)$/ ); # discard pure html, TT, empty |
| 512 |
$line =~ s/(<<.*?>>|\[\%.*?\%\]|<.*?>)/\%s/g; # put placeholders |
| 513 |
next if ( $line =~ /^(\s|%s|-|[[:punct:]]|\(|\))*$/ or length($line) < 2 ); # discard non strings |
| 514 |
if ( not $po->{ $line } ) { |
| 515 |
my $msg = new Locale::PO( |
| 516 |
-msgid => $line, -msgstr => '', |
| 517 |
-reference => "$dir/$file:$table_name:$tablec:row:$rowc:mul:$mulc" ); |
| 518 |
$po->{ $line } = $msg; |
| 519 |
} |
| 520 |
} |
| 521 |
} else { |
| 522 |
if ( length($row->{$field}) > 1 # discard small strings |
| 523 |
and not $po->{ $row->{$field} } ) { |
| 524 |
my $msg = new Locale::PO( |
| 525 |
-msgid => $row->{$field}, -msgstr => '', |
| 526 |
-reference => "$dir/$file:$table_name:$tablec:row:$rowc" ); |
| 527 |
$po->{ $row->{$field} } = $msg; |
| 528 |
} |
| 529 |
} |
| 530 |
} |
| 531 |
} |
| 532 |
} |
| 533 |
my $desccount; |
| 534 |
for my $description ( @{ $yaml->{'description'} } ) { |
| 535 |
$desccount++; |
| 536 |
if ( length($description) > 1 and not $po->{ $description } ) { |
| 537 |
my $msg = new Locale::PO( |
| 538 |
-msgid => $description, -msgstr => '', |
| 539 |
-reference => "$dir/$file:description:$desccount" ); |
| 540 |
$po->{ $description } = $msg; |
| 541 |
} |
| 542 |
} |
| 543 |
} |
| 544 |
} |
| 545 |
$po->{''} = $po_head if ( $po ); |
| 546 |
|
| 547 |
return $po; |
| 548 |
} |
| 549 |
|
| 550 |
sub create_installer { |
| 551 |
my $self = shift; |
| 552 |
return unless ( $self->{installer} ); |
| 553 |
|
| 554 |
say "Create installer translation files\n" if $self->{verbose}; |
| 555 |
|
| 556 |
my @targets = @{ $self->{installer} }; # each installer target (common,marc21,unimarc) |
| 557 |
|
| 558 |
for my $target ( @targets ) { |
| 559 |
if ( -e $self->po_filename( $target->{suffix} ) ) { |
| 560 |
say "$self->{lang}$target->{suffix} file already exists. Delete it if you want to recreate it."; |
| 561 |
return; |
| 562 |
} |
| 563 |
} |
| 564 |
|
| 565 |
for my $target ( @targets ) { |
| 566 |
my $po = get_po_from_target( $self, $target ); |
| 567 |
# create output file only if there is something to write |
| 568 |
if ( $po ) { |
| 569 |
my $po_file = $self->po_filename( $target->{suffix} ); |
| 570 |
Locale::PO->save_file_fromhash( $po_file, $po ); |
| 571 |
say "Saved in file: ", $po_file if $self->{verbose}; |
| 572 |
} |
| 573 |
} |
| 574 |
} |
| 575 |
|
| 576 |
sub update_installer { |
| 577 |
my $self = shift; |
| 578 |
return unless ( $self->{installer} ); |
| 579 |
|
| 580 |
say "Update installer translation files\n" if $self->{verbose}; |
| 581 |
|
| 582 |
my @targets = @{ $self->{installer} }; # each installer target (common,marc21,unimarc) |
| 583 |
|
| 584 |
for my $target ( @targets ) { |
| 585 |
return unless ( -e $self->po_filename( $target->{suffix} ) ); |
| 586 |
my $po = get_po_from_target( $self, $target ); |
| 587 |
# update file only if there is something to update |
| 588 |
if ( $po ) { |
| 589 |
my ( $fh, $po_temp ) = tempfile(); |
| 590 |
binmode( $fh, ":encoding(UTF-8)" ); |
| 591 |
Locale::PO->save_file_fromhash( $po_temp, $po ); |
| 592 |
my $po_file = $self->po_filename( $target->{suffix} ); |
| 593 |
eval { |
| 594 |
my $st = system($self->{msgmerge}." ".($self->{verbose}?'':'-q'). |
| 595 |
" -s $po_file $po_temp -o - | ".$self->{msgattrib}." --no-obsolete -o $po_file"); |
| 596 |
}; |
| 597 |
say "Updated file: ", $po_file if $self->{verbose}; |
| 598 |
} |
| 599 |
} |
| 600 |
} |
| 601 |
|
| 602 |
sub translate_yaml { |
| 603 |
my $self = shift; |
| 604 |
my $target = shift; |
| 605 |
my $srcyml = shift; |
| 606 |
|
| 607 |
my $po_file = $self->po_filename( $target->{suffix} ); |
| 608 |
return $srcyml unless ( -e $po_file ); |
| 609 |
|
| 610 |
my $po_ref = Locale::PO->load_file_ashash( $po_file ); |
| 611 |
|
| 612 |
my $dstyml = LoadFile( $srcyml ); |
| 613 |
|
| 614 |
# translate fields in table rows |
| 615 |
my @tables = @{ $dstyml->{'tables'} }; |
| 616 |
for my $table ( @tables ) { # each table |
| 617 |
my $table_name = ( keys %$table )[0]; |
| 618 |
my @translatable = @{ $table->{$table_name}->{translatable} }; |
| 619 |
my @rows = @{ $table->{$table_name}->{rows} }; |
| 620 |
my @multiline = @{ $table->{$table_name}->{'multiline'} }; # to check multiline values |
| 621 |
for my $row ( @rows ) { # each row |
| 622 |
for my $field ( @translatable ) { # each translatable field |
| 623 |
if ( @multiline and grep { $_ eq $field } @multiline ) { # multiline fields, only notices ATM |
| 624 |
foreach my $line ( @{$row->{$field}} ) { |
| 625 |
next if ( $line =~ /^(\s*<.*?>\s*$|^\s*\[.*?\]\s*|\s*)$/ ); # discard pure html, TT, empty |
| 626 |
my @ttvar; |
| 627 |
while ( $line =~ s/(<<.*?>>|\[\%.*?\%\]|<.*?>)/\%s/ ) { # put placeholders, save matches |
| 628 |
my $var = $1; |
| 629 |
push @ttvar, $var; |
| 630 |
} |
| 631 |
|
| 632 |
if ( $line =~ /^(\s|%s|-|[[:punct:]]|\(|\))*$/ ) { # ignore non strings |
| 633 |
while ( @ttvar ) { # restore placeholders |
| 634 |
my $var = shift @ttvar; |
| 635 |
$line =~ s/\%s/$var/; |
| 636 |
} |
| 637 |
next; |
| 638 |
} else { |
| 639 |
my $po = $po_ref->{"\"$line\""}; # quoted key |
| 640 |
if ( $po and not defined( $po->fuzzy() ) # not fuzzy |
| 641 |
and length( $po->msgid() ) > 2 # not empty msgid |
| 642 |
and length( $po->msgstr() ) > 2 ) { # not empty msgstr |
| 643 |
$line = $po->dequote( $po->msgstr() ); |
| 644 |
} |
| 645 |
while ( @ttvar ) { # restore placeholders |
| 646 |
my $var = shift @ttvar; |
| 647 |
$line =~ s/\%s/$var/; |
| 648 |
} |
| 649 |
} |
| 650 |
} |
| 651 |
} else { |
| 652 |
my $po = $po_ref->{"\"$row->{$field}\""}; # quoted key |
| 653 |
if ( $po and not defined( $po->fuzzy() ) # not fuzzy |
| 654 |
and length( $po->msgid() ) > 2 # not empty msgid |
| 655 |
and length( $po->msgstr() ) > 2 ) { # not empty msgstr |
| 656 |
$row->{$field} = $po->dequote( $po->msgstr() ); |
| 657 |
} |
| 658 |
} |
| 659 |
} |
| 660 |
} |
| 661 |
} |
| 662 |
|
| 663 |
# translate descriptions |
| 664 |
for my $description ( @{ $dstyml->{'description'} } ) { |
| 665 |
my $po = $po_ref->{"\"$description\""}; |
| 666 |
if ( $po and not defined( $po->fuzzy() ) |
| 667 |
and length( $po->msgid() ) > 2 |
| 668 |
and length( $po->msgstr() ) > 2 ) { |
| 669 |
$description = $po->dequote( $po->msgstr() ); |
| 670 |
} |
| 671 |
} |
| 672 |
|
| 673 |
return $dstyml; |
| 674 |
} |
| 675 |
|
| 676 |
sub install_installer { |
| 677 |
my $self = shift; |
| 678 |
return unless ( $self->{installer} ); |
| 679 |
|
| 680 |
my $intradir = $self->{context}->config('intranetdir'); |
| 681 |
my $db_scheme = $self->{context}->config('db_scheme'); |
| 682 |
my $langdir = "$intradir/installer/data/$db_scheme/$self->{lang}"; |
| 683 |
if ( -d $langdir ) { |
| 684 |
say "$self->{lang} installer dir $langdir already exists.\nDelete it if you want to recreate it."; |
| 685 |
return; |
| 686 |
} |
| 687 |
|
| 688 |
say "Install installer files\n" if $self->{verbose}; |
| 689 |
|
| 690 |
for my $target ( @{ $self->{installer} } ) { |
| 691 |
return unless ( -e $self->po_filename( $target->{suffix} ) ); |
| 692 |
for my $dir ( @{ $target->{dirs} } ) { |
| 693 |
( my $tdir = "$dir" ) =~ s|/en/|/$self->{lang}/|; |
| 694 |
make_path("$intradir/$tdir"); |
| 695 |
|
| 696 |
opendir( my $dh, "$intradir/$dir" ) or die ("Can't open $intradir/$dir"); |
| 697 |
my @files = grep { ! /^\.+$/ } readdir($dh); |
| 698 |
close($dh); |
| 699 |
|
| 700 |
for my $file ( @files ) { |
| 701 |
if ( $file =~ /yml$/ ) { |
| 702 |
my $translated_yaml = translate_yaml( $self, $target, "$intradir/$dir/$file" ); |
| 703 |
open(my $fh, ">:encoding(UTF-8)", "$intradir/$tdir/$file"); |
| 704 |
DumpFile( $fh, $translated_yaml ); |
| 705 |
close($fh); |
| 706 |
} else { |
| 707 |
File::Copy::copy( "$intradir/$dir/$file", "$intradir/$tdir/$file" ); |
| 708 |
} |
| 709 |
} |
| 710 |
} |
| 711 |
} |
| 712 |
} |
| 442 |
|
713 |
|
| 443 |
sub create_tmpl { |
714 |
sub create_tmpl { |
| 444 |
my ($self, $files) = @_; |
715 |
my ($self, $files) = @_; |
|
Lines 773-778
sub install {
Link Here
|
| 773 |
$self->install_prefs(); |
1044 |
$self->install_prefs(); |
| 774 |
$self->install_messages(); |
1045 |
$self->install_messages(); |
| 775 |
$self->remove_pot(); |
1046 |
$self->remove_pot(); |
|
|
1047 |
$self->install_installer(); |
| 776 |
} |
1048 |
} |
| 777 |
|
1049 |
|
| 778 |
|
1050 |
|
|
Lines 793-798
sub update {
Link Here
|
| 793 |
$self->update_tmpl($files) unless $self->{pref_only}; |
1065 |
$self->update_tmpl($files) unless $self->{pref_only}; |
| 794 |
$self->update_prefs(); |
1066 |
$self->update_prefs(); |
| 795 |
$self->update_messages(); |
1067 |
$self->update_messages(); |
|
|
1068 |
$self->update_installer(); |
| 796 |
} |
1069 |
} |
| 797 |
$self->remove_pot(); |
1070 |
$self->remove_pot(); |
| 798 |
} |
1071 |
} |
|
Lines 805-810
sub create {
Link Here
|
| 805 |
$self->create_prefs(); |
1078 |
$self->create_prefs(); |
| 806 |
$self->create_messages(); |
1079 |
$self->create_messages(); |
| 807 |
$self->remove_pot(); |
1080 |
$self->remove_pot(); |
|
|
1081 |
$self->create_installer(); |
| 808 |
} |
1082 |
} |
| 809 |
|
1083 |
|
| 810 |
|
1084 |
|
| 811 |
- |
|
|