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 );
29 $YAML::Syck::ImplicitTyping = 1;
32 # Default file header for .po syspref files
33 my $default_pref_po_header = Locale::PO->new(-msgid => '', -msgstr =>
34 "Project-Id-Version: PACKAGE VERSION\\n" .
35 "PO-Revision-Date: YEAR-MO-DA HO:MI +ZONE\\n" .
36 "Last-Translator: FULL NAME <EMAIL\@ADDRESS>\\n" .
37 "Language-Team: Koha Translate List <koha-translate\@lists.koha-community.org>\\n" .
38 "MIME-Version: 1.0\\n" .
39 "Content-Type: text/plain; charset=UTF-8\\n" .
40 "Content-Transfer-Encoding: 8bit\\n" .
41 "Plural-Forms: nplurals=2; plural=(n > 1);\\n"
46 my ($self, $lang) = @_;
48 $self->{lang} = $lang;
49 $self->{po_path_lang} = $self->{context}->config('intrahtdocs') .
50 "/prog/$lang/modules/admin/preferences";
55 my ($class, $lang, $pref_only, $verbose) = @_;
59 my $context = C4::Context->new();
60 $self->{context} = $context;
61 $self->{path_pref_en} = $context->config('intrahtdocs') .
62 '/prog/en/modules/admin/preferences';
63 set_lang( $self, $lang ) if $lang;
64 $self->{pref_only} = $pref_only;
65 $self->{verbose} = $verbose;
66 $self->{process} = "$Bin/tmpl_process3.pl " . ($verbose ? '' : '-q');
67 $self->{path_po} = "$Bin/po";
68 $self->{po} = { '' => $default_pref_po_header };
69 $self->{domain} = 'messages';
70 $self->{cp} = `which cp`;
71 $self->{msgmerge} = `which msgmerge`;
72 $self->{xgettext} = `which xgettext`;
73 $self->{sed} = `which sed`;
75 chomp $self->{msgmerge};
76 chomp $self->{xgettext};
79 unless ($self->{xgettext}) {
80 die "Missing 'xgettext' executable. Have you installed the gettext package?\n";
83 # Get all .pref file names
84 opendir my $fh, $self->{path_pref_en};
85 my @pref_files = grep { /\.pref$/ } readdir($fh);
87 $self->{pref_files} = \@pref_files;
89 # Get all available language codes
90 opendir $fh, $self->{path_po};
91 my @langs = map { ($_) =~ /(.*)-pref/ }
92 grep { $_ =~ /.*-pref/ } readdir($fh);
94 $self->{langs} = \@langs;
96 # Map for both interfaces opac/intranet
97 my $opachtdocs = $context->config('opachtdocs');
98 $self->{interface} = [
100 name => 'Intranet prog UI',
101 dir => $context->config('intrahtdocs') . '/prog',
102 suffix => '-staff-prog.po',
107 opendir my $dh, $context->config('opachtdocs');
108 for my $theme ( grep { not /^\.|lib|xslt/ } readdir($dh) ) {
109 push @{$self->{interface}}, {
110 name => "OPAC $theme",
111 dir => "$opachtdocs/$theme",
112 suffix => "-opac-$theme.po",
116 # MARC flavours (hardcoded list)
117 for ( "MARC21", "UNIMARC", "NORMARC" ) {
118 # search for strings on staff & opac marc files
119 my $dirs = $context->config('intrahtdocs') . '/prog';
120 opendir $fh, $context->config('opachtdocs');
121 for ( grep { not /^\.|\.\.|lib$|xslt/ } readdir($fh) ) {
122 $dirs .= ' ' . "$opachtdocs/$_";
124 push @{$self->{interface}}, {
127 suffix => "-marc-$_.po",
138 my $context = C4::Context->new;
139 my $trans_path = $Bin . '/po';
140 my $trans_file = "$trans_path/" . $self->{lang} . "-pref.po";
146 my ($self, $id, $comment) = @_;
147 my $po = $self->{po};
150 $p->comment( $p->comment . "\n" . $comment );
153 $po->{$id} = Locale::PO->new(
154 -comment => $comment,
163 my ($self, $comment, $prefs) = @_;
165 for my $pref ( @$prefs ) {
167 for my $element ( @$pref ) {
168 if ( ref( $element) eq 'HASH' ) {
169 $pref_name = $element->{pref};
173 for my $element ( @$pref ) {
174 if ( ref( $element) eq 'HASH' ) {
175 while ( my ($key, $value) = each(%$element) ) {
176 next unless $key eq 'choices';
177 next unless ref($value) eq 'HASH';
178 for my $ckey ( keys %$value ) {
179 my $id = $self->{file} . "#$pref_name# " . $value->{$ckey};
180 $self->po_append( $id, $comment );
185 $self->po_append( $self->{file} . "#$pref_name# $element", $comment );
193 my ($self, $id) = @_;
195 my $po = $self->{po}->{$id};
197 return Locale::PO->dequote($po->msgstr);
201 sub update_tab_prefs {
202 my ($self, $pref, $prefs) = @_;
204 for my $p ( @$prefs ) {
207 for my $element ( @$p ) {
208 if ( ref( $element) eq 'HASH' ) {
209 $pref_name = $element->{pref};
213 for my $i ( 0..@$p-1 ) {
214 my $element = $p->[$i];
215 if ( ref( $element) eq 'HASH' ) {
216 while ( my ($key, $value) = each(%$element) ) {
217 next unless $key eq 'choices';
218 next unless ref($value) eq 'HASH';
219 for my $ckey ( keys %$value ) {
220 my $id = $self->{file} . "#$pref_name# " . $value->{$ckey};
221 my $text = $self->get_trans_text( $id );
222 $value->{$ckey} = $text if $text;
227 my $id = $self->{file} . "#$pref_name# $element";
228 my $text = $self->get_trans_text( $id );
229 $p->[$i] = $text if $text;
236 sub get_po_from_prefs {
239 for my $file ( @{$self->{pref_files}} ) {
240 my $pref = LoadFile( $self->{path_pref_en} . "/$file" );
241 $self->{file} = $file;
242 # Entries for tab titles
243 $self->po_append( $self->{file}, $_ ) for keys %$pref;
244 while ( my ($tab, $tab_content) = each %$pref ) {
245 if ( ref($tab_content) eq 'ARRAY' ) {
246 $self->add_prefs( $tab, $tab_content );
249 while ( my ($section, $sysprefs) = each %$tab_content ) {
250 my $comment = "$tab > $section";
251 $self->po_append( $self->{file} . " " . $section, $comment );
252 $self->add_prefs( $comment, $sysprefs );
262 # Create file header if it doesn't already exist
263 my $po = $self->{po};
264 $po->{''} ||= $default_pref_po_header;
266 # Write .po entries into a file put in Koha standard po directory
267 Locale::PO->save_file_fromhash( $self->po_filename, $po );
268 say "Saved in file: ", $self->po_filename if $self->{verbose};
272 sub get_po_merged_with_en {
275 # Get po from current 'en' .pref files
276 $self->get_po_from_prefs();
277 my $po_current = $self->{po};
279 # Get po from previous generation
280 my $po_previous = Locale::PO->load_file_ashash( $self->po_filename );
282 for my $id ( keys %$po_current ) {
283 my $po = $po_previous->{Locale::PO->quote($id)};
285 my $text = Locale::PO->dequote( $po->msgstr );
286 $po_current->{$id}->msgstr( $text );
293 print "Update '", $self->{lang},
294 "' preferences .po file from 'en' .pref files\n" if $self->{verbose};
295 $self->get_po_merged_with_en();
303 unless ( -r $self->{po_path_lang} ) {
304 print "Koha directories hierarchy for ", $self->{lang}, " must be created first\n";
308 # Get the language .po file merged with last modified 'en' preferences
309 $self->get_po_merged_with_en();
311 for my $file ( @{$self->{pref_files}} ) {
312 my $pref = LoadFile( $self->{path_pref_en} . "/$file" );
313 $self->{file} = $file;
314 # First, keys are replaced (tab titles)
317 $self->get_trans_text( $self->{file} ) || $_ => $pref->{$_}
321 while ( my ($tab, $tab_content) = each %$pref ) {
322 if ( ref($tab_content) eq 'ARRAY' ) {
323 $self->update_tab_prefs( $pref, $tab_content );
326 while ( my ($section, $sysprefs) = each %$tab_content ) {
327 $self->update_tab_prefs( $pref, $sysprefs );
330 for my $section ( keys %$tab_content ) {
331 my $id = $self->{file} . " $section";
332 my $text = $self->get_trans_text($id);
333 my $nsection = $text ? $text : $section;
334 if( exists $ntab->{$nsection} ) {
335 # When translations collide (see BZ 18634)
336 push @{$ntab->{$nsection}}, @{$tab_content->{$section}};
338 $ntab->{$nsection} = $tab_content->{$section};
341 $pref->{$tab} = $ntab;
343 my $file_trans = $self->{po_path_lang} . "/$file";
344 print "Write $file\n" if $self->{verbose};
345 open my $fh, ">", $file_trans;
346 print $fh Dump($pref);
352 my ($self, $files) = @_;
353 say "Install templates" if $self->{verbose};
354 for my $trans ( @{$self->{interface}} ) {
355 my @t_dirs = split(" ", $trans->{dir});
356 for my $t_dir ( @t_dirs ) {
360 " Install templates '$trans->{name}'\n",
361 " From: $t_dir/en/\n",
362 " To : $t_dir/$self->{lang}\n",
363 " With: $self->{path_po}/$self->{lang}$trans->{suffix}\n"
366 my $trans_dir = "$t_dir/en/";
367 my $lang_dir = "$t_dir/$self->{lang}";
368 $lang_dir =~ s|/en/|/$self->{lang}/|;
369 mkdir $lang_dir unless -d $lang_dir;
370 # if installing MARC po file, only touch corresponding files
371 my $marc = ( $trans->{name} =~ /MARC/ )?"-m \"$trans->{name}\"":""; # for MARC translations
372 # if not installing MARC po file, ignore all MARC files
373 @nomarc = ( 'marc21', 'unimarc', 'normarc' ) if ( $trans->{name} !~ /MARC/ ); # hardcoded MARC variants
376 "$self->{process} install " .
379 "-s $self->{path_po}/$self->{lang}$trans->{suffix} -r " .
381 ( @files ? ' -f ' . join ' -f ', @files : '') .
382 ( @nomarc ? ' -n ' . join ' -n ', @nomarc : '');
389 my ($self, $files) = @_;
391 say "Update templates" if $self->{verbose};
392 for my $trans ( @{$self->{interface}} ) {
396 " Update templates '$trans->{name}'\n",
397 " From: $trans->{dir}/en/\n",
398 " To : $self->{path_po}/$self->{lang}$trans->{suffix}\n"
401 my $trans_dir = join("/en/ -i ",split(" ",$trans->{dir}))."/en/"; # multiple source dirs
402 # if processing MARC po file, only use corresponding files
403 my $marc = ( $trans->{name} =~ /MARC/ )?"-m \"$trans->{name}\"":""; # for MARC translations
404 # if not processing MARC po file, ignore all MARC files
405 @nomarc = ( 'marc21', 'unimarc', 'normarc' ) if ( $trans->{name} !~ /MARC/ ); # hardcoded MARC variants
408 "$self->{process} update " .
410 "-s $self->{path_po}/$self->{lang}$trans->{suffix} -r " .
412 ( @files ? ' -f ' . join ' -f ', @files : '') .
413 ( @nomarc ? ' -n ' . join ' -n ', @nomarc : '');
421 if ( -e $self->po_filename ) {
422 say "Preferences .po file already exists. Delete it if you want to recreate it.";
425 $self->get_po_from_prefs();
431 my ($self, $files) = @_;
433 say "Create templates\n" if $self->{verbose};
434 for my $trans ( @{$self->{interface}} ) {
438 " Create templates .po files for '$trans->{name}'\n",
439 " From: $trans->{dir}/en/\n",
440 " To : $self->{path_po}/$self->{lang}$trans->{suffix}\n"
443 my $trans_dir = join("/en/ -i ",split(" ",$trans->{dir}))."/en/"; # multiple source dirs
444 # if processing MARC po file, only use corresponding files
445 my $marc = ( $trans->{name} =~ /MARC/ )?"-m \"$trans->{name}\"":""; # for MARC translations
446 # if not processing MARC po file, ignore all MARC files
447 @nomarc = ( 'marc21', 'unimarc', 'normarc' ) if ( $trans->{name} !~ /MARC/ ); # hardcoded MARC variants
450 "$self->{process} create " .
452 "-s $self->{path_po}/$self->{lang}$trans->{suffix} -r " .
454 ( @files ? ' -f ' . join ' -f ', @files : '') .
455 ( @nomarc ? ' -n ' . join ' -n ', @nomarc : '');
459 sub create_messages {
462 print "Create messages ($self->{lang})\n" if $self->{verbose};
464 "$self->{cp} $self->{domain}.pot " .
465 "$self->{path_po}/$self->{lang}-$self->{domain}.po";
468 sub update_messages {
471 my $pofile = "$self->{path_po}/$self->{lang}-$self->{domain}.po";
472 print "Update messages ($self->{lang})\n" if $self->{verbose};
473 if ( not -f $pofile ) {
474 print "File $pofile does not exist\n" if $self->{verbose};
475 $self->create_messages();
477 system "$self->{msgmerge} -U $pofile $self->{domain}.pot";
480 sub extract_messages {
483 my $intranetdir = $self->{context}->config('intranetdir');
485 my @directories_to_scan = ('.');
486 my @blacklist = qw(blib koha-tmpl skel tmp t);
487 while (@directories_to_scan) {
488 my $dir = shift @directories_to_scan;
489 opendir DIR, "$intranetdir/$dir" or die "Unable to open $dir: $!";
490 foreach my $entry (readdir DIR) {
491 next if $entry =~ /^\./;
492 my $relentry = "$dir/$entry";
493 $relentry =~ s|^\./||;
494 if (-d "$intranetdir/$relentry" and not grep /^$relentry$/, @blacklist) {
495 push @directories_to_scan, "$relentry";
496 } elsif (-f "$intranetdir/$relentry" and $relentry =~ /(pl|pm)$/) {
497 push @files_to_scan, "$relentry";
502 my $xgettext_cmd = "$self->{xgettext} -L Perl --from-code=UTF-8 " .
503 "-o $Bin/$self->{domain}.pot -D $intranetdir";
504 $xgettext_cmd .= " $_" foreach (@files_to_scan);
506 if (system($xgettext_cmd) != 0) {
507 die "system call failed: $xgettext_cmd";
510 if ( -f "$Bin/$self->{domain}.pot" ) {
511 my $replace_charset_cmd = "$self->{sed} --in-place " .
512 "$Bin/$self->{domain}.pot " .
513 "--expression='s/charset=CHARSET/charset=UTF-8/'";
514 if (system($replace_charset_cmd) != 0) {
515 die "system call failed: $replace_charset_cmd";
518 print "No messages found\n" if $self->{verbose};
527 unlink "$Bin/$self->{domain}.pot";
531 my ($self, $files) = @_;
532 return unless $self->{lang};
533 $self->install_tmpl($files) unless $self->{pref_only};
534 $self->install_prefs();
540 opendir( my $dh, $self->{path_po} );
541 my @files = grep { $_ =~ /-pref.po$/ }
543 @files = map { $_ =~ s/-pref.po$//; $_ } @files;
548 my ($self, $files) = @_;
549 my @langs = $self->{lang} ? ($self->{lang}) : $self->get_all_langs();
550 my $extract_ok = $self->extract_messages();
551 for my $lang ( @langs ) {
552 $self->set_lang( $lang );
553 $self->update_tmpl($files) unless $self->{pref_only};
554 $self->update_prefs();
555 $self->update_messages() if $extract_ok;
557 $self->remove_pot() if $extract_ok;
562 my ($self, $files) = @_;
563 return unless $self->{lang};
564 $self->create_tmpl($files) unless $self->{pref_only};
565 $self->create_prefs();
566 if ($self->extract_messages()) {
567 $self->create_messages();
579 LangInstaller.pm - Handle templates and preferences translation
583 my $installer = LangInstaller->new( 'fr-FR' );
584 $installer->create();
585 $installer->update();
586 $installer->install();
587 for my $lang ( @{$installer->{langs} ) {
588 $installer->set_lang( $lan );
589 $installer->install();
596 Create a new instance of the installer object.
600 For the current language, create .po files for templates and preferences based
601 of the english ('en') version.
605 For the current language, update .po files.
609 For the current langage C<$self->{lang}, use .po files to translate the english
610 version of templates and preferences files and copy those files in the
611 appropriate directory.
615 =item translate create F<lang>
617 Create 4 kinds of .po files in F<po> subdirectory:
618 (1) one from each theme on opac pages templates,
619 (2) intranet templates,
621 (4) one for each MARC dialect.
626 =item F<lang>-opac-{theme}.po
628 Contains extracted text from english (en) OPAC templates found in
629 <KOHA_ROOT>/koha-tmpl/opac-tmpl/{theme}/en/ directory.
631 =item F<lang>-staff-prog.po
633 Contains extracted text from english (en) intranet templates found in
634 <KOHA_ROOT>/koha-tmpl/intranet-tmpl/prog/en/ directory.
636 =item F<lang>-pref.po
638 Contains extracted text from english (en) preferences. They are found in files
639 located in <KOHA_ROOT>/koha-tmpl/intranet-tmpl/prog/en/admin/preferences
642 =item F<lang>-marc-{MARC}.po
644 Contains extracted text from english (en) files from opac and intranet,
645 related with MARC dialects.
649 =item pref-trans update F<lang>
651 Update .po files in F<po> directory, named F<lang>-*.po.
653 =item pref-trans install F<lang>