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 456-485
sub create_tmpl {
Link Here
|
456 |
} |
467 |
} |
457 |
} |
468 |
} |
458 |
|
469 |
|
|
|
470 |
sub locale_name { |
471 |
my $self = shift; |
472 |
|
473 |
my ($language, $region, $country) = split /-/, $self->{lang}; |
474 |
$country //= $region; |
475 |
my $locale = $language; |
476 |
if ($country && length($country) == 2) { |
477 |
$locale .= '_' . $country; |
478 |
} |
479 |
|
480 |
return $locale; |
481 |
} |
482 |
|
459 |
sub create_messages { |
483 |
sub create_messages { |
460 |
my $self = shift; |
484 |
my $self = shift; |
461 |
|
485 |
|
462 |
print "Create messages ($self->{lang})\n" if $self->{verbose}; |
486 |
my $pot = "$self->{domain}.pot"; |
463 |
system |
487 |
my $po = "$self->{path_po}/$self->{lang}-messages.po"; |
464 |
"$self->{cp} $self->{domain}.pot " . |
488 |
|
465 |
"$self->{path_po}/$self->{lang}-$self->{domain}.po"; |
489 |
unless ( -f $pot ) { |
|
|
490 |
$self->extract_messages(); |
491 |
} |
492 |
|
493 |
say "Create messages ($self->{lang})" if $self->{verbose}; |
494 |
my $locale = $self->locale_name(); |
495 |
system "$self->{msginit} -i $pot -o $po -l $locale --no-translator"; |
496 |
|
497 |
# If msginit failed to correctly set Plural-Forms, set a default one |
498 |
system "$self->{sed} --in-place $po " |
499 |
. "--expression='s/Plural-Forms: nplurals=INTEGER; plural=EXPRESSION/Plural-Forms: nplurals=2; plural=(n != 1)/'"; |
466 |
} |
500 |
} |
467 |
|
501 |
|
468 |
sub update_messages { |
502 |
sub update_messages { |
469 |
my $self = shift; |
503 |
my $self = shift; |
470 |
|
504 |
|
471 |
my $pofile = "$self->{path_po}/$self->{lang}-$self->{domain}.po"; |
505 |
my $pot = "$self->{domain}.pot"; |
472 |
print "Update messages ($self->{lang})\n" if $self->{verbose}; |
506 |
my $po = "$self->{path_po}/$self->{lang}-messages.po"; |
473 |
if ( not -f $pofile ) { |
507 |
|
474 |
print "File $pofile does not exist\n" if $self->{verbose}; |
508 |
unless ( -f $pot ) { |
|
|
509 |
$self->extract_messages(); |
510 |
} |
511 |
|
512 |
if ( -f $po ) { |
513 |
say "Update messages ($self->{lang})" if $self->{verbose}; |
514 |
system "$self->{msgmerge} -U $po $pot"; |
515 |
} else { |
475 |
$self->create_messages(); |
516 |
$self->create_messages(); |
476 |
} |
517 |
} |
477 |
system "$self->{msgmerge} -U $pofile $self->{domain}.pot"; |
518 |
} |
|
|
519 |
|
520 |
sub extract_messages_from_templates { |
521 |
my ($self, $tempdir, @files) = @_; |
522 |
|
523 |
my $intranetdir = $self->{context}->config('intranetdir'); |
524 |
my @keywords = qw(t tx tn txn tnx tp tpx tnp tnpx); |
525 |
my $parser = Template::Parser->new(); |
526 |
|
527 |
foreach my $file (@files) { |
528 |
say "Extract messages from $file" if $self->{verbose}; |
529 |
my $template = read_file("$intranetdir/$file"); |
530 |
my $data = $parser->parse($template); |
531 |
unless ($data) { |
532 |
warn "Error at $file : " . $parser->error(); |
533 |
next; |
534 |
} |
535 |
|
536 |
make_path(dirname("$tempdir/$file")); |
537 |
open my $fh, '>', "$tempdir/$file"; |
538 |
|
539 |
my @blocks = ($data->{BLOCK}, values %{ $data->{DEFBLOCKS} }); |
540 |
foreach my $block (@blocks) { |
541 |
my $document = PPI::Document->new(\$block); |
542 |
|
543 |
# [% t('foo') %] is compiled to |
544 |
# $output .= $stash->get(['t', ['foo']]); |
545 |
# We try to find all nodes corresponding to keyword (here 't') |
546 |
my $nodes = $document->find(sub { |
547 |
my ($topnode, $element) = @_; |
548 |
|
549 |
# Filter out non-valid keywords |
550 |
return 0 unless ($element->isa('PPI::Token::Quote::Single')); |
551 |
return 0 unless (grep {$element->content eq qq{'$_'}} @keywords); |
552 |
|
553 |
# keyword (e.g. 't') should be the first element of the arrayref |
554 |
# passed to $stash->get() |
555 |
return 0 if $element->sprevious_sibling; |
556 |
|
557 |
return 0 unless $element->snext_sibling |
558 |
&& $element->snext_sibling->snext_sibling |
559 |
&& $element->snext_sibling->snext_sibling->isa('PPI::Structure::Constructor'); |
560 |
|
561 |
# Check that it's indeed a call to $stash->get() |
562 |
my $statement = $element->statement->parent->statement->parent->statement; |
563 |
return 0 unless grep { $_->isa('PPI::Token::Symbol') && $_->content eq '$stash' } $statement->children; |
564 |
return 0 unless grep { $_->isa('PPI::Token::Operator') && $_->content eq '->' } $statement->children; |
565 |
return 0 unless grep { $_->isa('PPI::Token::Word') && $_->content eq 'get' } $statement->children; |
566 |
|
567 |
return 1; |
568 |
}); |
569 |
|
570 |
next unless $nodes; |
571 |
|
572 |
# Write the Perl equivalent of calls to t* functions family, so |
573 |
# xgettext can extract the strings correctly |
574 |
foreach my $node (@$nodes) { |
575 |
my @args = map { |
576 |
$_->significant && !$_->isa('PPI::Token::Operator') ? $_->content : () |
577 |
} $node->snext_sibling->snext_sibling->find_first('PPI::Statement')->children; |
578 |
|
579 |
my $keyword = $node->content; |
580 |
$keyword =~ s/^'t(.*)'$/__$1/; |
581 |
|
582 |
say $fh "$keyword(" . join(', ', @args) . ");"; |
583 |
} |
584 |
|
585 |
} |
586 |
|
587 |
close $fh; |
588 |
} |
589 |
|
590 |
return $tempdir; |
478 |
} |
591 |
} |
479 |
|
592 |
|
480 |
sub extract_messages { |
593 |
sub extract_messages { |
481 |
my $self = shift; |
594 |
my $self = shift; |
482 |
|
595 |
|
|
|
596 |
say "Extract messages into POT file" if $self->{verbose}; |
597 |
|
483 |
my $intranetdir = $self->{context}->config('intranetdir'); |
598 |
my $intranetdir = $self->{context}->config('intranetdir'); |
484 |
my @files_to_scan; |
599 |
my @files_to_scan; |
485 |
my @directories_to_scan = ('.'); |
600 |
my @directories_to_scan = ('.'); |
Lines 499-524
sub extract_messages {
Link Here
|
499 |
} |
614 |
} |
500 |
} |
615 |
} |
501 |
|
616 |
|
502 |
my $xgettext_cmd = "$self->{xgettext} -L Perl --from-code=UTF-8 " . |
617 |
my @tt_files; |
503 |
"-o $Bin/$self->{domain}.pot -D $intranetdir"; |
618 |
find(sub { |
|
|
619 |
if ($File::Find::dir =~ m|/en/| && $_ =~ m/\.(tt|inc)$/) { |
620 |
my $filename = $File::Find::name; |
621 |
$filename =~ s|^$intranetdir/||; |
622 |
push @tt_files, $filename; |
623 |
} |
624 |
}, "$intranetdir/koha-tmpl"); |
625 |
|
626 |
my $tempdir = tempdir('Koha-translate-XXXX', TMPDIR => 1, CLEANUP => 1); |
627 |
$self->extract_messages_from_templates($tempdir, @tt_files); |
628 |
push @files_to_scan, @tt_files; |
629 |
|
630 |
my $xgettext_cmd = "$self->{xgettext} -L Perl --from-code=UTF-8 " |
631 |
. "--package-name=Koha --package-version='' " |
632 |
. "-k -k__ -k__x -k__n:1,2 -k__nx:1,2 -k__xn:1,2 -k__p:1c,2 " |
633 |
. "-k__px:1c,2 -k__np:1c,2,3 -k__npx:1c,2,3 -kN__ -kN__n:1,2 " |
634 |
. "-kN__p:1c,2 -kN__np:1c,2,3 " |
635 |
. "-o $Bin/$self->{domain}.pot -D $tempdir -D $intranetdir"; |
504 |
$xgettext_cmd .= " $_" foreach (@files_to_scan); |
636 |
$xgettext_cmd .= " $_" foreach (@files_to_scan); |
505 |
|
637 |
|
506 |
if (system($xgettext_cmd) != 0) { |
638 |
if (system($xgettext_cmd) != 0) { |
507 |
die "system call failed: $xgettext_cmd"; |
639 |
die "system call failed: $xgettext_cmd"; |
508 |
} |
640 |
} |
509 |
|
641 |
|
510 |
if ( -f "$Bin/$self->{domain}.pot" ) { |
642 |
my $replace_charset_cmd = "$self->{sed} --in-place " . |
511 |
my $replace_charset_cmd = "$self->{sed} --in-place " . |
643 |
"$Bin/$self->{domain}.pot " . |
512 |
"$Bin/$self->{domain}.pot " . |
644 |
"--expression='s/charset=CHARSET/charset=UTF-8/'"; |
513 |
"--expression='s/charset=CHARSET/charset=UTF-8/'"; |
645 |
if (system($replace_charset_cmd) != 0) { |
514 |
if (system($replace_charset_cmd) != 0) { |
646 |
die "system call failed: $replace_charset_cmd"; |
515 |
die "system call failed: $replace_charset_cmd"; |
|
|
516 |
} |
517 |
} else { |
518 |
print "No messages found\n" if $self->{verbose}; |
519 |
return; |
520 |
} |
647 |
} |
521 |
return 1; |
648 |
} |
|
|
649 |
|
650 |
sub install_messages { |
651 |
my ($self) = @_; |
652 |
|
653 |
my $locale = $self->locale_name(); |
654 |
my $modir = "$self->{path_po}/$locale/LC_MESSAGES"; |
655 |
my $pofile = "$self->{path_po}/$self->{lang}-messages.po"; |
656 |
my $mofile = "$modir/$self->{domain}.mo"; |
657 |
|
658 |
if ( not -f $pofile ) { |
659 |
$self->create_messages(); |
660 |
} |
661 |
say "Install messages ($locale)" if $self->{verbose}; |
662 |
make_path($modir); |
663 |
system "$self->{msgfmt} -o $mofile $pofile"; |
522 |
} |
664 |
} |
523 |
|
665 |
|
524 |
sub remove_pot { |
666 |
sub remove_pot { |
Lines 532-537
sub install {
Link Here
|
532 |
return unless $self->{lang}; |
674 |
return unless $self->{lang}; |
533 |
$self->install_tmpl($files) unless $self->{pref_only}; |
675 |
$self->install_tmpl($files) unless $self->{pref_only}; |
534 |
$self->install_prefs(); |
676 |
$self->install_prefs(); |
|
|
677 |
$self->install_messages(); |
678 |
$self->remove_pot(); |
535 |
} |
679 |
} |
536 |
|
680 |
|
537 |
|
681 |
|
Lines 547-560
sub get_all_langs {
Link Here
|
547 |
sub update { |
691 |
sub update { |
548 |
my ($self, $files) = @_; |
692 |
my ($self, $files) = @_; |
549 |
my @langs = $self->{lang} ? ($self->{lang}) : $self->get_all_langs(); |
693 |
my @langs = $self->{lang} ? ($self->{lang}) : $self->get_all_langs(); |
550 |
my $extract_ok = $self->extract_messages(); |
|
|
551 |
for my $lang ( @langs ) { |
694 |
for my $lang ( @langs ) { |
552 |
$self->set_lang( $lang ); |
695 |
$self->set_lang( $lang ); |
553 |
$self->update_tmpl($files) unless $self->{pref_only}; |
696 |
$self->update_tmpl($files) unless $self->{pref_only}; |
554 |
$self->update_prefs(); |
697 |
$self->update_prefs(); |
555 |
$self->update_messages() if $extract_ok; |
698 |
$self->update_messages(); |
556 |
} |
699 |
} |
557 |
$self->remove_pot() if $extract_ok; |
700 |
$self->remove_pot(); |
558 |
} |
701 |
} |
559 |
|
702 |
|
560 |
|
703 |
|
Lines 563-572
sub create {
Link Here
|
563 |
return unless $self->{lang}; |
706 |
return unless $self->{lang}; |
564 |
$self->create_tmpl($files) unless $self->{pref_only}; |
707 |
$self->create_tmpl($files) unless $self->{pref_only}; |
565 |
$self->create_prefs(); |
708 |
$self->create_prefs(); |
566 |
if ($self->extract_messages()) { |
709 |
$self->create_messages(); |
567 |
$self->create_messages(); |
710 |
$self->remove_pot(); |
568 |
$self->remove_pot(); |
|
|
569 |
} |
570 |
} |
711 |
} |
571 |
|
712 |
|
572 |
|
713 |
|