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 DumpFile );
27 use FindBin qw( $Bin );
30 use File::Path qw( make_path );
34 use File::Temp qw( tempdir tempfile );
39 $YAML::Syck::ImplicitTyping = 1;
42 # Default file header for .po syspref files
43 my $default_pref_po_header = Locale::PO->new(-msgid => '', -msgstr =>
44 "Project-Id-Version: PACKAGE VERSION\\n" .
45 "PO-Revision-Date: YEAR-MO-DA HO:MI +ZONE\\n" .
46 "Last-Translator: FULL NAME <EMAIL\@ADDRESS>\\n" .
47 "Language-Team: Koha Translate List <koha-translate\@lists.koha-community.org>\\n" .
48 "MIME-Version: 1.0\\n" .
49 "Content-Type: text/plain; charset=UTF-8\\n" .
50 "Content-Transfer-Encoding: 8bit\\n" .
51 "Plural-Forms: nplurals=2; plural=(n > 1);\\n"
56 my ($self, $lang) = @_;
58 $self->{lang} = $lang;
59 $self->{po_path_lang} = $self->{context}->config('intrahtdocs') .
60 "/prog/$lang/modules/admin/preferences";
65 my ($class, $lang, $pref_only, $verbose) = @_;
69 my $context = C4::Context->new();
70 $self->{context} = $context;
71 $self->{path_pref_en} = $context->config('intrahtdocs') .
72 '/prog/en/modules/admin/preferences';
73 set_lang( $self, $lang ) if $lang;
74 $self->{pref_only} = $pref_only;
75 $self->{verbose} = $verbose;
76 $self->{process} = "$Bin/tmpl_process3.pl " . ($verbose ? '' : '-q');
77 $self->{path_po} = "$Bin/po";
78 $self->{po} = { '' => $default_pref_po_header };
79 $self->{domain} = 'Koha';
80 $self->{cp} = `which cp`;
81 $self->{msgmerge} = `which msgmerge`;
82 $self->{msgfmt} = `which msgfmt`;
83 $self->{msginit} = `which msginit`;
84 $self->{msgattrib} = `which msgattrib`;
85 $self->{xgettext} = `which xgettext`;
86 $self->{sed} = `which sed`;
87 $self->{po2json} = "$Bin/po2json";
88 $self->{gzip} = `which gzip`;
89 $self->{gunzip} = `which gunzip`;
91 chomp $self->{msgmerge};
92 chomp $self->{msgfmt};
93 chomp $self->{msginit};
94 chomp $self->{msgattrib};
95 chomp $self->{xgettext};
98 chomp $self->{gunzip};
100 unless ($self->{xgettext}) {
101 die "Missing 'xgettext' executable. Have you installed the gettext package?\n";
104 # Get all .pref file names
105 opendir my $fh, $self->{path_pref_en};
106 my @pref_files = grep { /\.pref$/ } readdir($fh);
108 $self->{pref_files} = \@pref_files;
110 # Get all available language codes
111 opendir $fh, $self->{path_po};
112 my @langs = map { ($_) =~ /(.*)-pref/ }
113 grep { $_ =~ /.*-pref/ } readdir($fh);
115 $self->{langs} = \@langs;
117 # Map for both interfaces opac/intranet
118 my $opachtdocs = $context->config('opachtdocs');
119 $self->{interface} = [
121 name => 'Intranet prog UI',
122 dir => $context->config('intrahtdocs') . '/prog',
123 suffix => '-staff-prog.po',
128 opendir my $dh, $context->config('opachtdocs');
129 for my $theme ( grep { not /^\.|lib|xslt/ } readdir($dh) ) {
130 push @{$self->{interface}}, {
131 name => "OPAC $theme",
132 dir => "$opachtdocs/$theme",
133 suffix => "-opac-$theme.po",
137 # MARC flavours (hardcoded list)
138 for ( "MARC21", "UNIMARC", "NORMARC" ) {
139 # search for strings on staff & opac marc files
140 my $dirs = $context->config('intrahtdocs') . '/prog';
141 opendir $fh, $context->config('opachtdocs');
142 for ( grep { not /^\.|\.\.|lib$|xslt/ } readdir($fh) ) {
143 $dirs .= ' ' . "$opachtdocs/$_";
145 push @{$self->{interface}}, {
148 suffix => "-marc-$_.po",
152 # EN YAML installer files
153 push @{$self->{installer}}, {
154 name => "YAML installer files",
155 dirs => [ 'installer/data/mysql/en/mandatory',
156 'installer/data/mysql/en/optional'],
157 suffix => "-installer.po",
160 # EN MARC21 YAML installer files
161 push @{$self->{installer}}, {
162 name => "MARC21 YAML installer files",
163 dirs => [ 'installer/data/mysql/en/marcflavour/marc21/mandatory',
164 'installer/data/mysql/en/marcflavour/marc21/optional'],
165 suffix => "-installer-MARC21.po",
168 # EN UNIMARC YAML installer files
169 push @{$self->{installer}}, {
170 name => "UNIMARC YAML installer files",
171 dirs => [ 'installer/data/mysql/en/marcflavour/unimarc/mandatory', ],
172 suffix => "-installer-UNIMARC.po",
183 my $context = C4::Context->new;
184 my $trans_path = $Bin . '/po';
185 my $trans_file = "$trans_path/" . $self->{lang} . $suffix;
191 my ($self, $id, $comment) = @_;
192 my $po = $self->{po};
195 $p->comment( $p->comment . "\n" . $comment );
198 $po->{$id} = Locale::PO->new(
199 -comment => $comment,
208 my ($self, $comment, $prefs) = @_;
210 for my $pref ( @$prefs ) {
212 for my $element ( @$pref ) {
213 if ( ref( $element) eq 'HASH' ) {
214 $pref_name = $element->{pref};
218 for my $element ( @$pref ) {
219 if ( ref( $element) eq 'HASH' ) {
220 while ( my ($key, $value) = each(%$element) ) {
221 next unless $key eq 'choices' or $key eq 'multiple';
222 next unless ref($value) eq 'HASH';
223 for my $ckey ( keys %$value ) {
224 my $id = $self->{file} . "#$pref_name# " . $value->{$ckey};
225 $self->po_append( $id, $comment );
230 $self->po_append( $self->{file} . "#$pref_name# $element", $comment );
238 my ($self, $id) = @_;
240 my $po = $self->{po}->{$id};
242 return Locale::PO->dequote($po->msgstr);
246 sub update_tab_prefs {
247 my ($self, $pref, $prefs) = @_;
249 for my $p ( @$prefs ) {
252 for my $element ( @$p ) {
253 if ( ref( $element) eq 'HASH' ) {
254 $pref_name = $element->{pref};
258 for my $i ( 0..@$p-1 ) {
259 my $element = $p->[$i];
260 if ( ref( $element) eq 'HASH' ) {
261 while ( my ($key, $value) = each(%$element) ) {
262 next unless $key eq 'choices' or $key eq 'multiple';
263 next unless ref($value) eq 'HASH';
264 for my $ckey ( keys %$value ) {
265 my $id = $self->{file} . "#$pref_name# " . $value->{$ckey};
266 my $text = $self->get_trans_text( $id );
267 $value->{$ckey} = $text if $text;
272 my $id = $self->{file} . "#$pref_name# $element";
273 my $text = $self->get_trans_text( $id );
274 $p->[$i] = $text if $text;
281 sub get_po_from_prefs {
284 for my $file ( @{$self->{pref_files}} ) {
285 my $pref = LoadFile( $self->{path_pref_en} . "/$file" );
286 $self->{file} = $file;
287 # Entries for tab titles
288 $self->po_append( $self->{file}, $_ ) for keys %$pref;
289 while ( my ($tab, $tab_content) = each %$pref ) {
290 if ( ref($tab_content) eq 'ARRAY' ) {
291 $self->add_prefs( $tab, $tab_content );
294 while ( my ($section, $sysprefs) = each %$tab_content ) {
295 my $comment = "$tab > $section";
296 $self->po_append( $self->{file} . " " . $section, $comment );
297 $self->add_prefs( $comment, $sysprefs );
307 # Create file header if it doesn't already exist
308 my $po = $self->{po};
309 $po->{''} ||= $default_pref_po_header;
311 # Write .po entries into a file put in Koha standard po directory
312 Locale::PO->save_file_fromhash( $self->po_filename("-pref.po"), $po );
313 say "Saved in file: ", $self->po_filename("-pref.po") if $self->{verbose};
317 sub get_po_merged_with_en {
320 # Get po from current 'en' .pref files
321 $self->get_po_from_prefs();
322 my $po_current = $self->{po};
324 # Get po from previous generation
325 my $po_previous = Locale::PO->load_file_ashash( $self->po_filename("-pref.po") );
327 for my $id ( keys %$po_current ) {
328 my $po = $po_previous->{Locale::PO->quote($id)};
330 my $text = Locale::PO->dequote( $po->msgstr );
331 $po_current->{$id}->msgstr( $text );
338 print "Update '", $self->{lang},
339 "' preferences .po file from 'en' .pref files\n" if $self->{verbose};
340 $self->get_po_merged_with_en();
348 unless ( -r $self->{po_path_lang} ) {
349 print "Koha directories hierarchy for ", $self->{lang}, " must be created first\n";
353 # Get the language .po file merged with last modified 'en' preferences
354 $self->get_po_merged_with_en();
356 for my $file ( @{$self->{pref_files}} ) {
357 my $pref = LoadFile( $self->{path_pref_en} . "/$file" );
358 $self->{file} = $file;
359 # First, keys are replaced (tab titles)
362 $self->get_trans_text( $self->{file} ) || $_ => $pref->{$_}
366 while ( my ($tab, $tab_content) = each %$pref ) {
367 if ( ref($tab_content) eq 'ARRAY' ) {
368 $self->update_tab_prefs( $pref, $tab_content );
371 while ( my ($section, $sysprefs) = each %$tab_content ) {
372 $self->update_tab_prefs( $pref, $sysprefs );
375 for my $section ( keys %$tab_content ) {
376 my $id = $self->{file} . " $section";
377 my $text = $self->get_trans_text($id);
378 my $nsection = $text ? $text : $section;
379 if( exists $ntab->{$nsection} ) {
380 # When translations collide (see BZ 18634)
381 push @{$ntab->{$nsection}}, @{$tab_content->{$section}};
383 $ntab->{$nsection} = $tab_content->{$section};
386 $pref->{$tab} = $ntab;
388 my $file_trans = $self->{po_path_lang} . "/$file";
389 print "Write $file\n" if $self->{verbose};
390 open my $fh, ">", $file_trans;
391 print $fh Dump($pref);
397 my ($self, $files) = @_;
398 say "Install templates" if $self->{verbose};
399 for my $trans ( @{$self->{interface}} ) {
400 my @t_dirs = split(" ", $trans->{dir});
401 for my $t_dir ( @t_dirs ) {
405 " Install templates '$trans->{name}'\n",
406 " From: $t_dir/en/\n",
407 " To : $t_dir/$self->{lang}\n",
408 " With: $self->{path_po}/$self->{lang}$trans->{suffix}\n"
411 my $trans_dir = "$t_dir/en/";
412 my $lang_dir = "$t_dir/$self->{lang}";
413 $lang_dir =~ s|/en/|/$self->{lang}/|;
414 mkdir $lang_dir unless -d $lang_dir;
415 # if installing MARC po file, only touch corresponding files
416 my $marc = ( $trans->{name} =~ /MARC/ )?"-m \"$trans->{name}\"":""; # for MARC translations
417 # if not installing MARC po file, ignore all MARC files
418 @nomarc = ( 'marc21', 'unimarc', 'normarc' ) if ( $trans->{name} !~ /MARC/ ); # hardcoded MARC variants
421 "$self->{process} install " .
424 "-s $self->{path_po}/$self->{lang}$trans->{suffix} -r " .
426 ( @files ? ' -f ' . join ' -f ', @files : '') .
427 ( @nomarc ? ' -n ' . join ' -n ', @nomarc : '');
434 my ($self, $files) = @_;
436 say "Update templates" if $self->{verbose};
437 for my $trans ( @{$self->{interface}} ) {
441 " Update templates '$trans->{name}'\n",
442 " From: $trans->{dir}/en/\n",
443 " To : $self->{path_po}/$self->{lang}$trans->{suffix}\n"
446 my $trans_dir = join("/en/ -i ",split(" ",$trans->{dir}))."/en/"; # multiple source dirs
447 # if processing MARC po file, only use corresponding files
448 my $marc = ( $trans->{name} =~ /MARC/ )?"-m \"$trans->{name}\"":""; # for MARC translations
449 # if not processing MARC po file, ignore all MARC files
450 @nomarc = ( 'marc21', 'unimarc', 'normarc' ) if ( $trans->{name} !~ /MARC/ ); # hardcoded MARC variants
453 "$self->{process} update " .
455 "-s $self->{path_po}/$self->{lang}$trans->{suffix} -r " .
457 ( @files ? ' -f ' . join ' -f ', @files : '') .
458 ( @nomarc ? ' -n ' . join ' -n ', @nomarc : '');
466 if ( -e $self->po_filename("-pref.po") ) {
467 say "Preferences .po file already exists. Delete it if you want to recreate it.";
470 $self->get_po_from_prefs();
474 sub get_po_from_target {
479 my $po_head = new Locale::PO;
480 $po_head->{msgid} = "\"\"";
481 $po_head->{msgstr} = "".
482 "Project-Id-Version: Koha Project - Installation files\\n" .
483 "PO-Revision-Date: YEAR-MO-DA HO:MI +ZONE\\n" .
484 "Last-Translator: FULL NAME <EMAIL\@ADDRESS>\\n" .
485 "Language-Team: Koha Translation Team\\n" .
486 "Language: ".$self->{lang}."\\n" .
487 "MIME-Version: 1.0\\n" .
488 "Content-Type: text/plain; charset=UTF-8\\n" .
489 "Content-Transfer-Encoding: 8bit\\n";
491 my @dirs = @{ $target->{dirs} };
492 my $intradir = $self->{context}->config('intranetdir');
493 for my $dir ( @dirs ) { # each dir
494 opendir( my $dh, "$intradir/$dir" ) or die ("Can't open $intradir/$dir");
495 my @filelist = grep { $_ =~ m/\.yml/ } readdir($dh); # Just yaml files
497 for my $file ( @filelist ) { # each file
498 my $yaml = LoadFile( "$intradir/$dir/$file" );
499 my @tables = @{ $yaml->{'tables'} };
501 for my $table ( @tables ) { # each table
503 my $table_name = ( keys %$table )[0];
504 my @translatable = @{ $table->{$table_name}->{translatable} };
505 my @rows = @{ $table->{$table_name}->{rows} };
506 my @multiline = @{ $table->{$table_name}->{'multiline'} }; # to check multiline values
508 for my $row ( @rows ) { # each row
510 for my $field ( @translatable ) { # each field
511 if ( @multiline and grep { $_ eq $field } @multiline ) { # multiline fields, only notices ATM
513 foreach my $line ( @{$row->{$field}} ) {
515 next if ( $line =~ /^(\s*<.*?>\s*$|^\s*\[.*?\]\s*|\s*)$/ ); # discard pure html, TT, empty
516 $line =~ s/(<<.*?>>|\[\%.*?\%\]|<.*?>)/\%s/g; # put placeholders
517 next if ( $line =~ /^(\s|%s|-|[[:punct:]]|\(|\))*$/ or length($line) < 2 ); # discard non strings
518 if ( not $po->{ $line } ) {
519 my $msg = new Locale::PO(
520 -msgid => $line, -msgstr => '',
521 -reference => "$dir/$file:$table_name:$tablec:row:$rowc:mul:$mulc" );
522 $po->{ $line } = $msg;
526 if ( length($row->{$field}) > 1 # discard small strings
527 and not $po->{ $row->{$field} } ) {
528 my $msg = new Locale::PO(
529 -msgid => $row->{$field}, -msgstr => '',
530 -reference => "$dir/$file:$table_name:$tablec:row:$rowc" );
531 $po->{ $row->{$field} } = $msg;
538 for my $description ( @{ $yaml->{'description'} } ) {
540 if ( length($description) > 1 and not $po->{ $description } ) {
541 my $msg = new Locale::PO(
542 -msgid => $description, -msgstr => '',
543 -reference => "$dir/$file:description:$desccount" );
544 $po->{ $description } = $msg;
549 $po->{''} = $po_head if ( $po );
554 sub create_installer {
556 return unless ( $self->{installer} );
558 say "Create installer translation files\n" if $self->{verbose};
560 my @targets = @{ $self->{installer} }; # each installer target (common,marc21,unimarc)
562 for my $target ( @targets ) {
563 if ( -e $self->po_filename( $target->{suffix} ) ) {
564 say "$self->{lang}$target->{suffix} file already exists. Delete it if you want to recreate it.";
569 for my $target ( @targets ) {
570 my $po = get_po_from_target( $self, $target );
571 # create output file only if there is something to write
573 my $po_file = $self->po_filename( $target->{suffix} );
574 Locale::PO->save_file_fromhash( $po_file, $po );
575 say "Saved in file: ", $po_file if $self->{verbose};
580 sub update_installer {
582 return unless ( $self->{installer} );
584 say "Update installer translation files\n" if $self->{verbose};
586 my @targets = @{ $self->{installer} }; # each installer target (common,marc21,unimarc)
588 for my $target ( @targets ) {
589 return unless ( -e $self->po_filename( $target->{suffix} ) );
590 my $po = get_po_from_target( $self, $target );
591 # update file only if there is something to update
593 my ( $fh, $po_temp ) = tempfile();
594 binmode( $fh, ":encoding(UTF-8)" );
595 Locale::PO->save_file_fromhash( $po_temp, $po );
596 my $po_file = $self->po_filename( $target->{suffix} );
598 my $st = system($self->{msgmerge}." ".($self->{verbose}?'':'-q').
599 " -s $po_file $po_temp -o - | ".$self->{msgattrib}." --no-obsolete -o $po_file");
601 say "Updated file: ", $po_file if $self->{verbose};
611 my $po_file = $self->po_filename( $target->{suffix} );
612 return $srcyml unless ( -e $po_file );
614 my $po_ref = Locale::PO->load_file_ashash( $po_file );
616 my $dstyml = LoadFile( $srcyml );
618 # translate fields in table rows
619 my @tables = @{ $dstyml->{'tables'} };
620 for my $table ( @tables ) { # each table
621 my $table_name = ( keys %$table )[0];
622 my @translatable = @{ $table->{$table_name}->{translatable} };
623 my @rows = @{ $table->{$table_name}->{rows} };
624 my @multiline = @{ $table->{$table_name}->{'multiline'} }; # to check multiline values
625 for my $row ( @rows ) { # each row
626 for my $field ( @translatable ) { # each translatable field
627 if ( @multiline and grep { $_ eq $field } @multiline ) { # multiline fields, only notices ATM
628 foreach my $line ( @{$row->{$field}} ) {
629 next if ( $line =~ /^(\s*<.*?>\s*$|^\s*\[.*?\]\s*|\s*)$/ ); # discard pure html, TT, empty
631 while ( $line =~ s/(<<.*?>>|\[\%.*?\%\]|<.*?>)/\%s/ ) { # put placeholders, save matches
636 if ( $line =~ /^(\s|%s|-|[[:punct:]]|\(|\))*$/ ) { # ignore non strings
637 while ( @ttvar ) { # restore placeholders
638 my $var = shift @ttvar;
639 $line =~ s/\%s/$var/;
643 my $po = $po_ref->{"\"$line\""}; # quoted key
644 if ( $po and not defined( $po->fuzzy() ) # not fuzzy
645 and length( $po->msgid() ) > 2 # not empty msgid
646 and length( $po->msgstr() ) > 2 ) { # not empty msgstr
647 $line = $po->dequote( $po->msgstr() );
649 while ( @ttvar ) { # restore placeholders
650 my $var = shift @ttvar;
651 $line =~ s/\%s/$var/;
656 my $po = $po_ref->{"\"$row->{$field}\""}; # quoted key
657 if ( $po and not defined( $po->fuzzy() ) # not fuzzy
658 and length( $po->msgid() ) > 2 # not empty msgid
659 and length( $po->msgstr() ) > 2 ) { # not empty msgstr
660 $row->{$field} = $po->dequote( $po->msgstr() );
667 # translate descriptions
668 for my $description ( @{ $dstyml->{'description'} } ) {
669 my $po = $po_ref->{"\"$description\""};
670 if ( $po and not defined( $po->fuzzy() )
671 and length( $po->msgid() ) > 2
672 and length( $po->msgstr() ) > 2 ) {
673 $description = $po->dequote( $po->msgstr() );
680 sub install_installer {
682 return unless ( $self->{installer} );
684 my $intradir = $self->{context}->config('intranetdir');
685 my $db_scheme = $self->{context}->config('db_scheme');
686 my $langdir = "$intradir/installer/data/$db_scheme/$self->{lang}";
688 say "$self->{lang} installer dir $langdir already exists.\nDelete it if you want to recreate it.";
692 say "Install installer files\n" if $self->{verbose};
694 for my $target ( @{ $self->{installer} } ) {
695 return unless ( -e $self->po_filename( $target->{suffix} ) );
696 for my $dir ( @{ $target->{dirs} } ) {
697 ( my $tdir = "$dir" ) =~ s|/en/|/$self->{lang}/|;
698 make_path("$intradir/$tdir");
700 opendir( my $dh, "$intradir/$dir" ) or die ("Can't open $intradir/$dir");
701 my @files = grep { ! /^\.+$/ } readdir($dh);
704 for my $file ( @files ) {
705 if ( $file =~ /yml$/ ) {
706 my $translated_yaml = translate_yaml( $self, $target, "$intradir/$dir/$file" );
707 open(my $fh, ">:encoding(UTF-8)", "$intradir/$tdir/$file");
708 DumpFile( $fh, $translated_yaml );
711 File::Copy::copy( "$intradir/$dir/$file", "$intradir/$tdir/$file" );
719 my ($self, $files) = @_;
721 say "Create templates\n" if $self->{verbose};
722 for my $trans ( @{$self->{interface}} ) {
726 " Create templates .po files for '$trans->{name}'\n",
727 " From: $trans->{dir}/en/\n",
728 " To : $self->{path_po}/$self->{lang}$trans->{suffix}\n"
731 my $trans_dir = join("/en/ -i ",split(" ",$trans->{dir}))."/en/"; # multiple source dirs
732 # if processing MARC po file, only use corresponding files
733 my $marc = ( $trans->{name} =~ /MARC/ )?"-m \"$trans->{name}\"":""; # for MARC translations
734 # if not processing MARC po file, ignore all MARC files
735 @nomarc = ( 'marc21', 'unimarc', 'normarc' ) if ( $trans->{name} !~ /MARC/ ); # hardcoded MARC variants
738 "$self->{process} create " .
740 "-s $self->{path_po}/$self->{lang}$trans->{suffix} -r " .
742 ( @files ? ' -f ' . join ' -f ', @files : '') .
743 ( @nomarc ? ' -n ' . join ' -n ', @nomarc : '');
750 my ($language, $region, $country) = split /-/, $self->{lang};
751 $country //= $region;
752 my $locale = $language;
753 if ($country && length($country) == 2) {
754 $locale .= '_' . $country;
760 sub create_messages {
763 my $pot = "$Bin/$self->{domain}.pot";
764 my $po = "$self->{path_po}/$self->{lang}-messages.po";
765 my $js_pot = "$self->{domain}-js.pot";
766 my $js_po = "$self->{path_po}/$self->{lang}-messages-js.po";
768 unless ( -f $pot && -f $js_pot ) {
769 $self->extract_messages();
772 say "Create messages ($self->{lang})" if $self->{verbose};
773 my $locale = $self->locale_name();
774 system "$self->{msginit} -i $pot -o $po -l $locale --no-translator 2> /dev/null";
775 warn "Problems creating $pot ".$? if ( $? == -1 );
776 system "$self->{msginit} -i $js_pot -o $js_po -l $locale --no-translator 2> /dev/null";
777 warn "Problems creating $js_pot ".$? if ( $? == -1 );
779 # If msginit failed to correctly set Plural-Forms, set a default one
780 system "$self->{sed} --in-place "
781 . "--expression='s/Plural-Forms: nplurals=INTEGER; plural=EXPRESSION/Plural-Forms: nplurals=2; plural=(n != 1)/' "
785 sub update_messages {
788 my $pot = "$Bin/$self->{domain}.pot";
789 my $po = "$self->{path_po}/$self->{lang}-messages.po";
790 my $js_pot = "$self->{domain}-js.pot";
791 my $js_po = "$self->{path_po}/$self->{lang}-messages-js.po";
793 unless ( -f $pot && -f $js_pot ) {
794 $self->extract_messages();
797 if ( -f $po && -f $js_pot ) {
798 say "Update messages ($self->{lang})" if $self->{verbose};
799 system "$self->{msgmerge} --backup=off --quiet -U $po $pot";
800 system "$self->{msgmerge} --backup=off --quiet -U $js_po $js_pot";
802 $self->create_messages();
806 sub extract_messages_from_templates {
807 my ($self, $tempdir, $type, @files) = @_;
809 my $htdocs = $type eq 'intranet' ? 'intrahtdocs' : 'opachtdocs';
810 my $dir = $self->{context}->config($htdocs);
811 my @keywords = qw(t tx tn txn tnx tp tpx tnp tnpx);
812 my $parser = Template::Parser->new();
814 foreach my $file (@files) {
815 say "Extract messages from $file" if $self->{verbose};
816 my $template = read_file(File::Spec->catfile($dir, $file));
818 # No need to process a file that doesn't use the i18n.inc file.
819 next unless $template =~ /i18n\.inc/;
821 my $data = $parser->parse($template);
823 warn "Error at $file : " . $parser->error();
827 my $destfile = $type eq 'intranet' ?
828 File::Spec->catfile($tempdir, 'koha-tmpl', 'intranet-tmpl', $file) :
829 File::Spec->catfile($tempdir, 'koha-tmpl', 'opac-tmpl', $file);
831 make_path(dirname($destfile));
832 open my $fh, '>', $destfile;
834 my @blocks = ($data->{BLOCK}, values %{ $data->{DEFBLOCKS} });
835 foreach my $block (@blocks) {
836 my $document = PPI::Document->new(\$block);
838 # [% t('foo') %] is compiled to
839 # $output .= $stash->get(['t', ['foo']]);
840 # We try to find all nodes corresponding to keyword (here 't')
841 my $nodes = $document->find(sub {
842 my ($topnode, $element) = @_;
844 # Filter out non-valid keywords
845 return 0 unless ($element->isa('PPI::Token::Quote::Single'));
846 return 0 unless (grep {$element->content eq qq{'$_'}} @keywords);
848 # keyword (e.g. 't') should be the first element of the arrayref
849 # passed to $stash->get()
850 return 0 if $element->sprevious_sibling;
852 return 0 unless $element->snext_sibling
853 && $element->snext_sibling->snext_sibling
854 && $element->snext_sibling->snext_sibling->isa('PPI::Structure::Constructor');
856 # Check that it's indeed a call to $stash->get()
857 my $statement = $element->statement->parent->statement->parent->statement;
858 return 0 unless grep { $_->isa('PPI::Token::Symbol') && $_->content eq '$stash' } $statement->children;
859 return 0 unless grep { $_->isa('PPI::Token::Operator') && $_->content eq '->' } $statement->children;
860 return 0 unless grep { $_->isa('PPI::Token::Word') && $_->content eq 'get' } $statement->children;
867 # Write the Perl equivalent of calls to t* functions family, so
868 # xgettext can extract the strings correctly
869 foreach my $node (@$nodes) {
871 $_->significant && !$_->isa('PPI::Token::Operator') ? $_->content : ()
872 } $node->snext_sibling->snext_sibling->find_first('PPI::Statement')->children;
874 my $keyword = $node->content;
875 $keyword =~ s/^'t(.*)'$/__$1/;
877 # Only keep required args to have a clean output
878 my @required_args = shift @args;
879 push @required_args, shift @args if $keyword =~ /n/;
880 push @required_args, shift @args if $keyword =~ /p/;
882 say $fh "$keyword(" . join(', ', @required_args) . ");";
893 sub extract_messages {
896 say "Extract messages into POT file" if $self->{verbose};
898 my $intranetdir = $self->{context}->config('intranetdir');
899 my $opacdir = $self->{context}->config('opacdir');
901 # Find common ancestor directory
902 my @intranetdirs = File::Spec->splitdir($intranetdir);
903 my @opacdirs = File::Spec->splitdir($opacdir);
905 while (@intranetdirs and @opacdirs) {
906 my ($dir1, $dir2) = (shift @intranetdirs, shift @opacdirs);
907 last if $dir1 ne $dir2;
908 push @basedirs, $dir1;
910 my $basedir = File::Spec->catdir(@basedirs);
913 my @directories_to_scan = ('.');
914 my @blacklist = map { File::Spec->catdir(@intranetdirs, $_) } qw(blib koha-tmpl skel tmp t);
915 while (@directories_to_scan) {
916 my $dir = shift @directories_to_scan;
917 opendir DIR, File::Spec->catdir($basedir, $dir) or die "Unable to open $dir: $!";
918 foreach my $entry (readdir DIR) {
919 next if $entry =~ /^\./;
920 my $relentry = File::Spec->catfile($dir, $entry);
921 my $abspath = File::Spec->catfile($basedir, $relentry);
922 if (-d $abspath and not grep { $_ eq $relentry } @blacklist) {
923 push @directories_to_scan, $relentry;
924 } elsif (-f $abspath and $relentry =~ /\.(pl|pm)$/) {
925 push @files_to_scan, $relentry;
930 my $intrahtdocs = $self->{context}->config('intrahtdocs');
931 my $opachtdocs = $self->{context}->config('opachtdocs');
933 my @intranet_tt_files;
935 if ($File::Find::dir =~ m|/en/| && $_ =~ m/\.(tt|inc)$/) {
936 my $filename = $File::Find::name;
937 $filename =~ s|^$intrahtdocs/||;
938 push @intranet_tt_files, $filename;
944 if ($File::Find::dir =~ m|/en/| && $_ =~ m/\.(tt|inc)$/) {
945 my $filename = $File::Find::name;
946 $filename =~ s|^$opachtdocs/||;
947 push @opac_tt_files, $filename;
951 my $tempdir = tempdir('Koha-translate-XXXX', TMPDIR => 1, CLEANUP => 1);
952 $self->extract_messages_from_templates($tempdir, 'intranet', @intranet_tt_files);
953 $self->extract_messages_from_templates($tempdir, 'opac', @opac_tt_files);
955 @intranet_tt_files = map { File::Spec->catfile('koha-tmpl', 'intranet-tmpl', $_) } @intranet_tt_files;
956 @opac_tt_files = map { File::Spec->catfile('koha-tmpl', 'opac-tmpl', $_) } @opac_tt_files;
957 my @tt_files = grep { -e File::Spec->catfile($tempdir, $_) } @intranet_tt_files, @opac_tt_files;
959 push @files_to_scan, @tt_files;
961 my $xgettext_common_args = "--force-po --from-code=UTF-8 "
962 . "--package-name=Koha --package-version='' "
963 . "-k -k__ -k__x -k__n:1,2 -k__nx:1,2 -k__xn:1,2 -k__p:1c,2 "
964 . "-k__px:1c,2 -k__np:1c,2,3 -k__npx:1c,2,3 -kN__ -kN__n:1,2 "
965 . "-kN__p:1c,2 -kN__np:1c,2,3 ";
966 my $xgettext_cmd = "$self->{xgettext} -L Perl $xgettext_common_args "
967 . "-o $Bin/$self->{domain}.pot -D $tempdir -D $basedir";
968 $xgettext_cmd .= " $_" foreach (@files_to_scan);
970 if (system($xgettext_cmd) != 0) {
971 die "system call failed: $xgettext_cmd";
975 "$intrahtdocs/prog/js",
976 "$opachtdocs/bootstrap/js",
981 if ($_ =~ m/\.js$/) {
982 my $filename = $File::Find::name;
983 $filename =~ s|^$intranetdir/||;
984 push @js_files, $filename;
988 $xgettext_cmd = "$self->{xgettext} -L JavaScript $xgettext_common_args "
989 . "-o $Bin/$self->{domain}-js.pot -D $intranetdir";
990 $xgettext_cmd .= " $_" foreach (@js_files);
992 if (system($xgettext_cmd) != 0) {
993 die "system call failed: $xgettext_cmd";
996 my $replace_charset_cmd = "$self->{sed} --in-place " .
997 "--expression='s/charset=CHARSET/charset=UTF-8/' " .
998 "$Bin/$self->{domain}.pot $Bin/$self->{domain}-js.pot";
999 if (system($replace_charset_cmd) != 0) {
1000 die "system call failed: $replace_charset_cmd";
1004 sub install_messages {
1007 my $locale = $self->locale_name();
1008 my $modir = "$self->{path_po}/$locale/LC_MESSAGES";
1009 my $pofile = "$self->{path_po}/$self->{lang}-messages.po";
1010 my $mofile = "$modir/$self->{domain}.mo";
1011 my $js_pofile = "$self->{path_po}/$self->{lang}-messages-js.po";
1013 unless ( -f $pofile && -f $js_pofile ) {
1014 $self->create_messages();
1016 say "Install messages ($locale)" if $self->{verbose};
1018 system "$self->{msgfmt} -o $mofile $pofile";
1020 my $js_locale_data = 'var json_locale_data = {"Koha":' . `$self->{po2json} $js_pofile` . '};';
1021 my $progdir = $self->{context}->config('intrahtdocs') . '/prog';
1022 mkdir "$progdir/$self->{lang}/js";
1023 open my $fh, '>', "$progdir/$self->{lang}/js/locale_data.js";
1024 print $fh $js_locale_data;
1027 my $opachtdocs = $self->{context}->config('opachtdocs');
1028 opendir(my $dh, $opachtdocs);
1029 for my $theme ( grep { not /^\.|lib|xslt/ } readdir($dh) ) {
1030 mkdir "$opachtdocs/$theme/$self->{lang}/js";
1031 open my $fh, '>', "$opachtdocs/$theme/$self->{lang}/js/locale_data.js";
1032 print $fh $js_locale_data;
1040 unlink "$Bin/$self->{domain}.pot";
1041 unlink "$Bin/$self->{domain}-js.pot";
1045 my ($self, $files) = @_;
1046 my @langs = $self->{lang} ? ($self->{lang}) : $self->get_all_langs();
1047 for my $lang ( @langs ) {
1048 $self->set_lang( $lang );
1049 opendir( my $dh, $self->{path_po} );
1050 my @files = grep { $_ =~ /^$self->{lang}.*po$/ } readdir $dh;
1051 foreach my $file ( @files ) {
1052 say "Compress file $file" if $self->{verbose};
1053 system "$self->{gzip} -9 $self->{path_po}/$file";
1059 my ($self, $files) = @_;
1060 my @langs = $self->{lang} ? ($self->{lang}) : $self->get_all_langs();
1061 for my $lang ( @langs ) {
1062 opendir( my $dh, $self->{path_po} );
1063 $self->set_lang( $lang );
1064 my @files = grep { $_ =~ /^$self->{lang}.*po.gz$/ } readdir $dh;
1065 foreach my $file ( @files ) {
1066 say "Uncompress file $file" if $self->{verbose};
1067 system "$self->{gunzip} $self->{path_po}/$file";
1073 my ($self, $files) = @_;
1074 return unless $self->{lang};
1075 $self->uncompress();
1076 $self->install_tmpl($files) unless $self->{pref_only};
1077 $self->install_prefs();
1078 $self->install_messages();
1079 $self->remove_pot();
1080 $self->install_installer();
1086 opendir( my $dh, $self->{path_po} );
1087 my @files = grep { $_ =~ /-pref.(po|po.gz)$/ }
1089 @files = map { $_ =~ s/-pref.(po|po.gz)$//; $_ } @files;
1094 my ($self, $files) = @_;
1095 my @langs = $self->{lang} ? ($self->{lang}) : $self->get_all_langs();
1096 for my $lang ( @langs ) {
1097 $self->set_lang( $lang );
1098 $self->uncompress();
1099 $self->update_tmpl($files) unless $self->{pref_only};
1100 $self->update_prefs();
1101 $self->update_messages();
1102 $self->update_installer();
1104 $self->remove_pot();
1109 my ($self, $files) = @_;
1110 return unless $self->{lang};
1111 $self->create_tmpl($files) unless $self->{pref_only};
1112 $self->create_prefs();
1113 $self->create_messages();
1114 $self->remove_pot();
1115 $self->create_installer();
1125 LangInstaller.pm - Handle templates and preferences translation
1129 my $installer = LangInstaller->new( 'fr-FR' );
1130 $installer->create();
1131 $installer->update();
1132 $installer->install();
1133 for my $lang ( @{$installer->{langs} ) {
1134 $installer->set_lang( $lan );
1135 $installer->install();
1142 Create a new instance of the installer object.
1146 For the current language, create .po files for templates and preferences based
1147 of the english ('en') version.
1151 For the current language, update .po files.
1155 For the current langage C<$self->{lang}, use .po files to translate the english
1156 version of templates and preferences files and copy those files in the
1157 appropriate directory.
1161 =item translate create F<lang>
1163 Create 4 kinds of .po files in F<po> subdirectory:
1164 (1) one from each theme on opac pages templates,
1165 (2) intranet templates,
1166 (3) preferences, and
1167 (4) one for each MARC dialect.
1172 =item F<lang>-opac-{theme}.po
1174 Contains extracted text from english (en) OPAC templates found in
1175 <KOHA_ROOT>/koha-tmpl/opac-tmpl/{theme}/en/ directory.
1177 =item F<lang>-staff-prog.po
1179 Contains extracted text from english (en) intranet templates found in
1180 <KOHA_ROOT>/koha-tmpl/intranet-tmpl/prog/en/ directory.
1182 =item F<lang>-pref.po
1184 Contains extracted text from english (en) preferences. They are found in files
1185 located in <KOHA_ROOT>/koha-tmpl/intranet-tmpl/prog/en/admin/preferences
1188 =item F<lang>-marc-{MARC}.po
1190 Contains extracted text from english (en) files from opac and intranet,
1191 related with MARC dialects.
1195 =item pref-trans update F<lang>
1197 Update .po files in F<po> directory, named F<lang>-*.po.
1199 =item pref-trans install F<lang>