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 |
|