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");
530 my $data = $parser->parse($template);
532 warn "Error at $file : " . $parser->error();
536 make_path(dirname("$tempdir/$file"));
537 open my $fh, '>', "$tempdir/$file";
539 my @blocks = ($data->{BLOCK}, values %{ $data->{DEFBLOCKS} });
540 foreach my $block (@blocks) {
541 my $document = PPI::Document->new(\$block);
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) = @_;
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);
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;
557 return 0 unless $element->snext_sibling
558 && $element->snext_sibling->snext_sibling
559 && $element->snext_sibling->snext_sibling->isa('PPI::Structure::Constructor');
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;
572 # Write the Perl equivalent of calls to t* functions family, so
573 # xgettext can extract the strings correctly
574 foreach my $node (@$nodes) {
576 $_->significant && !$_->isa('PPI::Token::Operator') ? $_->content : ()
577 } $node->snext_sibling->snext_sibling->find_first('PPI::Statement')->children;
579 my $keyword = $node->content;
580 $keyword =~ s/^'t(.*)'$/__$1/;
582 say $fh "$keyword(" . join(', ', @args) . ");";
593 sub extract_messages {
596 say "Extract messages into POT file" if $self->{verbose};
598 my $intranetdir = $self->{context}->config('intranetdir');
600 my @directories_to_scan = ('.');
601 my @blacklist = qw(blib koha-tmpl skel tmp t);
602 while (@directories_to_scan) {
603 my $dir = shift @directories_to_scan;
604 opendir DIR, "$intranetdir/$dir" or die "Unable to open $dir: $!";
605 foreach my $entry (readdir DIR) {
606 next if $entry =~ /^\./;
607 my $relentry = "$dir/$entry";
608 $relentry =~ s|^\./||;
609 if (-d "$intranetdir/$relentry" and not grep /^$relentry$/, @blacklist) {
610 push @directories_to_scan, "$relentry";
611 } elsif (-f "$intranetdir/$relentry" and $relentry =~ /(pl|pm)$/) {
612 push @files_to_scan, "$relentry";
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;
624 }, "$intranetdir/koha-tmpl");
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;
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";
636 $xgettext_cmd .= " $_" foreach (@files_to_scan);
638 if (system($xgettext_cmd) != 0) {
639 die "system call failed: $xgettext_cmd";
642 my $replace_charset_cmd = "$self->{sed} --in-place " .
643 "$Bin/$self->{domain}.pot " .
644 "--expression='s/charset=CHARSET/charset=UTF-8/'";
645 if (system($replace_charset_cmd) != 0) {
646 die "system call failed: $replace_charset_cmd";
650 sub install_messages {
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";
658 if ( not -f $pofile ) {
659 $self->create_messages();
661 say "Install messages ($locale)" if $self->{verbose};
663 system "$self->{msgfmt} -o $mofile $pofile";
669 unlink "$Bin/$self->{domain}.pot";
673 my ($self, $files) = @_;
674 return unless $self->{lang};
675 $self->install_tmpl($files) unless $self->{pref_only};
676 $self->install_prefs();
677 $self->install_messages();
684 opendir( my $dh, $self->{path_po} );
685 my @files = grep { $_ =~ /-pref.po$/ }
687 @files = map { $_ =~ s/-pref.po$//; $_ } @files;
692 my ($self, $files) = @_;
693 my @langs = $self->{lang} ? ($self->{lang}) : $self->get_all_langs();
694 for my $lang ( @langs ) {
695 $self->set_lang( $lang );
696 $self->update_tmpl($files) unless $self->{pref_only};
697 $self->update_prefs();
698 $self->update_messages();
705 my ($self, $files) = @_;
706 return unless $self->{lang};
707 $self->create_tmpl($files) unless $self->{pref_only};
708 $self->create_prefs();
709 $self->create_messages();
720 LangInstaller.pm - Handle templates and preferences translation
724 my $installer = LangInstaller->new( 'fr-FR' );
725 $installer->create();
726 $installer->update();
727 $installer->install();
728 for my $lang ( @{$installer->{langs} ) {
729 $installer->set_lang( $lan );
730 $installer->install();
737 Create a new instance of the installer object.
741 For the current language, create .po files for templates and preferences based
742 of the english ('en') version.
746 For the current language, update .po files.
750 For the current langage C<$self->{lang}, use .po files to translate the english
751 version of templates and preferences files and copy those files in the
752 appropriate directory.
756 =item translate create F<lang>
758 Create 4 kinds of .po files in F<po> subdirectory:
759 (1) one from each theme on opac pages templates,
760 (2) intranet templates,
762 (4) one for each MARC dialect.
767 =item F<lang>-opac-{theme}.po
769 Contains extracted text from english (en) OPAC templates found in
770 <KOHA_ROOT>/koha-tmpl/opac-tmpl/{theme}/en/ directory.
772 =item F<lang>-staff-prog.po
774 Contains extracted text from english (en) intranet templates found in
775 <KOHA_ROOT>/koha-tmpl/intranet-tmpl/prog/en/ directory.
777 =item F<lang>-pref.po
779 Contains extracted text from english (en) preferences. They are found in files
780 located in <KOHA_ROOT>/koha-tmpl/intranet-tmpl/prog/en/admin/preferences
783 =item F<lang>-marc-{MARC}.po
785 Contains extracted text from english (en) files from opac and intranet,
786 related with MARC dialects.
790 =item pref-trans update F<lang>
792 Update .po files in F<po> directory, named F<lang>-*.po.
794 =item pref-trans install F<lang>