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 under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License along
17 # with Koha; if not, write to the Free Software Foundation, Inc.,
18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
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 # Get all .pref file names
80 opendir my $fh, $self->{path_pref_en};
81 my @pref_files = grep { /.pref/ } readdir($fh);
83 $self->{pref_files} = \@pref_files;
85 # Get all available language codes
86 opendir $fh, $self->{path_po};
87 my @langs = map { ($_) =~ /(.*)-pref/ }
88 grep { $_ =~ /.*-pref/ } readdir($fh);
90 $self->{langs} = \@langs;
92 # Map for both interfaces opac/intranet
93 my $opachtdocs = $context->config('opachtdocs');
94 $self->{interface} = [
96 name => 'Intranet prog UI',
97 dir => $context->config('intrahtdocs') . '/prog',
98 suffix => '-i-staff-t-prog-v-3006000.po',
101 name => 'Intranet prog help',
102 dir => $context->config('intrahtdocs') . '/prog/en/modules/help',
103 suffix => '-staff-help.po',
108 opendir my $dh, $context->config('opachtdocs');
109 for my $theme ( grep { not /^\.|lib/ } readdir($dh) ) {
110 push @{$self->{interface}}, {
111 name => "OPAC $theme",
112 dir => "$opachtdocs/$theme",
113 suffix => "-opac-$theme.po",
124 my $context = C4::Context->new;
125 my $trans_path = $Bin . '/po';
126 my $trans_file = "$trans_path/" . $self->{lang} . "-pref.po";
132 my ($self, $id, $comment) = @_;
133 my $po = $self->{po};
136 $p->comment( $p->comment . "\n" . $comment );
139 $po->{$id} = Locale::PO->new(
140 -comment => $comment,
149 my ($self, $comment, $prefs) = @_;
151 for my $pref ( @$prefs ) {
153 for my $element ( @$pref ) {
154 if ( ref( $element) eq 'HASH' ) {
155 $pref_name = $element->{pref};
159 for my $element ( @$pref ) {
160 if ( ref( $element) eq 'HASH' ) {
161 while ( my ($key, $value) = each(%$element) ) {
162 next unless $key eq 'choices';
163 next unless ref($value) eq 'HASH';
164 for my $ckey ( keys %$value ) {
165 my $id = $self->{file} . "#$pref_name# " . $value->{$ckey};
166 $self->po_append( $id, $comment );
171 $self->po_append( $self->{file} . "#$pref_name# $element", $comment );
179 my ($self, $id) = @_;
181 my $po = $self->{po}->{$id};
183 return Locale::PO->dequote($po->msgstr);
187 sub update_tab_prefs {
188 my ($self, $pref, $prefs) = @_;
190 for my $p ( @$prefs ) {
193 for my $element ( @$p ) {
194 if ( ref( $element) eq 'HASH' ) {
195 $pref_name = $element->{pref};
199 for my $i ( 0..@$p-1 ) {
200 my $element = $p->[$i];
201 if ( ref( $element) eq 'HASH' ) {
202 while ( my ($key, $value) = each(%$element) ) {
203 next unless $key eq 'choices';
204 next unless ref($value) eq 'HASH';
205 for my $ckey ( keys %$value ) {
206 my $id = $self->{file} . "#$pref_name# " . $value->{$ckey};
207 my $text = $self->get_trans_text( $id );
208 $value->{$ckey} = $text if $text;
213 my $id = $self->{file} . "#$pref_name# $element";
214 my $text = $self->get_trans_text( $id );
215 $p->[$i] = $text if $text;
222 sub get_po_from_prefs {
225 for my $file ( @{$self->{pref_files}} ) {
226 my $pref = LoadFile( $self->{path_pref_en} . "/$file" );
227 $self->{file} = $file;
228 # Entries for tab titles
229 $self->po_append( $self->{file}, $_ ) for keys %$pref;
230 while ( my ($tab, $tab_content) = each %$pref ) {
231 if ( ref($tab_content) eq 'ARRAY' ) {
232 $self->add_prefs( $tab, $tab_content );
235 while ( my ($section, $sysprefs) = each %$tab_content ) {
236 my $comment = "$tab > $section";
237 $self->po_append( $self->{file} . " " . $section, $comment );
238 $self->add_prefs( $comment, $sysprefs );
248 # Create file header if it doesn't already exist
249 my $po = $self->{po};
250 $po->{''} ||= $default_pref_po_header;
252 # Write .po entries into a file put in Koha standard po directory
253 Locale::PO->save_file_fromhash( $self->po_filename, $po );
254 say "Saved in file: ", $self->po_filename if $self->{verbose};
258 sub get_po_merged_with_en {
261 # Get po from current 'en' .pref files
262 $self->get_po_from_prefs();
263 my $po_current = $self->{po};
265 # Get po from previous generation
266 my $po_previous = Locale::PO->load_file_ashash( $self->po_filename );
268 for my $id ( keys %$po_current ) {
269 my $po = $po_previous->{Locale::PO->quote($id)};
271 my $text = Locale::PO->dequote( $po->msgstr );
272 $po_current->{$id}->msgstr( $text );
279 print "Update '", $self->{lang},
280 "' preferences .po file from 'en' .pref files\n" if $self->{verbose};
281 $self->get_po_merged_with_en();
289 unless ( -r $self->{po_path_lang} ) {
290 print "Koha directories hierarchy for ", $self->{lang}, " must be created first\n";
294 # Get the language .po file merged with last modified 'en' preferences
295 $self->get_po_merged_with_en();
297 for my $file ( @{$self->{pref_files}} ) {
298 my $pref = LoadFile( $self->{path_pref_en} . "/$file" );
299 $self->{file} = $file;
300 # First, keys are replaced (tab titles)
303 $self->get_trans_text( $self->{file} ) || $_ => $pref->{$_}
307 while ( my ($tab, $tab_content) = each %$pref ) {
308 if ( ref($tab_content) eq 'ARRAY' ) {
309 $self->update_tab_prefs( $pref, $tab_content );
312 while ( my ($section, $sysprefs) = each %$tab_content ) {
313 $self->update_tab_prefs( $pref, $sysprefs );
316 for my $section ( keys %$tab_content ) {
317 my $id = $self->{file} . " $section";
318 my $text = $self->get_trans_text($id);
319 my $nsection = $text ? $text : $section;
320 $ntab->{$nsection} = $tab_content->{$section};
322 $pref->{$tab} = $ntab;
324 my $file_trans = $self->{po_path_lang} . "/$file";
325 print "Write $file\n" if $self->{verbose};
326 open my $fh, ">", $file_trans;
327 print $fh Dump($pref);
333 my ($self, $files) = @_;
334 say "Install templates" if $self->{verbose};
335 for my $trans ( @{$self->{interface}} ) {
337 " Install templates '$trans->{name}'\n",
338 " From: $trans->{dir}/en/\n",
339 " To : $trans->{dir}/$self->{lang}\n",
340 " With: $self->{path_po}/$self->{lang}$trans->{suffix}\n"
343 my $trans_dir = ( $trans->{name} =~ /help/ )?"$trans->{dir}":"$trans->{dir}/en/";
344 my $lang_dir = ( $trans->{name} =~ /help/ )?"$trans->{dir}":"$trans->{dir}/$self->{lang}";
345 $lang_dir =~ s|/en/|/$self->{lang}/|;
346 mkdir $lang_dir unless -d $lang_dir;
347 my $excludes = ( $trans->{name} =~ /UI/ )?"-x 'help'":"";
350 "$self->{process} install " .
353 "-s $self->{path_po}/$self->{lang}$trans->{suffix} -r $excludes" .
356 ? ' -f ' . join ' -f ', @$files
364 my ($self, $files) = @_;
366 say "Update templates" if $self->{verbose};
367 for my $trans ( @{$self->{interface}} ) {
369 " Update templates '$trans->{name}'\n",
370 " From: $trans->{dir}/en/\n",
371 " To : $self->{path_po}/$self->{lang}$trans->{suffix}\n"
373 my $lang_dir = "$trans->{dir}/$self->{lang}";
374 mkdir $lang_dir unless -d $lang_dir;
376 my $trans_dir = ( $trans->{name} =~ /help/ )?"$trans->{dir}":"$trans->{dir}/en/";
377 my $excludes = ( $trans->{name} =~ /UI/ )?"-x 'help'":"";
380 "$self->{process} update " .
382 "-s $self->{path_po}/$self->{lang}$trans->{suffix} -r $excludes" .
385 ? ' -f ' . join ' -f ', @$files
395 if ( -e $self->po_filename ) {
396 say "Preferences .po file already exists. Delete it if you want to recreate it.";
399 $self->get_po_from_prefs();
405 my ($self, $files) = @_;
407 say "Create templates\n" if $self->{verbose};
408 for my $trans ( @{$self->{interface}} ) {
410 " Create templates .po files for '$trans->{name}'\n",
411 " From: $trans->{dir}/en/\n",
412 " To : $self->{path_po}/$self->{lang}$trans->{suffix}\n"
415 my $trans_dir = ( $trans->{name} =~ /help/ )?"$trans->{dir}":"$trans->{dir}/en/";
416 my $excludes = ( $trans->{name} =~ /UI/ )?"-x 'help'":"";
419 "$self->{process} create " .
421 "-s $self->{path_po}/$self->{lang}$trans->{suffix} -r $excludes" .
424 ? ' -f ' . join ' -f ', @$files
430 sub create_messages {
433 print "Create messages ($self->{lang})\n" if $self->{verbose};
435 "$self->{cp} $self->{domain}.pot " .
436 "$self->{path_po}/$self->{lang}-$self->{domain}.po";
439 sub update_messages {
442 my $pofile = "$self->{path_po}/$self->{lang}-$self->{domain}.po";
443 print "Update messages ($self->{lang})\n" if $self->{verbose};
444 if ( not -f $pofile ) {
445 print "File $pofile does not exist\n" if $self->{verbose};
446 $self->create_messages();
448 system "$self->{msgmerge} -U $pofile $self->{domain}.pot";
451 sub extract_messages {
454 my $intranetdir = $self->{context}->config('intranetdir');
456 my @directories_to_scan = ('.');
457 my @blacklist = qw(blib koha-tmpl skel tmp t);
458 while (@directories_to_scan) {
459 my $dir = shift @directories_to_scan;
460 opendir DIR, "$intranetdir/$dir" or die "Unable to open $dir: $!";
461 foreach my $entry (readdir DIR) {
462 next if $entry =~ /^\./;
463 my $relentry = "$dir/$entry";
464 $relentry =~ s|^\./||;
465 if (-d "$intranetdir/$relentry" and not grep /^$relentry$/, @blacklist) {
466 push @directories_to_scan, "$relentry";
467 } elsif (-f "$intranetdir/$relentry" and $relentry =~ /(pl|pm)$/) {
468 push @files_to_scan, "$relentry";
473 my $xgettext_cmd = "$self->{xgettext} -L Perl --from-code=UTF-8 " .
474 "-o $Bin/$self->{domain}.pot -D $intranetdir";
475 $xgettext_cmd .= " $_" foreach (@files_to_scan);
477 if (system($xgettext_cmd) != 0) {
478 die "system call failed: $xgettext_cmd";
481 if ( -f "$Bin/$self->{domain}.pot" ) {
482 my $replace_charset_cmd = "$self->{sed} --in-place " .
483 "$Bin/$self->{domain}.pot " .
484 "--expression='s/charset=CHARSET/charset=UTF-8/'";
485 if (system($replace_charset_cmd) != 0) {
486 die "system call failed: $replace_charset_cmd";
489 print "No messages found\n" if $self->{verbose};
498 unlink "$Bin/$self->{domain}.pot";
502 my ($self, $files) = @_;
503 return unless $self->{lang};
504 $self->install_tmpl($files) unless $self->{pref_only};
505 $self->install_prefs();
511 opendir( my $dh, $self->{path_po} );
512 my @files = grep { $_ =~ /-pref.po$/ }
514 @files = map { $_ =~ s/-pref.po$//; $_ } @files;
519 my ($self, $files) = @_;
520 my @langs = $self->{lang} ? ($self->{lang}) : $self->get_all_langs();
521 my $extract_ok = $self->extract_messages();
522 for my $lang ( @langs ) {
523 $self->set_lang( $lang );
524 $self->update_tmpl($files) unless $self->{pref_only};
525 $self->update_prefs();
526 $self->update_messages() if $extract_ok;
528 $self->remove_pot() if $extract_ok;
533 my ($self, $files) = @_;
534 return unless $self->{lang};
535 $self->create_tmpl($files) unless $self->{pref_only};
536 $self->create_prefs();
537 if ($self->extract_messages()) {
538 $self->create_messages();
550 LangInstaller.pm - Handle templates and preferences translation
554 my $installer = LangInstaller->new( 'fr-FR' );
555 $installer->create();
556 $installer->update();
557 $installer->install();
558 for my $lang ( @{$installer->{langs} ) {
559 $installer->set_lang( $lan );
560 $installer->install();
567 Create a new instance of the installer object.
571 For the current language, create .po files for templates and preferences based
572 of the english ('en') version.
576 For the current language, update .po files.
580 For the current langage C<$self->{lang}, use .po files to translate the english
581 version of templates and preferences files and copy those files in the
582 appropriate directory.
586 =item translate create F<lang>
588 Create 3 .po files in F<po> subdirectory: (1) from opac pages templates, (2)
589 intranet templates, and (3) from preferences.
593 =item F<lang>-opac-{theme}.po
595 Contains extracted text from english (en) OPAC templates found in
596 <KOHA_ROOT>/koha-tmpl/opac-tmpl/{theme}/en/ directory.
598 =item F<lang>-intranet.po
600 Contains extracted text from english (en) intranet templates found in
601 <KOHA_ROOT>/koha-tmpl/intranet-tmpl/prog/en/ directory.
603 =item F<lang>-pref.po
605 Contains extracted text from english (en) preferences. They are found in files
606 located in <KOHA_ROOT>/koha-tmpl/intranet-tmpl/prog/en/admin/preferences
611 =item pref-trans update F<lang>
613 Update .po files in F<po> directory, named F<lang>-*.po.
615 =item pref-trans install F<lang>