Bug 19171: Attempt to make "no holds possible" messages less confusing
[koha.git] / misc / translator / LangInstaller.pm
blobcd947fc3b3fd730d8a5fb5549c8fe26f870fb406
1 package LangInstaller;
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>.
20 use Modern::Perl;
22 use C4::Context;
23 # WARNING: Any other tested YAML library fails to work properly in this
24 # script content
25 use YAML::Syck qw( Dump LoadFile );
26 use Locale::PO;
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"
45 sub set_lang {
46 my ($self, $lang) = @_;
48 $self->{lang} = $lang;
49 $self->{po_path_lang} = $self->{context}->config('intrahtdocs') .
50 "/prog/$lang/modules/admin/preferences";
54 sub new {
55 my ($class, $lang, $pref_only, $verbose) = @_;
57 my $self = { };
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`;
74 chomp $self->{cp};
75 chomp $self->{msgmerge};
76 chomp $self->{xgettext};
77 chomp $self->{sed};
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);
86 close $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);
93 closedir $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',
111 # OPAC themes
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}}, {
130 name => "$_",
131 dir => $dirs,
132 suffix => "-marc-$_.po",
136 bless $self, $class;
140 sub po_filename {
141 my $self = shift;
143 my $context = C4::Context->new;
144 my $trans_path = $Bin . '/po';
145 my $trans_file = "$trans_path/" . $self->{lang} . "-pref.po";
146 return $trans_file;
150 sub po_append {
151 my ($self, $id, $comment) = @_;
152 my $po = $self->{po};
153 my $p = $po->{$id};
154 if ( $p ) {
155 $p->comment( $p->comment . "\n" . $comment );
157 else {
158 $po->{$id} = Locale::PO->new(
159 -comment => $comment,
160 -msgid => $id,
161 -msgstr => ''
167 sub add_prefs {
168 my ($self, $comment, $prefs) = @_;
170 for my $pref ( @$prefs ) {
171 my $pref_name = '';
172 for my $element ( @$pref ) {
173 if ( ref( $element) eq 'HASH' ) {
174 $pref_name = $element->{pref};
175 last;
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 );
189 elsif ( $element ) {
190 $self->po_append( $self->{file} . "#$pref_name# $element", $comment );
197 sub get_trans_text {
198 my ($self, $id) = @_;
200 my $po = $self->{po}->{$id};
201 return unless $po;
202 return Locale::PO->dequote($po->msgstr);
206 sub update_tab_prefs {
207 my ($self, $pref, $prefs) = @_;
209 for my $p ( @$prefs ) {
210 my $pref_name = '';
211 next unless $p;
212 for my $element ( @$p ) {
213 if ( ref( $element) eq 'HASH' ) {
214 $pref_name = $element->{pref};
215 last;
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;
231 elsif ( $element ) {
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 {
242 my $self = shift;
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 );
252 next;
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 );
264 sub save_po {
265 my $self = shift;
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 {
278 my $self = shift;
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)};
289 next unless $po;
290 my $text = Locale::PO->dequote( $po->msgstr );
291 $po_current->{$id}->msgstr( $text );
296 sub update_prefs {
297 my $self = shift;
298 print "Update '", $self->{lang},
299 "' preferences .po file from 'en' .pref files\n" if $self->{verbose};
300 $self->get_po_merged_with_en();
301 $self->save_po();
305 sub install_prefs {
306 my $self = shift;
308 unless ( -r $self->{po_path_lang} ) {
309 print "Koha directories hierarchy for ", $self->{lang}, " must be created first\n";
310 exit;
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)
320 $pref = do {
321 my %pref = map {
322 $self->get_trans_text( $self->{file} ) || $_ => $pref->{$_}
323 } keys %$pref;
324 \%pref;
326 while ( my ($tab, $tab_content) = each %$pref ) {
327 if ( ref($tab_content) eq 'ARRAY' ) {
328 $self->update_tab_prefs( $pref, $tab_content );
329 next;
331 while ( my ($section, $sysprefs) = each %$tab_content ) {
332 $self->update_tab_prefs( $pref, $sysprefs );
334 my $ntab = {};
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}};
342 } else {
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);
356 sub install_tmpl {
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 ) {
362 my @files = @$files;
363 my @nomarc = ();
364 print
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"
369 if $self->{verbose};
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
381 system
382 "$self->{process} install " .
383 "-i $trans_dir " .
384 "-o $lang_dir ".
385 "-s $self->{path_po}/$self->{lang}$trans->{suffix} -r " .
386 "$excludes " .
387 "$marc " .
388 ( @files ? ' -f ' . join ' -f ', @files : '') .
389 ( @nomarc ? ' -n ' . join ' -n ', @nomarc : '');
395 sub update_tmpl {
396 my ($self, $files) = @_;
398 say "Update templates" if $self->{verbose};
399 for my $trans ( @{$self->{interface}} ) {
400 my @files = @$files;
401 my @nomarc = ();
402 print
403 " Update templates '$trans->{name}'\n",
404 " From: $trans->{dir}/en/\n",
405 " To : $self->{path_po}/$self->{lang}$trans->{suffix}\n"
406 if $self->{verbose};
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
416 system
417 "$self->{process} update " .
418 "-i $trans_dir " .
419 "-s $self->{path_po}/$self->{lang}$trans->{suffix} -r " .
420 "$excludes " .
421 "$marc " .
422 ( @files ? ' -f ' . join ' -f ', @files : '') .
423 ( @nomarc ? ' -n ' . join ' -n ', @nomarc : '');
428 sub create_prefs {
429 my $self = shift;
431 if ( -e $self->po_filename ) {
432 say "Preferences .po file already exists. Delete it if you want to recreate it.";
433 return;
435 $self->get_po_from_prefs();
436 $self->save_po();
440 sub create_tmpl {
441 my ($self, $files) = @_;
443 say "Create templates\n" if $self->{verbose};
444 for my $trans ( @{$self->{interface}} ) {
445 my @files = @$files;
446 my @nomarc = ();
447 print
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"
451 if $self->{verbose};
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
460 system
461 "$self->{process} create " .
462 "-i $trans_dir " .
463 "-s $self->{path_po}/$self->{lang}$trans->{suffix} -r " .
464 "$excludes " .
465 "$marc " .
466 ( @files ? ' -f ' . join ' -f ', @files : '') .
467 ( @nomarc ? ' -n ' . join ' -n ', @nomarc : '');
471 sub create_messages {
472 my $self = shift;
474 print "Create messages ($self->{lang})\n" if $self->{verbose};
475 system
476 "$self->{cp} $self->{domain}.pot " .
477 "$self->{path_po}/$self->{lang}-$self->{domain}.po";
480 sub update_messages {
481 my $self = shift;
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 {
493 my $self = shift;
495 my $intranetdir = $self->{context}->config('intranetdir');
496 my @files_to_scan;
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";
529 } else {
530 print "No messages found\n" if $self->{verbose};
531 return;
533 return 1;
536 sub remove_pot {
537 my $self = shift;
539 unlink "$Bin/$self->{domain}.pot";
542 sub install {
543 my ($self, $files) = @_;
544 return unless $self->{lang};
545 $self->install_tmpl($files) unless $self->{pref_only};
546 $self->install_prefs();
550 sub get_all_langs {
551 my $self = shift;
552 opendir( my $dh, $self->{path_po} );
553 my @files = grep { $_ =~ /-pref.po$/ }
554 readdir $dh;
555 @files = map { $_ =~ s/-pref.po$//; $_ } @files;
559 sub update {
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;
573 sub create {
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();
580 $self->remove_pot();
589 =head1 NAME
591 LangInstaller.pm - Handle templates and preferences translation
593 =head1 SYNOPSYS
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();
604 =head1 METHODS
606 =head2 new
608 Create a new instance of the installer object.
610 =head2 create
612 For the current language, create .po files for templates and preferences based
613 of the english ('en') version.
615 =head2 update
617 For the current language, update .po files.
619 =head2 install
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.
625 =over
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,
632 (3) preferences, and
633 (4) one for each MARC dialect.
636 =over
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
652 directory.
654 =item F<lang>-marc-{MARC}.po
656 Contains extracted text from english (en) files from opac and intranet,
657 related with MARC dialects.
659 =back
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>
667 =back
669 =cut