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/ } 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$/ } 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 $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 = ( $trans->{name} =~ /help/ )?"$t_dir":"$t_dir/en/";
367 my $lang_dir = ( $trans->{name} =~ /help/ )?"$t_dir":"$t_dir/$self->{lang}";
368 $lang_dir =~ s|/en/|/$self->{lang}/|;
369 mkdir $lang_dir unless -d $lang_dir;
370 my $excludes = ( $trans->{name} !~ /help/ )?"":"-x 'help'";
371 # if installing MARC po file, only touch corresponding files
372 my $marc = ( $trans->{name} =~ /MARC/ )?"-m \"$trans->{name}\"":""; # for MARC translations
373 # if not installing MARC po file, ignore all MARC files
374 @nomarc = ( 'marc21', 'unimarc', 'normarc' ) if ( $trans->{name} !~ /MARC/ ); # hardcoded MARC variants
377 "$self->{process} install " .
380 "-s $self->{path_po}/$self->{lang}$trans->{suffix} -r " .
383 ( @files ? ' -f ' . join ' -f ', @files : '') .
384 ( @nomarc ? ' -n ' . join ' -n ', @nomarc : '');
391 my ($self, $files) = @_;
393 say "Update templates" if $self->{verbose};
394 for my $trans ( @{$self->{interface}} ) {
398 " Update templates '$trans->{name}'\n",
399 " From: $trans->{dir}/en/\n",
400 " To : $self->{path_po}/$self->{lang}$trans->{suffix}\n"
403 my $trans_dir = ( $trans->{name} =~ /help/ )?"$trans->{dir}":join("/en/ -i ",split(" ",$trans->{dir}))."/en/"; # multiple source dirs
404 # do no process 'help' dirs unless needed
405 my $excludes = ( $trans->{name} !~ /help/ )?"-x help":"";
406 # if processing MARC po file, only use corresponding files
407 my $marc = ( $trans->{name} =~ /MARC/ )?"-m \"$trans->{name}\"":""; # for MARC translations
408 # if not processing MARC po file, ignore all MARC files
409 @nomarc = ( 'marc21', 'unimarc', 'normarc' ) if ( $trans->{name} !~ /MARC/ ); # hardcoded MARC variants
412 "$self->{process} update " .
414 "-s $self->{path_po}/$self->{lang}$trans->{suffix} -r " .
417 ( @files ? ' -f ' . join ' -f ', @files : '') .
418 ( @nomarc ? ' -n ' . join ' -n ', @nomarc : '');
426 if ( -e $self->po_filename ) {
427 say "Preferences .po file already exists. Delete it if you want to recreate it.";
430 $self->get_po_from_prefs();
436 my ($self, $files) = @_;
438 say "Create templates\n" if $self->{verbose};
439 for my $trans ( @{$self->{interface}} ) {
443 " Create templates .po files for '$trans->{name}'\n",
444 " From: $trans->{dir}/en/\n",
445 " To : $self->{path_po}/$self->{lang}$trans->{suffix}\n"
448 my $trans_dir = ( $trans->{name} =~ /help/ )?"$trans->{dir}":join("/en/ -i ",split(" ",$trans->{dir}))."/en/"; # multiple source dirs
449 my $excludes = ( $trans->{name} !~ /help/ )?"-x help":"";
450 # if processing MARC po file, only use corresponding files
451 my $marc = ( $trans->{name} =~ /MARC/ )?"-m \"$trans->{name}\"":""; # for MARC translations
452 # if not processing MARC po file, ignore all MARC files
453 @nomarc = ( 'marc21', 'unimarc', 'normarc' ) if ( $trans->{name} !~ /MARC/ ); # hardcoded MARC variants
456 "$self->{process} create " .
458 "-s $self->{path_po}/$self->{lang}$trans->{suffix} -r " .
461 ( @files ? ' -f ' . join ' -f ', @files : '') .
462 ( @nomarc ? ' -n ' . join ' -n ', @nomarc : '');
466 sub create_messages {
469 print "Create messages ($self->{lang})\n" if $self->{verbose};
471 "$self->{cp} $self->{domain}.pot " .
472 "$self->{path_po}/$self->{lang}-$self->{domain}.po";
475 sub update_messages {
478 my $pofile = "$self->{path_po}/$self->{lang}-$self->{domain}.po";
479 print "Update messages ($self->{lang})\n" if $self->{verbose};
480 if ( not -f $pofile ) {
481 print "File $pofile does not exist\n" if $self->{verbose};
482 $self->create_messages();
484 system "$self->{msgmerge} -U $pofile $self->{domain}.pot";
487 sub extract_messages {
490 my $intranetdir = $self->{context}->config('intranetdir');
492 my @directories_to_scan = ('.');
493 my @blacklist = qw(blib koha-tmpl skel tmp t);
494 while (@directories_to_scan) {
495 my $dir = shift @directories_to_scan;
496 opendir DIR
, "$intranetdir/$dir" or die "Unable to open $dir: $!";
497 foreach my $entry (readdir DIR
) {
498 next if $entry =~ /^\./;
499 my $relentry = "$dir/$entry";
500 $relentry =~ s
|^\
./||;
501 if (-d
"$intranetdir/$relentry" and not grep /^$relentry$/, @blacklist) {
502 push @directories_to_scan, "$relentry";
503 } elsif (-f
"$intranetdir/$relentry" and $relentry =~ /(pl
|pm
)$/) {
504 push @files_to_scan, "$relentry";
509 my $xgettext_cmd = "$self->{xgettext} -L Perl --from-code=UTF-8 " .
510 "-o $Bin/$self->{domain}.pot -D $intranetdir";
511 $xgettext_cmd .= " $_" foreach (@files_to_scan);
513 if (system($xgettext_cmd) != 0) {
514 die "system call failed: $xgettext_cmd";
517 if ( -f
"$Bin/$self->{domain}.pot" ) {
518 my $replace_charset_cmd = "$self->{sed} --in-place " .
519 "$Bin/$self->{domain}.pot " .
520 "--expression='s/charset=CHARSET/charset=UTF-8/'";
521 if (system($replace_charset_cmd) != 0) {
522 die "system call failed: $replace_charset_cmd";
525 print "No messages found\n" if $self->{verbose
};
534 unlink "$Bin/$self->{domain}.pot";
538 my ($self, $files) = @_;
539 return unless $self->{lang
};
540 $self->install_tmpl($files) unless $self->{pref_only
};
541 $self->install_prefs();
547 opendir( my $dh, $self->{path_po
} );
548 my @files = grep { $_ =~ /-pref.po$/ }
550 @files = map { $_ =~ s/-pref.po$//; $_ } @files;
555 my ($self, $files) = @_;
556 my @langs = $self->{lang
} ?
($self->{lang
}) : $self->get_all_langs();
557 my $extract_ok = $self->extract_messages();
558 for my $lang ( @langs ) {
559 $self->set_lang( $lang );
560 $self->update_tmpl($files) unless $self->{pref_only
};
561 $self->update_prefs();
562 $self->update_messages() if $extract_ok;
564 $self->remove_pot() if $extract_ok;
569 my ($self, $files) = @_;
570 return unless $self->{lang
};
571 $self->create_tmpl($files) unless $self->{pref_only
};
572 $self->create_prefs();
573 if ($self->extract_messages()) {
574 $self->create_messages();
586 LangInstaller.pm - Handle templates and preferences translation
590 my $installer = LangInstaller->new( 'fr-FR' );
591 $installer->create();
592 $installer->update();
593 $installer->install();
594 for my $lang ( @{$installer->{langs} ) {
595 $installer->set_lang( $lan );
596 $installer->install();
603 Create a new instance of the installer object.
607 For the current language, create .po files for templates and preferences based
608 of the english ('en') version.
612 For the current language, update .po files.
616 For the current langage C<$self->{lang}, use .po files to translate the english
617 version of templates and preferences files and copy those files in the
618 appropriate directory.
622 =item translate create F<lang>
624 Create 4 kinds of .po files in F<po> subdirectory:
625 (1) one from each theme on opac pages templates,
626 (2) intranet templates and help,
628 (4) one for each MARC dialect.
633 =item F<lang>-opac-{theme}.po
635 Contains extracted text from english (en) OPAC templates found in
636 <KOHA_ROOT>/koha-tmpl/opac-tmpl/{theme}/en/ directory.
638 =item F<lang>-staff-prog.po and F<lang>-staff-help.po
640 Contains extracted text from english (en) intranet templates found in
641 <KOHA_ROOT>/koha-tmpl/intranet-tmpl/prog/en/ directory.
643 =item F<lang>-pref.po
645 Contains extracted text from english (en) preferences. They are found in files
646 located in <KOHA_ROOT>/koha-tmpl/intranet-tmpl/prog/en/admin/preferences
649 =item F<lang>-marc-{MARC}.po
651 Contains extracted text from english (en) files from opac and intranet,
652 related with MARC dialects.
656 =item pref-trans update F<lang>
658 Update .po files in F<po> directory, named F<lang>-*.po.
660 =item pref-trans install F<lang>