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',
105 name => 'Intranet prog help',
106 dir => $context->config('intrahtdocs') . '/prog/en/modules/help',
107 suffix => '-staff-help.po',
112 opendir my $dh, $context->config('opachtdocs');
113 for my $theme ( grep { not /^\.|lib|xslt/ } readdir($dh) ) {
114 push @{$self->{interface}}, {
115 name => "OPAC $theme",
116 dir => "$opachtdocs/$theme",
117 suffix => "-opac-$theme.po",
121 # MARC flavours (hardcoded list)
122 for ( "MARC21", "UNIMARC", "NORMARC" ) {
123 # search for strings on staff & opac marc files
124 my $dirs = $context->config('intrahtdocs') . '/prog';
125 opendir $fh, $context->config('opachtdocs');
126 for ( grep { not /^\.|\.\.|lib$|xslt/ } readdir($fh) ) {
127 $dirs .= ' ' . "$opachtdocs/$_";
129 push @{$self->{interface}}, {
132 suffix => "-marc-$_.po",
143 my $context = C4::Context->new;
144 my $trans_path = $Bin . '/po';
145 my $trans_file = "$trans_path/" . $self->{lang} . "-pref.po";
151 my ($self, $id, $comment) = @_;
152 my $po = $self->{po};
155 $p->comment( $p->comment . "\n" . $comment );
158 $po->{$id} = Locale::PO->new(
159 -comment => $comment,
168 my ($self, $comment, $prefs) = @_;
170 for my $pref ( @$prefs ) {
172 for my $element ( @$pref ) {
173 if ( ref( $element) eq 'HASH' ) {
174 $pref_name = $element->{pref};
178 for my $element ( @$pref ) {
179 if ( ref( $element) eq 'HASH' ) {
180 while ( my ($key, $value) = each(%$element) ) {
181 next unless $key eq 'choices';
182 next unless ref($value) eq 'HASH';
183 for my $ckey ( keys %$value ) {
184 my $id = $self->{file} . "#$pref_name# " . $value->{$ckey};
185 $self->po_append( $id, $comment );
190 $self->po_append( $self->{file} . "#$pref_name# $element", $comment );
198 my ($self, $id) = @_;
200 my $po = $self->{po}->{$id};
202 return Locale::PO->dequote($po->msgstr);
206 sub update_tab_prefs {
207 my ($self, $pref, $prefs) = @_;
209 for my $p ( @$prefs ) {
212 for my $element ( @$p ) {
213 if ( ref( $element) eq 'HASH' ) {
214 $pref_name = $element->{pref};
218 for my $i ( 0..@$p-1 ) {
219 my $element = $p->[$i];
220 if ( ref( $element) eq 'HASH' ) {
221 while ( my ($key, $value) = each(%$element) ) {
222 next unless $key eq 'choices';
223 next unless ref($value) eq 'HASH';
224 for my $ckey ( keys %$value ) {
225 my $id = $self->{file} . "#$pref_name# " . $value->{$ckey};
226 my $text = $self->get_trans_text( $id );
227 $value->{$ckey} = $text if $text;
232 my $id = $self->{file} . "#$pref_name# $element";
233 my $text = $self->get_trans_text( $id );
234 $p->[$i] = $text if $text;
241 sub get_po_from_prefs {
244 for my $file ( @{$self->{pref_files}} ) {
245 my $pref = LoadFile( $self->{path_pref_en} . "/$file" );
246 $self->{file} = $file;
247 # Entries for tab titles
248 $self->po_append( $self->{file}, $_ ) for keys %$pref;
249 while ( my ($tab, $tab_content) = each %$pref ) {
250 if ( ref($tab_content) eq 'ARRAY' ) {
251 $self->add_prefs( $tab, $tab_content );
254 while ( my ($section, $sysprefs) = each %$tab_content ) {
255 my $comment = "$tab > $section";
256 $self->po_append( $self->{file} . " " . $section, $comment );
257 $self->add_prefs( $comment, $sysprefs );
267 # Create file header if it doesn't already exist
268 my $po = $self->{po};
269 $po->{''} ||= $default_pref_po_header;
271 # Write .po entries into a file put in Koha standard po directory
272 Locale::PO->save_file_fromhash( $self->po_filename, $po );
273 say "Saved in file: ", $self->po_filename if $self->{verbose};
277 sub get_po_merged_with_en {
280 # Get po from current 'en' .pref files
281 $self->get_po_from_prefs();
282 my $po_current = $self->{po};
284 # Get po from previous generation
285 my $po_previous = Locale::PO->load_file_ashash( $self->po_filename );
287 for my $id ( keys %$po_current ) {
288 my $po = $po_previous->{Locale::PO->quote($id)};
290 my $text = Locale::PO->dequote( $po->msgstr );
291 $po_current->{$id}->msgstr( $text );
298 print "Update '", $self->{lang},
299 "' preferences .po file from 'en' .pref files\n" if $self->{verbose};
300 $self->get_po_merged_with_en();
308 unless ( -r $self->{po_path_lang} ) {
309 print "Koha directories hierarchy for ", $self->{lang}, " must be created first\n";
313 # Get the language .po file merged with last modified 'en' preferences
314 $self->get_po_merged_with_en();
316 for my $file ( @{$self->{pref_files}} ) {
317 my $pref = LoadFile( $self->{path_pref_en} . "/$file" );
318 $self->{file} = $file;
319 # First, keys are replaced (tab titles)
322 $self->get_trans_text( $self->{file} ) || $_ => $pref->{$_}
326 while ( my ($tab, $tab_content) = each %$pref ) {
327 if ( ref($tab_content) eq 'ARRAY' ) {
328 $self->update_tab_prefs( $pref, $tab_content );
331 while ( my ($section, $sysprefs) = each %$tab_content ) {
332 $self->update_tab_prefs( $pref, $sysprefs );
335 for my $section ( keys %$tab_content ) {
336 my $id = $self->{file} . " $section";
337 my $text = $self->get_trans_text($id);
338 my $nsection = $text ? $text : $section;
339 if( exists $ntab->{$nsection} ) {
340 # When translations collide (see BZ 18634)
341 push @{$ntab->{$nsection}}, @{$tab_content->{$section}};
343 $ntab->{$nsection} = $tab_content->{$section};
346 $pref->{$tab} = $ntab;
348 my $file_trans = $self->{po_path_lang} . "/$file";
349 print "Write $file\n" if $self->{verbose};
350 open my $fh, ">", $file_trans;
351 print $fh Dump($pref);
357 my ($self, $files) = @_;
358 say "Install templates" if $self->{verbose};
359 for my $trans ( @{$self->{interface}} ) {
360 my @t_dirs = split(" ", $trans->{dir});
361 for my $t_dir ( @t_dirs ) {
365 " Install templates '$trans->{name}'\n",
366 " From: $t_dir/en/\n",
367 " To : $t_dir/$self->{lang}\n",
368 " With: $self->{path_po}/$self->{lang}$trans->{suffix}\n"
371 my $trans_dir = ( $trans->{name} =~ /help/ )?"$t_dir":"$t_dir/en/";
372 my $lang_dir = ( $trans->{name} =~ /help/ )?"$t_dir":"$t_dir/$self->{lang}";
373 $lang_dir =~ s|/en/|/$self->{lang}/|;
374 mkdir $lang_dir unless -d $lang_dir;
375 my $excludes = ( $trans->{name} !~ /help/ )?"":"-x 'help'";
376 # if installing MARC po file, only touch corresponding files
377 my $marc = ( $trans->{name} =~ /MARC/ )?"-m \"$trans->{name}\"":""; # for MARC translations
378 # if not installing MARC po file, ignore all MARC files
379 @nomarc = ( 'marc21', 'unimarc', 'normarc' ) if ( $trans->{name} !~ /MARC/ ); # hardcoded MARC variants
382 "$self->{process} install " .
385 "-s $self->{path_po}/$self->{lang}$trans->{suffix} -r " .
388 ( @files ? ' -f ' . join ' -f ', @files : '') .
389 ( @nomarc ? ' -n ' . join ' -n ', @nomarc : '');
396 my ($self, $files) = @_;
398 say "Update templates" if $self->{verbose};
399 for my $trans ( @{$self->{interface}} ) {
403 " Update templates '$trans->{name}'\n",
404 " From: $trans->{dir}/en/\n",
405 " To : $self->{path_po}/$self->{lang}$trans->{suffix}\n"
408 my $trans_dir = ( $trans->{name} =~ /help/ )?"$trans->{dir}":join("/en/ -i ",split(" ",$trans->{dir}))."/en/"; # multiple source dirs
409 # do no process 'help' dirs unless needed
410 my $excludes = ( $trans->{name} !~ /help/ )?"-x help":"";
411 # if processing MARC po file, only use corresponding files
412 my $marc = ( $trans->{name} =~ /MARC/ )?"-m \"$trans->{name}\"":""; # for MARC translations
413 # if not processing MARC po file, ignore all MARC files
414 @nomarc = ( 'marc21', 'unimarc', 'normarc' ) if ( $trans->{name} !~ /MARC/ ); # hardcoded MARC variants
417 "$self->{process} update " .
419 "-s $self->{path_po}/$self->{lang}$trans->{suffix} -r " .
422 ( @files ? ' -f ' . join ' -f ', @files : '') .
423 ( @nomarc ? ' -n ' . join ' -n ', @nomarc : '');
431 if ( -e $self->po_filename ) {
432 say "Preferences .po file already exists. Delete it if you want to recreate it.";
435 $self->get_po_from_prefs();
441 my ($self, $files) = @_;
443 say "Create templates\n" if $self->{verbose};
444 for my $trans ( @{$self->{interface}} ) {
448 " Create templates .po files for '$trans->{name}'\n",
449 " From: $trans->{dir}/en/\n",
450 " To : $self->{path_po}/$self->{lang}$trans->{suffix}\n"
453 my $trans_dir = ( $trans->{name} =~ /help/ )?"$trans->{dir}":join("/en/ -i ",split(" ",$trans->{dir}))."/en/"; # multiple source dirs
454 my $excludes = ( $trans->{name} !~ /help/ )?"-x help":"";
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 " .
466 ( @files ? ' -f ' . join ' -f ', @files : '') .
467 ( @nomarc ? ' -n ' . join ' -n ', @nomarc : '');
471 sub create_messages {
474 print "Create messages ($self->{lang})\n" if $self->{verbose};
476 "$self->{cp} $self->{domain}.pot " .
477 "$self->{path_po}/$self->{lang}-$self->{domain}.po";
480 sub update_messages {
483 my $pofile = "$self->{path_po}/$self->{lang}-$self->{domain}.po";
484 print "Update messages ($self->{lang})\n" if $self->{verbose};
485 if ( not -f $pofile ) {
486 print "File $pofile does not exist\n" if $self->{verbose};
487 $self->create_messages();
489 system "$self->{msgmerge} -U $pofile $self->{domain}.pot";
492 sub extract_messages {
495 my $intranetdir = $self->{context}->config('intranetdir');
497 my @directories_to_scan = ('.');
498 my @blacklist = qw(blib koha-tmpl skel tmp t);
499 while (@directories_to_scan) {
500 my $dir = shift @directories_to_scan;
501 opendir DIR
, "$intranetdir/$dir" or die "Unable to open $dir: $!";
502 foreach my $entry (readdir DIR
) {
503 next if $entry =~ /^\./;
504 my $relentry = "$dir/$entry";
505 $relentry =~ s
|^\
./||;
506 if (-d
"$intranetdir/$relentry" and not grep /^$relentry$/, @blacklist) {
507 push @directories_to_scan, "$relentry";
508 } elsif (-f
"$intranetdir/$relentry" and $relentry =~ /(pl
|pm
)$/) {
509 push @files_to_scan, "$relentry";
514 my $xgettext_cmd = "$self->{xgettext} -L Perl --from-code=UTF-8 " .
515 "-o $Bin/$self->{domain}.pot -D $intranetdir";
516 $xgettext_cmd .= " $_" foreach (@files_to_scan);
518 if (system($xgettext_cmd) != 0) {
519 die "system call failed: $xgettext_cmd";
522 if ( -f
"$Bin/$self->{domain}.pot" ) {
523 my $replace_charset_cmd = "$self->{sed} --in-place " .
524 "$Bin/$self->{domain}.pot " .
525 "--expression='s/charset=CHARSET/charset=UTF-8/'";
526 if (system($replace_charset_cmd) != 0) {
527 die "system call failed: $replace_charset_cmd";
530 print "No messages found\n" if $self->{verbose
};
539 unlink "$Bin/$self->{domain}.pot";
543 my ($self, $files) = @_;
544 return unless $self->{lang
};
545 $self->install_tmpl($files) unless $self->{pref_only
};
546 $self->install_prefs();
552 opendir( my $dh, $self->{path_po
} );
553 my @files = grep { $_ =~ /-pref.po$/ }
555 @files = map { $_ =~ s/-pref.po$//; $_ } @files;
560 my ($self, $files) = @_;
561 my @langs = $self->{lang
} ?
($self->{lang
}) : $self->get_all_langs();
562 my $extract_ok = $self->extract_messages();
563 for my $lang ( @langs ) {
564 $self->set_lang( $lang );
565 $self->update_tmpl($files) unless $self->{pref_only
};
566 $self->update_prefs();
567 $self->update_messages() if $extract_ok;
569 $self->remove_pot() if $extract_ok;
574 my ($self, $files) = @_;
575 return unless $self->{lang
};
576 $self->create_tmpl($files) unless $self->{pref_only
};
577 $self->create_prefs();
578 if ($self->extract_messages()) {
579 $self->create_messages();
591 LangInstaller.pm - Handle templates and preferences translation
595 my $installer = LangInstaller->new( 'fr-FR' );
596 $installer->create();
597 $installer->update();
598 $installer->install();
599 for my $lang ( @{$installer->{langs} ) {
600 $installer->set_lang( $lan );
601 $installer->install();
608 Create a new instance of the installer object.
612 For the current language, create .po files for templates and preferences based
613 of the english ('en') version.
617 For the current language, update .po files.
621 For the current langage C<$self->{lang}, use .po files to translate the english
622 version of templates and preferences files and copy those files in the
623 appropriate directory.
627 =item translate create F<lang>
629 Create 4 kinds of .po files in F<po> subdirectory:
630 (1) one from each theme on opac pages templates,
631 (2) intranet templates and help,
633 (4) one for each MARC dialect.
638 =item F<lang>-opac-{theme}.po
640 Contains extracted text from english (en) OPAC templates found in
641 <KOHA_ROOT>/koha-tmpl/opac-tmpl/{theme}/en/ directory.
643 =item F<lang>-staff-prog.po and F<lang>-staff-help.po
645 Contains extracted text from english (en) intranet templates found in
646 <KOHA_ROOT>/koha-tmpl/intranet-tmpl/prog/en/ directory.
648 =item F<lang>-pref.po
650 Contains extracted text from english (en) preferences. They are found in files
651 located in <KOHA_ROOT>/koha-tmpl/intranet-tmpl/prog/en/admin/preferences
654 =item F<lang>-marc-{MARC}.po
656 Contains extracted text from english (en) files from opac and intranet,
657 related with MARC dialects.
661 =item pref-trans update F<lang>
663 Update .po files in F<po> directory, named F<lang>-*.po.
665 =item pref-trans install F<lang>