|
Lines 25-30
use C4::Context;
Link Here
|
| 25 |
use YAML::Syck qw( Dump LoadFile ); |
25 |
use YAML::Syck qw( Dump LoadFile ); |
| 26 |
use Locale::PO; |
26 |
use Locale::PO; |
| 27 |
use FindBin qw( $Bin ); |
27 |
use FindBin qw( $Bin ); |
|
|
28 |
use File::Basename; |
| 29 |
use File::Find; |
| 30 |
use File::Path qw( make_path ); |
| 31 |
use File::Slurp; |
| 32 |
use File::Temp qw( tempdir ); |
| 33 |
use Template::Parser; |
| 34 |
use PPI; |
| 28 |
|
35 |
|
| 29 |
$YAML::Syck::ImplicitTyping = 1; |
36 |
$YAML::Syck::ImplicitTyping = 1; |
| 30 |
|
37 |
|
|
Lines 66-78
sub new {
Link Here
|
| 66 |
$self->{process} = "$Bin/tmpl_process3.pl " . ($verbose ? '' : '-q'); |
73 |
$self->{process} = "$Bin/tmpl_process3.pl " . ($verbose ? '' : '-q'); |
| 67 |
$self->{path_po} = "$Bin/po"; |
74 |
$self->{path_po} = "$Bin/po"; |
| 68 |
$self->{po} = { '' => $default_pref_po_header }; |
75 |
$self->{po} = { '' => $default_pref_po_header }; |
| 69 |
$self->{domain} = 'messages'; |
76 |
$self->{domain} = 'Koha'; |
| 70 |
$self->{cp} = `which cp`; |
77 |
$self->{cp} = `which cp`; |
| 71 |
$self->{msgmerge} = `which msgmerge`; |
78 |
$self->{msgmerge} = `which msgmerge`; |
|
|
79 |
$self->{msgfmt} = `which msgfmt`; |
| 80 |
$self->{msginit} = `which msginit`; |
| 72 |
$self->{xgettext} = `which xgettext`; |
81 |
$self->{xgettext} = `which xgettext`; |
| 73 |
$self->{sed} = `which sed`; |
82 |
$self->{sed} = `which sed`; |
| 74 |
chomp $self->{cp}; |
83 |
chomp $self->{cp}; |
| 75 |
chomp $self->{msgmerge}; |
84 |
chomp $self->{msgmerge}; |
|
|
85 |
chomp $self->{msgfmt}; |
| 86 |
chomp $self->{msginit}; |
| 76 |
chomp $self->{xgettext}; |
87 |
chomp $self->{xgettext}; |
| 77 |
chomp $self->{sed}; |
88 |
chomp $self->{sed}; |
| 78 |
|
89 |
|
|
Lines 468-497
sub create_tmpl {
Link Here
|
| 468 |
} |
479 |
} |
| 469 |
} |
480 |
} |
| 470 |
|
481 |
|
|
|
482 |
sub locale_name { |
| 483 |
my $self = shift; |
| 484 |
|
| 485 |
my ($language, $region, $country) = split /-/, $self->{lang}; |
| 486 |
$country //= $region; |
| 487 |
my $locale = $language; |
| 488 |
if ($country && length($country) == 2) { |
| 489 |
$locale .= '_' . $country; |
| 490 |
} |
| 491 |
|
| 492 |
return $locale; |
| 493 |
} |
| 494 |
|
| 471 |
sub create_messages { |
495 |
sub create_messages { |
| 472 |
my $self = shift; |
496 |
my $self = shift; |
| 473 |
|
497 |
|
| 474 |
print "Create messages ($self->{lang})\n" if $self->{verbose}; |
498 |
my $pot = "$self->{domain}.pot"; |
| 475 |
system |
499 |
my $po = "$self->{path_po}/$self->{lang}-messages.po"; |
| 476 |
"$self->{cp} $self->{domain}.pot " . |
500 |
|
| 477 |
"$self->{path_po}/$self->{lang}-$self->{domain}.po"; |
501 |
unless ( -f $pot ) { |
|
|
502 |
$self->extract_messages(); |
| 503 |
} |
| 504 |
|
| 505 |
say "Create messages ($self->{lang})" if $self->{verbose}; |
| 506 |
my $locale = $self->locale_name(); |
| 507 |
system "$self->{msginit} -i $pot -o $po -l $locale --no-translator"; |
| 508 |
|
| 509 |
# If msginit failed to correctly set Plural-Forms, set a default one |
| 510 |
system "$self->{sed} --in-place $po " |
| 511 |
. "--expression='s/Plural-Forms: nplurals=INTEGER; plural=EXPRESSION/Plural-Forms: nplurals=2; plural=(n != 1)/'"; |
| 478 |
} |
512 |
} |
| 479 |
|
513 |
|
| 480 |
sub update_messages { |
514 |
sub update_messages { |
| 481 |
my $self = shift; |
515 |
my $self = shift; |
| 482 |
|
516 |
|
| 483 |
my $pofile = "$self->{path_po}/$self->{lang}-$self->{domain}.po"; |
517 |
my $pot = "$self->{domain}.pot"; |
| 484 |
print "Update messages ($self->{lang})\n" if $self->{verbose}; |
518 |
my $po = "$self->{path_po}/$self->{lang}-messages.po"; |
| 485 |
if ( not -f $pofile ) { |
519 |
|
| 486 |
print "File $pofile does not exist\n" if $self->{verbose}; |
520 |
unless ( -f $pot ) { |
|
|
521 |
$self->extract_messages(); |
| 522 |
} |
| 523 |
|
| 524 |
if ( -f $po ) { |
| 525 |
say "Update messages ($self->{lang})" if $self->{verbose}; |
| 526 |
system "$self->{msgmerge} -U $po $pot"; |
| 527 |
} else { |
| 487 |
$self->create_messages(); |
528 |
$self->create_messages(); |
| 488 |
} |
529 |
} |
| 489 |
system "$self->{msgmerge} -U $pofile $self->{domain}.pot"; |
530 |
} |
|
|
531 |
|
| 532 |
sub extract_messages_from_templates { |
| 533 |
my ($self, $tempdir, @files) = @_; |
| 534 |
|
| 535 |
my $intranetdir = $self->{context}->config('intranetdir'); |
| 536 |
my @keywords = qw(t tx tn txn tnx tp tpx tnp tnpx); |
| 537 |
my $parser = Template::Parser->new(); |
| 538 |
|
| 539 |
foreach my $file (@files) { |
| 540 |
say "Extract messages from $file" if $self->{verbose}; |
| 541 |
my $template = read_file("$intranetdir/$file"); |
| 542 |
my $data = $parser->parse($template); |
| 543 |
unless ($data) { |
| 544 |
warn "Error at $file : " . $parser->error(); |
| 545 |
next; |
| 546 |
} |
| 547 |
|
| 548 |
make_path(dirname("$tempdir/$file")); |
| 549 |
open my $fh, '>', "$tempdir/$file"; |
| 550 |
|
| 551 |
my @blocks = ($data->{BLOCK}, values %{ $data->{DEFBLOCKS} }); |
| 552 |
foreach my $block (@blocks) { |
| 553 |
my $document = PPI::Document->new(\$block); |
| 554 |
|
| 555 |
# [% t('foo') %] is compiled to |
| 556 |
# $output .= $stash->get(['t', ['foo']]); |
| 557 |
# We try to find all nodes corresponding to keyword (here 't') |
| 558 |
my $nodes = $document->find(sub { |
| 559 |
my ($topnode, $element) = @_; |
| 560 |
|
| 561 |
# Filter out non-valid keywords |
| 562 |
return 0 unless ($element->isa('PPI::Token::Quote::Single')); |
| 563 |
return 0 unless (grep {$element->content eq qq{'$_'}} @keywords); |
| 564 |
|
| 565 |
# keyword (e.g. 't') should be the first element of the arrayref |
| 566 |
# passed to $stash->get() |
| 567 |
return 0 if $element->sprevious_sibling; |
| 568 |
|
| 569 |
return 0 unless $element->snext_sibling |
| 570 |
&& $element->snext_sibling->snext_sibling |
| 571 |
&& $element->snext_sibling->snext_sibling->isa('PPI::Structure::Constructor'); |
| 572 |
|
| 573 |
# Check that it's indeed a call to $stash->get() |
| 574 |
my $statement = $element->statement->parent->statement->parent->statement; |
| 575 |
return 0 unless grep { $_->isa('PPI::Token::Symbol') && $_->content eq '$stash' } $statement->children; |
| 576 |
return 0 unless grep { $_->isa('PPI::Token::Operator') && $_->content eq '->' } $statement->children; |
| 577 |
return 0 unless grep { $_->isa('PPI::Token::Word') && $_->content eq 'get' } $statement->children; |
| 578 |
|
| 579 |
return 1; |
| 580 |
}); |
| 581 |
|
| 582 |
next unless $nodes; |
| 583 |
|
| 584 |
# Write the Perl equivalent of calls to t* functions family, so |
| 585 |
# xgettext can extract the strings correctly |
| 586 |
foreach my $node (@$nodes) { |
| 587 |
my @args = map { |
| 588 |
$_->significant && !$_->isa('PPI::Token::Operator') ? $_->content : () |
| 589 |
} $node->snext_sibling->snext_sibling->find_first('PPI::Statement')->children; |
| 590 |
|
| 591 |
my $keyword = $node->content; |
| 592 |
$keyword =~ s/^'t(.*)'$/__$1/; |
| 593 |
|
| 594 |
say $fh "$keyword(" . join(', ', @args) . ");"; |
| 595 |
} |
| 596 |
|
| 597 |
} |
| 598 |
|
| 599 |
close $fh; |
| 600 |
} |
| 601 |
|
| 602 |
return $tempdir; |
| 490 |
} |
603 |
} |
| 491 |
|
604 |
|
| 492 |
sub extract_messages { |
605 |
sub extract_messages { |
| 493 |
my $self = shift; |
606 |
my $self = shift; |
| 494 |
|
607 |
|
|
|
608 |
say "Extract messages into POT file" if $self->{verbose}; |
| 609 |
|
| 495 |
my $intranetdir = $self->{context}->config('intranetdir'); |
610 |
my $intranetdir = $self->{context}->config('intranetdir'); |
| 496 |
my @files_to_scan; |
611 |
my @files_to_scan; |
| 497 |
my @directories_to_scan = ('.'); |
612 |
my @directories_to_scan = ('.'); |
|
Lines 511-536
sub extract_messages {
Link Here
|
| 511 |
} |
626 |
} |
| 512 |
} |
627 |
} |
| 513 |
|
628 |
|
| 514 |
my $xgettext_cmd = "$self->{xgettext} -L Perl --from-code=UTF-8 " . |
629 |
my @tt_files; |
| 515 |
"-o $Bin/$self->{domain}.pot -D $intranetdir"; |
630 |
find(sub { |
|
|
631 |
if ($File::Find::dir =~ m|/en/| && $_ =~ m/\.(tt|inc)$/) { |
| 632 |
my $filename = $File::Find::name; |
| 633 |
$filename =~ s|^$intranetdir/||; |
| 634 |
push @tt_files, $filename; |
| 635 |
} |
| 636 |
}, "$intranetdir/koha-tmpl"); |
| 637 |
|
| 638 |
my $tempdir = tempdir('Koha-translate-XXXX', TMPDIR => 1, CLEANUP => 1); |
| 639 |
$self->extract_messages_from_templates($tempdir, @tt_files); |
| 640 |
push @files_to_scan, @tt_files; |
| 641 |
|
| 642 |
my $xgettext_cmd = "$self->{xgettext} -L Perl --from-code=UTF-8 " |
| 643 |
. "--package-name=Koha --package-version='' " |
| 644 |
. "-k -k__ -k__x -k__n:1,2 -k__nx:1,2 -k__xn:1,2 -k__p:1c,2 " |
| 645 |
. "-k__px:1c,2 -k__np:1c,2,3 -k__npx:1c,2,3 -kN__ -kN__n:1,2 " |
| 646 |
. "-kN__p:1c,2 -kN__np:1c,2,3 " |
| 647 |
. "-o $Bin/$self->{domain}.pot -D $tempdir -D $intranetdir"; |
| 516 |
$xgettext_cmd .= " $_" foreach (@files_to_scan); |
648 |
$xgettext_cmd .= " $_" foreach (@files_to_scan); |
| 517 |
|
649 |
|
| 518 |
if (system($xgettext_cmd) != 0) { |
650 |
if (system($xgettext_cmd) != 0) { |
| 519 |
die "system call failed: $xgettext_cmd"; |
651 |
die "system call failed: $xgettext_cmd"; |
| 520 |
} |
652 |
} |
| 521 |
|
653 |
|
| 522 |
if ( -f "$Bin/$self->{domain}.pot" ) { |
654 |
my $replace_charset_cmd = "$self->{sed} --in-place " . |
| 523 |
my $replace_charset_cmd = "$self->{sed} --in-place " . |
655 |
"$Bin/$self->{domain}.pot " . |
| 524 |
"$Bin/$self->{domain}.pot " . |
656 |
"--expression='s/charset=CHARSET/charset=UTF-8/'"; |
| 525 |
"--expression='s/charset=CHARSET/charset=UTF-8/'"; |
657 |
if (system($replace_charset_cmd) != 0) { |
| 526 |
if (system($replace_charset_cmd) != 0) { |
658 |
die "system call failed: $replace_charset_cmd"; |
| 527 |
die "system call failed: $replace_charset_cmd"; |
|
|
| 528 |
} |
| 529 |
} else { |
| 530 |
print "No messages found\n" if $self->{verbose}; |
| 531 |
return; |
| 532 |
} |
659 |
} |
| 533 |
return 1; |
660 |
} |
|
|
661 |
|
| 662 |
sub install_messages { |
| 663 |
my ($self) = @_; |
| 664 |
|
| 665 |
my $locale = $self->locale_name(); |
| 666 |
my $modir = "$self->{path_po}/$locale/LC_MESSAGES"; |
| 667 |
my $pofile = "$self->{path_po}/$self->{lang}-messages.po"; |
| 668 |
my $mofile = "$modir/$self->{domain}.mo"; |
| 669 |
|
| 670 |
if ( not -f $pofile ) { |
| 671 |
$self->create_messages(); |
| 672 |
} |
| 673 |
say "Install messages ($locale)" if $self->{verbose}; |
| 674 |
make_path($modir); |
| 675 |
system "$self->{msgfmt} -o $mofile $pofile"; |
| 534 |
} |
676 |
} |
| 535 |
|
677 |
|
| 536 |
sub remove_pot { |
678 |
sub remove_pot { |
|
Lines 544-549
sub install {
Link Here
|
| 544 |
return unless $self->{lang}; |
686 |
return unless $self->{lang}; |
| 545 |
$self->install_tmpl($files) unless $self->{pref_only}; |
687 |
$self->install_tmpl($files) unless $self->{pref_only}; |
| 546 |
$self->install_prefs(); |
688 |
$self->install_prefs(); |
|
|
689 |
$self->install_messages(); |
| 690 |
$self->remove_pot(); |
| 547 |
} |
691 |
} |
| 548 |
|
692 |
|
| 549 |
|
693 |
|
|
Lines 559-572
sub get_all_langs {
Link Here
|
| 559 |
sub update { |
703 |
sub update { |
| 560 |
my ($self, $files) = @_; |
704 |
my ($self, $files) = @_; |
| 561 |
my @langs = $self->{lang} ? ($self->{lang}) : $self->get_all_langs(); |
705 |
my @langs = $self->{lang} ? ($self->{lang}) : $self->get_all_langs(); |
| 562 |
my $extract_ok = $self->extract_messages(); |
|
|
| 563 |
for my $lang ( @langs ) { |
706 |
for my $lang ( @langs ) { |
| 564 |
$self->set_lang( $lang ); |
707 |
$self->set_lang( $lang ); |
| 565 |
$self->update_tmpl($files) unless $self->{pref_only}; |
708 |
$self->update_tmpl($files) unless $self->{pref_only}; |
| 566 |
$self->update_prefs(); |
709 |
$self->update_prefs(); |
| 567 |
$self->update_messages() if $extract_ok; |
710 |
$self->update_messages(); |
| 568 |
} |
711 |
} |
| 569 |
$self->remove_pot() if $extract_ok; |
712 |
$self->remove_pot(); |
| 570 |
} |
713 |
} |
| 571 |
|
714 |
|
| 572 |
|
715 |
|
|
Lines 575-584
sub create {
Link Here
|
| 575 |
return unless $self->{lang}; |
718 |
return unless $self->{lang}; |
| 576 |
$self->create_tmpl($files) unless $self->{pref_only}; |
719 |
$self->create_tmpl($files) unless $self->{pref_only}; |
| 577 |
$self->create_prefs(); |
720 |
$self->create_prefs(); |
| 578 |
if ($self->extract_messages()) { |
721 |
$self->create_messages(); |
| 579 |
$self->create_messages(); |
722 |
$self->remove_pot(); |
| 580 |
$self->remove_pot(); |
|
|
| 581 |
} |
| 582 |
} |
723 |
} |
| 583 |
|
724 |
|
| 584 |
|
725 |
|