3 # Copyright (C) 2010 Tamil s.a.r.l.
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
23 # WARNING: Any other tested YAML library fails to work properly in this
25 use YAML::Syck qw( Dump LoadFile );
27 use FindBin qw( $Bin );
30 use File::Path qw( make_path );
32 use File::Temp qw( tempdir );
36 $YAML::Syck::ImplicitTyping = 1;
39 # Default file header for .po syspref files
40 my $default_pref_po_header = Locale::PO->new(-msgid => '', -msgstr =>
41 "Project-Id-Version: PACKAGE VERSION\\n" .
42 "PO-Revision-Date: YEAR-MO-DA HO:MI +ZONE\\n" .
43 "Last-Translator: FULL NAME <EMAIL\@ADDRESS>\\n" .
44 "Language-Team: Koha Translate List <koha-translate\@lists.koha-community.org>\\n" .
45 "MIME-Version: 1.0\\n" .
46 "Content-Type: text/plain; charset=UTF-8\\n" .
47 "Content-Transfer-Encoding: 8bit\\n" .
48 "Plural-Forms: nplurals=2; plural=(n > 1);\\n"
53 my ($self, $lang) = @_;
55 $self->{lang} = $lang;
56 $self->{po_path_lang} = $self->{context}->config('intrahtdocs') .
57 "/prog/$lang/modules/admin/preferences";
62 my ($class, $lang, $pref_only, $verbose) = @_;
66 my $context = C4::Context->new();
67 $self->{context} = $context;
68 $self->{path_pref_en} = $context->config('intrahtdocs') .
69 '/prog/en/modules/admin/preferences';
70 set_lang( $self, $lang ) if $lang;
71 $self->{pref_only} = $pref_only;
72 $self->{verbose} = $verbose;
73 $self->{process} = "$Bin/tmpl_process3.pl " . ($verbose ? '' : '-q');
74 $self->{path_po} = "$Bin/po";
75 $self->{po} = { '' => $default_pref_po_header };
76 $self->{domain} = 'Koha';
77 $self->{cp} = `which cp`;
78 $self->{msgmerge} = `which msgmerge`;
79 $self->{msgfmt} = `which msgfmt`;
80 $self->{msginit} = `which msginit`;
81 $self->{xgettext} = `which xgettext`;
82 $self->{sed} = `which sed`;
84 chomp $self->{msgmerge};
85 chomp $self->{msgfmt};
86 chomp $self->{msginit};
87 chomp $self->{xgettext};
90 unless ($self->{xgettext}) {
91 die "Missing 'xgettext' executable. Have you installed the gettext package?\n";
94 # Get all .pref file names
95 opendir my $fh, $self->{path_pref_en};
96 my @pref_files = grep { /\.pref$/ } readdir($fh);
98 $self->{pref_files} = \@pref_files;
100 # Get all available language codes
101 opendir $fh, $self->{path_po};
102 my @langs = map { ($_) =~ /(.*)-pref/ }
103 grep { $_ =~ /.*-pref/ } readdir($fh);
105 $self->{langs} = \@langs;
107 # Map for both interfaces opac/intranet
108 my $opachtdocs = $context->config('opachtdocs');
109 $self->{interface} = [
111 name => 'Intranet prog UI',
112 dir => $context->config('intrahtdocs') . '/prog',
113 suffix => '-staff-prog.po',
118 opendir my $dh, $context->config('opachtdocs');
119 for my $theme ( grep { not /^\.|lib|xslt/ } readdir($dh) ) {
120 push @{$self->{interface}}, {
121 name => "OPAC $theme",
122 dir => "$opachtdocs/$theme",
123 suffix => "-opac-$theme.po",
127 # MARC flavours (hardcoded list)
128 for ( "MARC21", "UNIMARC", "NORMARC" ) {
129 # search for strings on staff & opac marc files
130 my $dirs = $context->config('intrahtdocs') . '/prog';
131 opendir $fh, $context->config('opachtdocs');
132 for ( grep { not /^\.|\.\.|lib$|xslt/ } readdir($fh) ) {
133 $dirs .= ' ' . "$opachtdocs/$_";
135 push @{$self->{interface}}, {
138 suffix => "-marc-$_.po",
149 my $context = C4::Context->new;
150 my $trans_path = $Bin . '/po';
151 my $trans_file = "$trans_path/" . $self->{lang} . "-pref.po";
157 my ($self, $id, $comment) = @_;
158 my $po = $self->{po};
161 $p->comment( $p->comment . "\n" . $comment );
164 $po->{$id} = Locale::PO->new(
165 -comment => $comment,
174 my ($self, $comment, $prefs) = @_;
176 for my $pref ( @$prefs ) {
178 for my $element ( @$pref ) {
179 if ( ref( $element) eq 'HASH' ) {
180 $pref_name = $element->{pref};
184 for my $element ( @$pref ) {
185 if ( ref( $element) eq 'HASH' ) {
186 while ( my ($key, $value) = each(%$element) ) {
187 next unless $key eq 'choices';
188 next unless ref($value) eq 'HASH';
189 for my $ckey ( keys %$value ) {
190 my $id = $self->{file} . "#$pref_name# " . $value->{$ckey};
191 $self->po_append( $id, $comment );
196 $self->po_append( $self->{file} . "#$pref_name# $element", $comment );
204 my ($self, $id) = @_;
206 my $po = $self->{po}->{$id};
208 return Locale::PO->dequote($po->msgstr);
212 sub update_tab_prefs {
213 my ($self, $pref, $prefs) = @_;
215 for my $p ( @$prefs ) {
218 for my $element ( @$p ) {
219 if ( ref( $element) eq 'HASH' ) {
220 $pref_name = $element->{pref};
224 for my $i ( 0..@$p-1 ) {
225 my $element = $p->[$i];
226 if ( ref( $element) eq 'HASH' ) {
227 while ( my ($key, $value) = each(%$element) ) {
228 next unless $key eq 'choices';
229 next unless ref($value) eq 'HASH';
230 for my $ckey ( keys %$value ) {
231 my $id = $self->{file} . "#$pref_name# " . $value->{$ckey};
232 my $text = $self->get_trans_text( $id );
233 $value->{$ckey} = $text if $text;
238 my $id = $self->{file} . "#$pref_name# $element";
239 my $text = $self->get_trans_text( $id );
240 $p->[$i] = $text if $text;
247 sub get_po_from_prefs {
250 for my $file ( @{$self->{pref_files}} ) {
251 my $pref = LoadFile( $self->{path_pref_en} . "/$file" );
252 $self->{file} = $file;
253 # Entries for tab titles
254 $self->po_append( $self->{file}, $_ ) for keys %$pref;
255 while ( my ($tab, $tab_content) = each %$pref ) {
256 if ( ref($tab_content) eq 'ARRAY' ) {
257 $self->add_prefs( $tab, $tab_content );
260 while ( my ($section, $sysprefs) = each %$tab_content ) {
261 my $comment = "$tab > $section";
262 $self->po_append( $self->{file} . " " . $section, $comment );
263 $self->add_prefs( $comment, $sysprefs );
273 # Create file header if it doesn't already exist
274 my $po = $self->{po};
275 $po->{''} ||= $default_pref_po_header;
277 # Write .po entries into a file put in Koha standard po directory
278 Locale::PO->save_file_fromhash( $self->po_filename, $po );
279 say "Saved in file: ", $self->po_filename if $self->{verbose};
283 sub get_po_merged_with_en {
286 # Get po from current 'en' .pref files
287 $self->get_po_from_prefs();
288 my $po_current = $self->{po};
290 # Get po from previous generation
291 my $po_previous = Locale::PO->load_file_ashash( $self->po_filename );
293 for my $id ( keys %$po_current ) {
294 my $po = $po_previous->{Locale::PO->quote($id)};
296 my $text = Locale::PO->dequote( $po->msgstr );
297 $po_current->{$id}->msgstr( $text );
304 print "Update '", $self->{lang},
305 "' preferences .po file from 'en' .pref files\n" if $self->{verbose};
306 $self->get_po_merged_with_en();
314 unless ( -r $self->{po_path_lang} ) {
315 print "Koha directories hierarchy for ", $self->{lang}, " must be created first\n";
319 # Get the language .po file merged with last modified 'en' preferences
320 $self->get_po_merged_with_en();
322 for my $file ( @{$self->{pref_files}} ) {
323 my $pref = LoadFile( $self->{path_pref_en} . "/$file" );
324 $self->{file} = $file;
325 # First, keys are replaced (tab titles)
328 $self->get_trans_text( $self->{file} ) || $_ => $pref->{$_}
332 while ( my ($tab, $tab_content) = each %$pref ) {
333 if ( ref($tab_content) eq 'ARRAY' ) {
334 $self->update_tab_prefs( $pref, $tab_content );
337 while ( my ($section, $sysprefs) = each %$tab_content ) {
338 $self->update_tab_prefs( $pref, $sysprefs );
341 for my $section ( keys %$tab_content ) {
342 my $id = $self->{file} . " $section";
343 my $text = $self->get_trans_text($id);
344 my $nsection = $text ? $text : $section;
345 if( exists $ntab->{$nsection} ) {
346 # When translations collide (see BZ 18634)
347 push @{$ntab->{$nsection}}, @{$tab_content->{$section}};
349 $ntab->{$nsection} = $tab_content->{$section};
352 $pref->{$tab} = $ntab;
354 my $file_trans = $self->{po_path_lang} . "/$file";
355 print "Write $file\n" if $self->{verbose};
356 open my $fh, ">", $file_trans;
357 print $fh Dump($pref);
363 my ($self, $files) = @_;
364 say "Install templates" if $self->{verbose};
365 for my $trans ( @{$self->{interface}} ) {
366 my @t_dirs = split(" ", $trans->{dir});
367 for my $t_dir ( @t_dirs ) {
371 " Install templates '$trans->{name}'\n",
372 " From: $t_dir/en/\n",
373 " To : $t_dir/$self->{lang}\n",
374 " With: $self->{path_po}/$self->{lang}$trans->{suffix}\n"
377 my $trans_dir = "$t_dir/en/";
378 my $lang_dir = "$t_dir/$self->{lang}";
379 $lang_dir =~ s|/en/|/$self->{lang}/|;
380 mkdir $lang_dir unless -d $lang_dir;
381 # if installing MARC po file, only touch corresponding files
382 my $marc = ( $trans->{name} =~ /MARC/ )?"-m \"$trans->{name}\"":""; # for MARC translations
383 # if not installing MARC po file, ignore all MARC files
384 @nomarc = ( 'marc21', 'unimarc', 'normarc' ) if ( $trans->{name} !~ /MARC/ ); # hardcoded MARC variants
387 "$self->{process} install " .
390 "-s $self->{path_po}/$self->{lang}$trans->{suffix} -r " .
392 ( @files ? ' -f ' . join ' -f ', @files : '') .
393 ( @nomarc ? ' -n ' . join ' -n ', @nomarc : '');
400 my ($self, $files) = @_;
402 say "Update templates" if $self->{verbose};
403 for my $trans ( @{$self->{interface}} ) {
407 " Update templates '$trans->{name}'\n",
408 " From: $trans->{dir}/en/\n",
409 " To : $self->{path_po}/$self->{lang}$trans->{suffix}\n"
412 my $trans_dir = join("/en/ -i ",split(" ",$trans->{dir}))."/en/"; # multiple source dirs
413 # if processing MARC po file, only use corresponding files
414 my $marc = ( $trans->{name} =~ /MARC/ )?"-m \"$trans->{name}\"":""; # for MARC translations
415 # if not processing MARC po file, ignore all MARC files
416 @nomarc = ( 'marc21', 'unimarc', 'normarc' ) if ( $trans->{name} !~ /MARC/ ); # hardcoded MARC variants
419 "$self->{process} update " .
421 "-s $self->{path_po}/$self->{lang}$trans->{suffix} -r " .
423 ( @files ? ' -f ' . join ' -f ', @files : '') .
424 ( @nomarc ? ' -n ' . join ' -n ', @nomarc : '');
432 if ( -e $self->po_filename ) {
433 say "Preferences .po file already exists. Delete it if you want to recreate it.";
436 $self->get_po_from_prefs();
442 my ($self, $files) = @_;
444 say "Create templates\n" if $self->{verbose};
445 for my $trans ( @{$self->{interface}} ) {
449 " Create templates .po files for '$trans->{name}'\n",
450 " From: $trans->{dir}/en/\n",
451 " To : $self->{path_po}/$self->{lang}$trans->{suffix}\n"
454 my $trans_dir = join("/en/ -i ",split(" ",$trans->{dir}))."/en/"; # multiple source dirs
455 # if processing MARC po file, only use corresponding files
456 my $marc = ( $trans->{name} =~ /MARC/ )?"-m \"$trans->{name}\"":""; # for MARC translations
457 # if not processing MARC po file, ignore all MARC files
458 @nomarc = ( 'marc21', 'unimarc', 'normarc' ) if ( $trans->{name} !~ /MARC/ ); # hardcoded MARC variants
461 "$self->{process} create " .
463 "-s $self->{path_po}/$self->{lang}$trans->{suffix} -r " .
465 ( @files ? ' -f ' . join ' -f ', @files : '') .
466 ( @nomarc ? ' -n ' . join ' -n ', @nomarc : '');
473 my ($language, $region, $country) = split /-/, $self->{lang};
474 $country //= $region;
475 my $locale = $language;
476 if ($country && length($country) == 2) {
477 $locale .= '_' . $country;
483 sub create_messages {
486 my $pot = "$self->{domain}.pot";
487 my $po = "$self->{path_po}/$self->{lang}-messages.po";
490 $self->extract_messages();
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";
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)/'";
502 sub update_messages {
505 my $pot = "$self->{domain}.pot";
506 my $po = "$self->{path_po}/$self->{lang}-messages.po";
509 $self->extract_messages();
513 say "Update messages ($self->{lang})" if $self->{verbose};
514 system "$self->{msgmerge} --quiet -U $po $pot";
516 $self->create_messages();
520 sub extract_messages_from_templates {
521 my ($self, $tempdir, @files) = @_;
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();
527 foreach my $file (@files) {
528 say "Extract messages from $file" if $self->{verbose};
529 my $template = read_file("$intranetdir/$file");
531 # No need to process a file that doesn't use the i18n.inc file.
532 next unless $template =~ /i18n\.inc/;
534 my $data = $parser->parse($template);
536 warn "Error at $file : " . $parser->error();
540 make_path(dirname("$tempdir/$file"));
541 open my $fh, '>', "$tempdir/$file";
543 my @blocks = ($data->{BLOCK}, values %{ $data->{DEFBLOCKS} });
544 foreach my $block (@blocks) {
545 my $document = PPI::Document->new(\$block);
547 # [% t('foo') %] is compiled to
548 # $output .= $stash->get(['t', ['foo']]);
549 # We try to find all nodes corresponding to keyword (here 't')
550 my $nodes = $document->find(sub {
551 my ($topnode, $element) = @_;
553 # Filter out non-valid keywords
554 return 0 unless ($element->isa('PPI::Token::Quote::Single'));
555 return 0 unless (grep {$element->content eq qq{'$_'}} @keywords);
557 # keyword (e.g. 't') should be the first element of the arrayref
558 # passed to $stash->get()
559 return 0 if $element->sprevious_sibling;
561 return 0 unless $element->snext_sibling
562 && $element->snext_sibling->snext_sibling
563 && $element->snext_sibling->snext_sibling->isa('PPI::Structure::Constructor');
565 # Check that it's indeed a call to $stash->get()
566 my $statement = $element->statement->parent->statement->parent->statement;
567 return 0 unless grep { $_->isa('PPI::Token::Symbol') && $_->content eq '$stash' } $statement->children;
568 return 0 unless grep { $_->isa('PPI::Token::Operator') && $_->content eq '->' } $statement->children;
569 return 0 unless grep { $_->isa('PPI::Token::Word') && $_->content eq 'get' } $statement->children;
576 # Write the Perl equivalent of calls to t* functions family, so
577 # xgettext can extract the strings correctly
578 foreach my $node (@$nodes) {
580 $_->significant && !$_->isa('PPI::Token::Operator') ? $_->content : ()
581 } $node->snext_sibling->snext_sibling->find_first('PPI::Statement')->children;
583 my $keyword = $node->content;
584 $keyword =~ s/^'t(.*)'$/__$1/;
586 # Only keep required args to have a clean output
587 my @required_args = shift @args;
588 push @required_args, shift @args if $keyword =~ /n/;
589 push @required_args, shift @args if $keyword =~ /p/;
591 say $fh "$keyword(" . join(', ', @required_args) . ");";
602 sub extract_messages {
605 say "Extract messages into POT file" if $self->{verbose};
607 my $intranetdir = $self->{context}->config('intranetdir');
609 my @directories_to_scan = ('.');
610 my @blacklist = qw(blib koha-tmpl skel tmp t);
611 while (@directories_to_scan) {
612 my $dir = shift @directories_to_scan;
613 opendir DIR, "$intranetdir/$dir" or die "Unable to open $dir: $!";
614 foreach my $entry (readdir DIR) {
615 next if $entry =~ /^\./;
616 my $relentry = "$dir/$entry";
617 $relentry =~ s|^\./||;
618 if (-d "$intranetdir/$relentry" and not grep /^$relentry$/, @blacklist) {
619 push @directories_to_scan, "$relentry";
620 } elsif (-f "$intranetdir/$relentry" and $relentry =~ /(pl|pm)$/) {
621 push @files_to_scan, "$relentry";
628 if ($File::Find::dir =~ m|/en/| && $_ =~ m/\.(tt|inc)$/) {
629 my $filename = $File::Find::name;
630 $filename =~ s|^$intranetdir/||;
631 push @tt_files, $filename;
633 }, "$intranetdir/koha-tmpl");
635 my $tempdir = tempdir('Koha-translate-XXXX', TMPDIR => 1, CLEANUP => 1);
636 $self->extract_messages_from_templates($tempdir, @tt_files);
637 push @files_to_scan, @tt_files;
639 my $xgettext_cmd = "$self->{xgettext} -L Perl --from-code=UTF-8 "
640 . "--package-name=Koha --package-version='' "
641 . "-k -k__ -k__x -k__n:1,2 -k__nx:1,2 -k__xn:1,2 -k__p:1c,2 "
642 . "-k__px:1c,2 -k__np:1c,2,3 -k__npx:1c,2,3 -kN__ -kN__n:1,2 "
643 . "-kN__p:1c,2 -kN__np:1c,2,3 "
644 . "-o $Bin/$self->{domain}.pot -D $tempdir -D $intranetdir";
645 $xgettext_cmd .= " $_" foreach (@files_to_scan);
647 if (system($xgettext_cmd) != 0) {
648 die "system call failed: $xgettext_cmd";
651 my $replace_charset_cmd = "$self->{sed} --in-place " .
652 "$Bin/$self->{domain}.pot " .
653 "--expression='s/charset=CHARSET/charset=UTF-8/'";
654 if (system($replace_charset_cmd) != 0) {
655 die "system call failed: $replace_charset_cmd";
659 sub install_messages {
662 my $locale = $self->locale_name();
663 my $modir = "$self->{path_po}/$locale/LC_MESSAGES";
664 my $pofile = "$self->{path_po}/$self->{lang}-messages.po";
665 my $mofile = "$modir/$self->{domain}.mo";
667 if ( not -f $pofile ) {
668 $self->create_messages();
670 say "Install messages ($locale)" if $self->{verbose};
672 system "$self->{msgfmt} -o $mofile $pofile";
678 unlink "$Bin/$self->{domain}.pot";
682 my ($self, $files) = @_;
683 return unless $self->{lang};
684 $self->install_tmpl($files) unless $self->{pref_only};
685 $self->install_prefs();
686 $self->install_messages();
693 opendir( my $dh, $self->{path_po} );
694 my @files = grep { $_ =~ /-pref.po$/ }
696 @files = map { $_ =~ s/-pref.po$//; $_ } @files;
701 my ($self, $files) = @_;
702 my @langs = $self->{lang} ? ($self->{lang}) : $self->get_all_langs();
703 for my $lang ( @langs ) {
704 $self->set_lang( $lang );
705 $self->update_tmpl($files) unless $self->{pref_only};
706 $self->update_prefs();
707 $self->update_messages();
714 my ($self, $files) = @_;
715 return unless $self->{lang};
716 $self->create_tmpl($files) unless $self->{pref_only};
717 $self->create_prefs();
718 $self->create_messages();
729 LangInstaller.pm - Handle templates and preferences translation
733 my $installer = LangInstaller->new( 'fr-FR' );
734 $installer->create();
735 $installer->update();
736 $installer->install();
737 for my $lang ( @{$installer->{langs} ) {
738 $installer->set_lang( $lan );
739 $installer->install();
746 Create a new instance of the installer object.
750 For the current language, create .po files for templates and preferences based
751 of the english ('en') version.
755 For the current language, update .po files.
759 For the current langage C<$self->{lang}, use .po files to translate the english
760 version of templates and preferences files and copy those files in the
761 appropriate directory.
765 =item translate create F<lang>
767 Create 4 kinds of .po files in F<po> subdirectory:
768 (1) one from each theme on opac pages templates,
769 (2) intranet templates,
771 (4) one for each MARC dialect.
776 =item F<lang>-opac-{theme}.po
778 Contains extracted text from english (en) OPAC templates found in
779 <KOHA_ROOT>/koha-tmpl/opac-tmpl/{theme}/en/ directory.
781 =item F<lang>-staff-prog.po
783 Contains extracted text from english (en) intranet templates found in
784 <KOHA_ROOT>/koha-tmpl/intranet-tmpl/prog/en/ directory.
786 =item F<lang>-pref.po
788 Contains extracted text from english (en) preferences. They are found in files
789 located in <KOHA_ROOT>/koha-tmpl/intranet-tmpl/prog/en/admin/preferences
792 =item F<lang>-marc-{MARC}.po
794 Contains extracted text from english (en) files from opac and intranet,
795 related with MARC dialects.
799 =item pref-trans update F<lang>
801 Update .po files in F<po> directory, named F<lang>-*.po.
803 =item pref-trans install F<lang>