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 ( defined $row->{$field} and length($row->{$field}) > 1 # discard null values and 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 next unless defined $row->{$field}; # next if null value
657 my $po = $po_ref->{"\"$row->{$field}\""}; # quoted key
658 if ( $po and not defined( $po->fuzzy() ) # not fuzzy
659 and length( $po->msgid() ) > 2 # not empty msgid
660 and length( $po->msgstr() ) > 2 ) { # not empty msgstr
661 $row->{$field} = $po->dequote( $po->msgstr() );
668 # translate descriptions
669 for my $description ( @
{ $dstyml->{'description'} } ) {
670 my $po = $po_ref->{"\"$description\""};
671 if ( $po and not defined( $po->fuzzy() )
672 and length( $po->msgid() ) > 2
673 and length( $po->msgstr() ) > 2 ) {
674 $description = $po->dequote( $po->msgstr() );
681 sub install_installer
{
683 return unless ( $self->{installer
} );
685 my $intradir = $self->{context
}->config('intranetdir');
686 my $db_scheme = $self->{context
}->config('db_scheme');
687 my $langdir = "$intradir/installer/data/$db_scheme/$self->{lang}";
689 say "$self->{lang} installer dir $langdir already exists.\nDelete it if you want to recreate it." if $self->{verbose
};
693 say "Install installer files\n" if $self->{verbose
};
695 for my $target ( @
{ $self->{installer
} } ) {
696 return unless ( -e
$self->po_filename( $target->{suffix
} ) );
697 for my $dir ( @
{ $target->{dirs
} } ) {
698 ( my $tdir = "$dir" ) =~ s
|/en/|/$self->{lang}/|;
699 make_path
("$intradir/$tdir");
701 opendir( my $dh, "$intradir/$dir" ) or die ("Can't open $intradir/$dir");
702 my @files = grep { ! /^\.+$/ } readdir($dh);
705 for my $file ( @files ) {
706 if ( $file =~ /yml$/ ) {
707 my $translated_yaml = translate_yaml
( $self, $target, "$intradir/$dir/$file" );
708 open(my $fh, ">:encoding(UTF-8)", "$intradir/$tdir/$file");
709 DumpFile
( $fh, $translated_yaml );
712 File
::Copy
::copy
( "$intradir/$dir/$file", "$intradir/$tdir/$file" );
720 my ($self, $files) = @_;
722 say "Create templates\n" if $self->{verbose
};
723 for my $trans ( @
{$self->{interface
}} ) {
727 " Create templates .po files for '$trans->{name}'\n",
728 " From: $trans->{dir}/en/\n",
729 " To : $self->{path_po}/$self->{lang}$trans->{suffix}\n"
732 my $trans_dir = join("/en/ -i ",split(" ",$trans->{dir
}))."/en/"; # multiple source dirs
733 # if processing MARC po file, only use corresponding files
734 my $marc = ( $trans->{name
} =~ /MARC/ )?
"-m \"$trans->{name}\"":""; # for MARC translations
735 # if not processing MARC po file, ignore all MARC files
736 @nomarc = ( 'marc21', 'unimarc', 'normarc' ) if ( $trans->{name
} !~ /MARC/ ); # hardcoded MARC variants
739 "$self->{process} create " .
741 "-s $self->{path_po}/$self->{lang}$trans->{suffix} -r " .
743 ( @files ?
' -f ' . join ' -f ', @files : '') .
744 ( @nomarc ?
' -n ' . join ' -n ', @nomarc : '');
751 my ($language, $region, $country) = split /-/, $self->{lang
};
752 $country //= $region;
753 my $locale = $language;
754 if ($country && length($country) == 2) {
755 $locale .= '_' . $country;
761 sub create_messages
{
764 my $pot = "$Bin/$self->{domain}.pot";
765 my $po = "$self->{path_po}/$self->{lang}-messages.po";
766 my $js_pot = "$self->{domain}-js.pot";
767 my $js_po = "$self->{path_po}/$self->{lang}-messages-js.po";
769 unless ( -f
$pot && -f
$js_pot ) {
770 $self->extract_messages();
773 say "Create messages ($self->{lang})" if $self->{verbose
};
774 my $locale = $self->locale_name();
775 system "$self->{msginit} -i $pot -o $po -l $locale --no-translator 2> /dev/null";
776 warn "Problems creating $pot ".$?
if ( $?
== -1 );
777 system "$self->{msginit} -i $js_pot -o $js_po -l $locale --no-translator 2> /dev/null";
778 warn "Problems creating $js_pot ".$?
if ( $?
== -1 );
780 # If msginit failed to correctly set Plural-Forms, set a default one
781 system "$self->{sed} --in-place "
782 . "--expression='s/Plural-Forms: nplurals=INTEGER; plural=EXPRESSION/Plural-Forms: nplurals=2; plural=(n != 1)/' "
786 sub update_messages
{
789 my $pot = "$Bin/$self->{domain}.pot";
790 my $po = "$self->{path_po}/$self->{lang}-messages.po";
791 my $js_pot = "$self->{domain}-js.pot";
792 my $js_po = "$self->{path_po}/$self->{lang}-messages-js.po";
794 unless ( -f
$pot && -f
$js_pot ) {
795 $self->extract_messages();
798 if ( -f
$po && -f
$js_pot ) {
799 say "Update messages ($self->{lang})" if $self->{verbose
};
800 system "$self->{msgmerge} --backup=off --quiet -U $po $pot";
801 system "$self->{msgmerge} --backup=off --quiet -U $js_po $js_pot";
803 $self->create_messages();
807 sub extract_messages_from_templates
{
808 my ($self, $tempdir, $type, @files) = @_;
810 my $htdocs = $type eq 'intranet' ?
'intrahtdocs' : 'opachtdocs';
811 my $dir = $self->{context
}->config($htdocs);
812 my @keywords = qw(t tx tn txn tnx tp tpx tnp tnpx);
813 my $parser = Template
::Parser
->new();
815 foreach my $file (@files) {
816 say "Extract messages from $file" if $self->{verbose
};
817 my $template = read_file
(File
::Spec
->catfile($dir, $file));
819 # No need to process a file that doesn't use the i18n.inc file.
820 next unless $template =~ /i18n\.inc/;
822 my $data = $parser->parse($template);
824 warn "Error at $file : " . $parser->error();
828 my $destfile = $type eq 'intranet' ?
829 File
::Spec
->catfile($tempdir, 'koha-tmpl', 'intranet-tmpl', $file) :
830 File
::Spec
->catfile($tempdir, 'koha-tmpl', 'opac-tmpl', $file);
832 make_path
(dirname
($destfile));
833 open my $fh, '>', $destfile;
835 my @blocks = ($data->{BLOCK
}, values %{ $data->{DEFBLOCKS
} });
836 foreach my $block (@blocks) {
837 my $document = PPI
::Document
->new(\
$block);
839 # [% t('foo') %] is compiled to
840 # $output .= $stash->get(['t', ['foo']]);
841 # We try to find all nodes corresponding to keyword (here 't')
842 my $nodes = $document->find(sub {
843 my ($topnode, $element) = @_;
845 # Filter out non-valid keywords
846 return 0 unless ($element->isa('PPI::Token::Quote::Single'));
847 return 0 unless (grep {$element->content eq qq{'$_'}} @keywords);
849 # keyword (e.g. 't') should be the first element of the arrayref
850 # passed to $stash->get()
851 return 0 if $element->sprevious_sibling;
853 return 0 unless $element->snext_sibling
854 && $element->snext_sibling->snext_sibling
855 && $element->snext_sibling->snext_sibling->isa('PPI::Structure::Constructor');
857 # Check that it's indeed a call to $stash->get()
858 my $statement = $element->statement->parent->statement->parent->statement;
859 return 0 unless grep { $_->isa('PPI::Token::Symbol') && $_->content eq '$stash' } $statement->children;
860 return 0 unless grep { $_->isa('PPI::Token::Operator') && $_->content eq '->' } $statement->children;
861 return 0 unless grep { $_->isa('PPI::Token::Word') && $_->content eq 'get' } $statement->children;
868 # Write the Perl equivalent of calls to t* functions family, so
869 # xgettext can extract the strings correctly
870 foreach my $node (@
$nodes) {
872 $_->significant && !$_->isa('PPI::Token::Operator') ?
$_->content : ()
873 } $node->snext_sibling->snext_sibling->find_first('PPI::Statement')->children;
875 my $keyword = $node->content;
876 $keyword =~ s/^'t(.*)'$/__$1/;
878 # Only keep required args to have a clean output
879 my @required_args = shift @args;
880 push @required_args, shift @args if $keyword =~ /n/;
881 push @required_args, shift @args if $keyword =~ /p/;
883 say $fh "$keyword(" . join(', ', @required_args) . ");";
894 sub extract_messages
{
897 say "Extract messages into POT file" if $self->{verbose
};
899 my $intranetdir = $self->{context
}->config('intranetdir');
900 my $opacdir = $self->{context
}->config('opacdir');
902 # Find common ancestor directory
903 my @intranetdirs = File
::Spec
->splitdir($intranetdir);
904 my @opacdirs = File
::Spec
->splitdir($opacdir);
906 while (@intranetdirs and @opacdirs) {
907 my ($dir1, $dir2) = (shift @intranetdirs, shift @opacdirs);
908 last if $dir1 ne $dir2;
909 push @basedirs, $dir1;
911 my $basedir = File
::Spec
->catdir(@basedirs);
914 my @directories_to_scan = ('.');
915 my @blacklist = map { File
::Spec
->catdir(@intranetdirs, $_) } qw(blib koha-tmpl skel tmp t);
916 while (@directories_to_scan) {
917 my $dir = shift @directories_to_scan;
918 opendir DIR
, File
::Spec
->catdir($basedir, $dir) or die "Unable to open $dir: $!";
919 foreach my $entry (readdir DIR
) {
920 next if $entry =~ /^\./;
921 my $relentry = File
::Spec
->catfile($dir, $entry);
922 my $abspath = File
::Spec
->catfile($basedir, $relentry);
923 if (-d
$abspath and not grep { $_ eq $relentry } @blacklist) {
924 push @directories_to_scan, $relentry;
925 } elsif (-f
$abspath and $relentry =~ /\.(pl|pm)$/) {
926 push @files_to_scan, $relentry;
931 my $intrahtdocs = $self->{context
}->config('intrahtdocs');
932 my $opachtdocs = $self->{context
}->config('opachtdocs');
934 my @intranet_tt_files;
936 if ($File::Find
::dir
=~ m
|/en/| && $_ =~ m/\.(tt|inc)$/) {
937 my $filename = $File::Find
::name
;
938 $filename =~ s
|^$intrahtdocs/||;
939 push @intranet_tt_files, $filename;
945 if ($File::Find
::dir
=~ m
|/en/| && $_ =~ m/\.(tt|inc)$/) {
946 my $filename = $File::Find
::name
;
947 $filename =~ s
|^$opachtdocs/||;
948 push @opac_tt_files, $filename;
952 my $tempdir = tempdir
('Koha-translate-XXXX', TMPDIR
=> 1, CLEANUP
=> 1);
953 $self->extract_messages_from_templates($tempdir, 'intranet', @intranet_tt_files);
954 $self->extract_messages_from_templates($tempdir, 'opac', @opac_tt_files);
956 @intranet_tt_files = map { File
::Spec
->catfile('koha-tmpl', 'intranet-tmpl', $_) } @intranet_tt_files;
957 @opac_tt_files = map { File
::Spec
->catfile('koha-tmpl', 'opac-tmpl', $_) } @opac_tt_files;
958 my @tt_files = grep { -e File
::Spec
->catfile($tempdir, $_) } @intranet_tt_files, @opac_tt_files;
960 push @files_to_scan, @tt_files;
962 my $xgettext_common_args = "--force-po --from-code=UTF-8 "
963 . "--package-name=Koha --package-version='' "
964 . "-k -k__ -k__x -k__n:1,2 -k__nx:1,2 -k__xn:1,2 -k__p:1c,2 "
965 . "-k__px:1c,2 -k__np:1c,2,3 -k__npx:1c,2,3 -kN__ -kN__n:1,2 "
966 . "-kN__p:1c,2 -kN__np:1c,2,3 ";
967 my $xgettext_cmd = "$self->{xgettext} -L Perl $xgettext_common_args "
968 . "-o $Bin/$self->{domain}.pot -D $tempdir -D $basedir";
969 $xgettext_cmd .= " $_" foreach (@files_to_scan);
971 if (system($xgettext_cmd) != 0) {
972 die "system call failed: $xgettext_cmd";
976 "$intrahtdocs/prog/js",
977 "$opachtdocs/bootstrap/js",
982 if ($_ =~ m/\.js$/) {
983 my $filename = $File::Find
::name
;
984 $filename =~ s
|^$intranetdir/||;
985 push @js_files, $filename;
989 $xgettext_cmd = "$self->{xgettext} -L JavaScript $xgettext_common_args "
990 . "-o $Bin/$self->{domain}-js.pot -D $intranetdir";
991 $xgettext_cmd .= " $_" foreach (@js_files);
993 if (system($xgettext_cmd) != 0) {
994 die "system call failed: $xgettext_cmd";
997 my $replace_charset_cmd = "$self->{sed} --in-place " .
998 "--expression='s/charset=CHARSET/charset=UTF-8/' " .
999 "$Bin/$self->{domain}.pot $Bin/$self->{domain}-js.pot";
1000 if (system($replace_charset_cmd) != 0) {
1001 die "system call failed: $replace_charset_cmd";
1005 sub install_messages
{
1008 my $locale = $self->locale_name();
1009 my $modir = "$self->{path_po}/$locale/LC_MESSAGES";
1010 my $pofile = "$self->{path_po}/$self->{lang}-messages.po";
1011 my $mofile = "$modir/$self->{domain}.mo";
1012 my $js_pofile = "$self->{path_po}/$self->{lang}-messages-js.po";
1014 unless ( -f
$pofile && -f
$js_pofile ) {
1015 $self->create_messages();
1017 say "Install messages ($locale)" if $self->{verbose
};
1019 system "$self->{msgfmt} -o $mofile $pofile";
1021 my $js_locale_data = 'var json_locale_data = {"Koha":' . `$self->{po2json} $js_pofile` . '};';
1022 my $progdir = $self->{context
}->config('intrahtdocs') . '/prog';
1023 mkdir "$progdir/$self->{lang}/js";
1024 open my $fh, '>', "$progdir/$self->{lang}/js/locale_data.js";
1025 print $fh $js_locale_data;
1028 my $opachtdocs = $self->{context
}->config('opachtdocs');
1029 opendir(my $dh, $opachtdocs);
1030 for my $theme ( grep { not /^\.|lib|xslt/ } readdir($dh) ) {
1031 mkdir "$opachtdocs/$theme/$self->{lang}/js";
1032 open my $fh, '>', "$opachtdocs/$theme/$self->{lang}/js/locale_data.js";
1033 print $fh $js_locale_data;
1041 unlink "$Bin/$self->{domain}.pot";
1042 unlink "$Bin/$self->{domain}-js.pot";
1046 my ($self, $files) = @_;
1047 my @langs = $self->{lang
} ?
($self->{lang
}) : $self->get_all_langs();
1048 for my $lang ( @langs ) {
1049 $self->set_lang( $lang );
1050 opendir( my $dh, $self->{path_po
} );
1051 my @files = grep { $_ =~ /^$self->{lang}.*po$/ } readdir $dh;
1052 foreach my $file ( @files ) {
1053 say "Compress file $file" if $self->{verbose
};
1054 system "$self->{gzip} -9 $self->{path_po}/$file";
1060 my ($self, $files) = @_;
1061 my @langs = $self->{lang
} ?
($self->{lang
}) : $self->get_all_langs();
1062 for my $lang ( @langs ) {
1063 opendir( my $dh, $self->{path_po
} );
1064 $self->set_lang( $lang );
1065 my @files = grep { $_ =~ /^$self->{lang}.*po.gz$/ } readdir $dh;
1066 foreach my $file ( @files ) {
1067 say "Uncompress file $file" if $self->{verbose
};
1068 system "$self->{gunzip} $self->{path_po}/$file";
1074 my ($self, $files) = @_;
1075 return unless $self->{lang
};
1076 $self->uncompress();
1077 $self->install_tmpl($files) unless $self->{pref_only
};
1078 $self->install_prefs();
1079 $self->install_messages();
1080 $self->remove_pot();
1081 $self->install_installer();
1087 opendir( my $dh, $self->{path_po
} );
1088 my @files = grep { $_ =~ /-pref.(po|po.gz)$/ }
1090 @files = map { $_ =~ s/-pref.(po|po.gz)$//; $_ } @files;
1095 my ($self, $files) = @_;
1096 my @langs = $self->{lang
} ?
($self->{lang
}) : $self->get_all_langs();
1097 for my $lang ( @langs ) {
1098 $self->set_lang( $lang );
1099 $self->uncompress();
1100 $self->update_tmpl($files) unless $self->{pref_only
};
1101 $self->update_prefs();
1102 $self->update_messages();
1103 $self->update_installer();
1105 $self->remove_pot();
1110 my ($self, $files) = @_;
1111 return unless $self->{lang
};
1112 $self->create_tmpl($files) unless $self->{pref_only
};
1113 $self->create_prefs();
1114 $self->create_messages();
1115 $self->remove_pot();
1116 $self->create_installer();
1126 LangInstaller.pm - Handle templates and preferences translation
1130 my $installer = LangInstaller->new( 'fr-FR' );
1131 $installer->create();
1132 $installer->update();
1133 $installer->install();
1134 for my $lang ( @{$installer->{langs} ) {
1135 $installer->set_lang( $lan );
1136 $installer->install();
1143 Create a new instance of the installer object.
1147 For the current language, create .po files for templates and preferences based
1148 of the english ('en') version.
1152 For the current language, update .po files.
1156 For the current langage C<$self->{lang}, use .po files to translate the english
1157 version of templates and preferences files and copy those files in the
1158 appropriate directory.
1162 =item translate create F<lang>
1164 Create 4 kinds of .po files in F<po> subdirectory:
1165 (1) one from each theme on opac pages templates,
1166 (2) intranet templates,
1167 (3) preferences, and
1168 (4) one for each MARC dialect.
1173 =item F<lang>-opac-{theme}.po
1175 Contains extracted text from english (en) OPAC templates found in
1176 <KOHA_ROOT>/koha-tmpl/opac-tmpl/{theme}/en/ directory.
1178 =item F<lang>-staff-prog.po
1180 Contains extracted text from english (en) intranet templates found in
1181 <KOHA_ROOT>/koha-tmpl/intranet-tmpl/prog/en/ directory.
1183 =item F<lang>-pref.po
1185 Contains extracted text from english (en) preferences. They are found in files
1186 located in <KOHA_ROOT>/koha-tmpl/intranet-tmpl/prog/en/admin/preferences
1189 =item F<lang>-marc-{MARC}.po
1191 Contains extracted text from english (en) files from opac and intranet,
1192 related with MARC dialects.
1196 =item pref-trans update F<lang>
1198 Update .po files in F<po> directory, named F<lang>-*.po.
1200 =item pref-trans install F<lang>