# with Koha; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-use strict;
-use warnings;
+use Modern::Perl;
use C4::Context;
# WARNING: Any other tested YAML library fails to work properly in this
$YAML::Syck::ImplicitTyping = 1;
+
+# Default file header for .po syspref files
+my $default_pref_po_header = Locale::PO->new(-msgid => '', -msgstr =>
+ "Project-Id-Version: PACKAGE VERSION\\n" .
+ "PO-Revision-Date: YEAR-MO-DA HO:MI +ZONE\\n" .
+ "Last-Translator: FULL NAME <EMAIL\@ADDRESS>\\n" .
+ "Language-Team: Koha Translate List <koha-translate\@lists.koha-community.org>\\n" .
+ "MIME-Version: 1.0\\n" .
+ "Content-Type: text/plain; charset=UTF-8\\n" .
+ "Content-Transfer-Encoding: 8bit\\n" .
+ "Plural-Forms: nplurals=2; plural=(n > 1);\\n"
+);
+
+
sub set_lang {
my ($self, $lang) = @_;
sub new {
- my ($class, $lang, $pref_only) = @_;
+ my ($class, $lang, $pref_only, $verbose) = @_;
my $self = { };
'/prog/en/modules/admin/preferences';
set_lang( $self, $lang ) if $lang;
$self->{pref_only} = $pref_only;
- $self->{translator_path} = $Bin;
- $self->{path_po} = $self->{translator_path} . "/po";
- $self->{po} = {};
+ $self->{verbose} = $verbose;
+ $self->{process} = "$Bin/tmpl_process3.pl " . ($verbose ? '' : '-q');
+ $self->{path_po} = "$Bin/po";
+ $self->{po} = { '' => $default_pref_po_header };
+ $self->{domain} = 'messages';
+ $self->{cp} = `which cp`;
+ $self->{msgmerge} = `which msgmerge`;
+ $self->{xgettext} = `which xgettext`;
+ $self->{sed} = `which sed`;
+ chomp $self->{cp};
+ chomp $self->{msgmerge};
+ chomp $self->{xgettext};
+ chomp $self->{sed};
# Get all .pref file names
opendir my $fh, $self->{path_pref_en};
# Get all available language codes
opendir $fh, $self->{path_po};
my @langs = map { ($_) =~ /(.*)-i-opac/ }
- grep { $_ =~ /.*-opac-/ } readdir($fh);
+ grep { $_ =~ /.*-opac-t-prog/ } readdir($fh);
closedir $fh;
$self->{langs} = \@langs;
# Map for both interfaces opac/intranet
- $self->{interface} = {
- opac => {
- dir => $context->config('opachtdocs') . '/prog',
- suffix => '-i-opac-t-prog-v-3002000.po',
+ my $opachtdocs = $context->config('opachtdocs');
+ $self->{interface} = [
+ {
+ name => 'OPAC prog',
+ dir => "$opachtdocs/prog",
+ suffix => '-i-opac-t-prog-v-3006000.po',
},
- intranet => {
+ {
+ name => 'Intranet prog UI',
dir => $context->config('intrahtdocs') . '/prog',
- suffix => '-i-staff-t-prog-v-3002000.po',
- }
- };
+ suffix => '-i-staff-t-prog-v-3006000.po',
+ },
+ {
+ name => 'Intranet prog help',
+ dir => $context->config('intrahtdocs') . '/prog/en/modules/help',
+ suffix => '-staff-help.po',
+ },
+ ];
+
+ # Alternate opac themes
+ opendir $fh, $context->config('opachtdocs');
+ for ( grep { not /^\.|\.\.|prog|lib$/ } readdir($fh) ) {
+ push @{$self->{interface}}, {
+ name => "OPAC $_",
+ dir => "$opachtdocs/$_",
+ suffix => "-opac-$_.po",
+ };
+ }
bless $self, $class;
}
sub save_po {
my $self = shift;
+
+ # Create file header if it doesn't already exist
+ my $po = $self->{po};
+ $po->{''} ||= $default_pref_po_header;
+
# Write .po entries into a file put in Koha standard po directory
- Locale::PO->save_file_fromhash( $self->po_filename, $self->{po} );
- print "Saved in file: ", $self->po_filename, "\n";
+ Locale::PO->save_file_fromhash( $self->po_filename, $po );
+ say "Saved in file: ", $self->po_filename if $self->{verbose};
}
sub update_prefs {
my $self = shift;
print "Update '", $self->{lang},
- "' preferences .po file from 'en' .pref files\n";
+ "' preferences .po file from 'en' .pref files\n" if $self->{verbose};
$self->get_po_merged_with_en();
$self->save_po();
}
$pref->{$tab} = $ntab;
}
my $file_trans = $self->{po_path_lang} . "/$file";
- print "Write $file\n";
+ print "Write $file\n" if $self->{verbose};
open my $fh, ">", $file_trans;
print $fh Dump($pref);
}
sub install_tmpl {
- my $self = shift;
-
- print
- "Install templates\n";
- while ( my ($interface, $tmpl) = each %{$self->{interface}} ) {
+ my ($self, $files) = @_;
+ say "Install templates" if $self->{verbose};
+ for my $trans ( @{$self->{interface}} ) {
print
- " Install templates '$interface\n",
- " From: $tmpl->{dir}/en/\n",
- " To : $tmpl->{dir}/$self->{lang}\n",
- " With: $self->{path_po}/$self->{lang}$tmpl->{suffix}\n";
- my $lang_dir = "$tmpl->{dir}/$self->{lang}";
+ " Install templates '$trans->{name}'\n",
+ " From: $trans->{dir}/en/\n",
+ " To : $trans->{dir}/$self->{lang}\n",
+ " With: $self->{path_po}/$self->{lang}$trans->{suffix}\n"
+ if $self->{verbose};
+
+ my $trans_dir = ( $trans->{name} =~ /help/ )?"$trans->{dir}":"$trans->{dir}/en/";
+ my $lang_dir = ( $trans->{name} =~ /help/ )?"$trans->{dir}":"$trans->{dir}/$self->{lang}";
+ $lang_dir =~ s|/en/|/$self->{lang}/|;
mkdir $lang_dir unless -d $lang_dir;
+ my $excludes = ( $trans->{name} =~ /UI/ )?"-x 'help'":"";
+
system
- "$self->{translator_path}/tmpl_process3.pl install " .
- "-i $tmpl->{dir}/en/ " .
- "-o $tmpl->{dir}/$self->{lang} ".
- "-s $self->{path_po}/$self->{lang}$tmpl->{suffix} -r"
+ "$self->{process} install " .
+ "-i $trans_dir " .
+ "-o $lang_dir ".
+ "-s $self->{path_po}/$self->{lang}$trans->{suffix} -r $excludes" .
+ (
+ @$files
+ ? ' -f ' . join ' -f ', @$files
+ : ''
+ )
}
}
sub update_tmpl {
- my $self = shift;
+ my ($self, $files) = @_;
- print
- "Update templates\n";
- while ( my ($interface, $tmpl) = each %{$self->{interface}} ) {
+ say "Update templates" if $self->{verbose};
+ for my $trans ( @{$self->{interface}} ) {
print
- " Update templates '$interface'\n",
- " From: $tmpl->{dir}/en/\n",
- " To : $self->{path_po}/$self->{lang}$tmpl->{suffix}\n";
- my $lang_dir = "$tmpl->{dir}/$self->{lang}";
+ " Update templates '$trans->{name}'\n",
+ " From: $trans->{dir}/en/\n",
+ " To : $self->{path_po}/$self->{lang}$trans->{suffix}\n"
+ if $self->{verbose};
+ my $lang_dir = "$trans->{dir}/$self->{lang}";
mkdir $lang_dir unless -d $lang_dir;
+
+ my $trans_dir = ( $trans->{name} =~ /help/ )?"$trans->{dir}":"$trans->{dir}/en/";
+ my $excludes = ( $trans->{name} =~ /UI/ )?"-x 'help'":"";
+
system
- "$self->{translator_path}/tmpl_process3.pl update " .
- "-i $tmpl->{dir}/en/ " .
- "-s $self->{path_po}/$self->{lang}$tmpl->{suffix} -r"
+ "$self->{process} update " .
+ "-i $trans_dir " .
+ "-s $self->{path_po}/$self->{lang}$trans->{suffix} -r $excludes" .
+ (
+ @$files
+ ? ' -f ' . join ' -f ', @$files
+ : ''
+ )
}
}
sub create_prefs {
my $self = shift;
+ if ( -e $self->po_filename ) {
+ say "Preferences .po file already exists. Delete it if you want to recreate it.";
+ return;
+ }
$self->get_po_from_prefs();
$self->save_po();
}
sub create_tmpl {
- my $self = shift;
+ my ($self, $files) = @_;
- print
- "Create templates\n";
- while ( my ($interface, $tmpl) = each %{$self->{interface}} ) {
+ say "Create templates\n" if $self->{verbose};
+ for my $trans ( @{$self->{interface}} ) {
print
- " Create templates .po files for '$interface'\n",
- " From: $tmpl->{dir}/en/\n",
- " To : $self->{path_po}/$self->{lang}$tmpl->{suffix}\n";
+ " Create templates .po files for '$trans->{name}'\n",
+ " From: $trans->{dir}/en/\n",
+ " To : $self->{path_po}/$self->{lang}$trans->{suffix}\n"
+ if $self->{verbose};
+
+ my $trans_dir = ( $trans->{name} =~ /help/ )?"$trans->{dir}":"$trans->{dir}/en/";
+ my $excludes = ( $trans->{name} =~ /UI/ )?"-x 'help'":"";
+
system
- "$self->{translator_path}/tmpl_process3.pl create " .
- "-i $tmpl->{dir}/en/ " .
- "-s $self->{path_po}/$self->{lang}$tmpl->{suffix} -r"
+ "$self->{process} create " .
+ "-i $trans_dir " .
+ "-s $self->{path_po}/$self->{lang}$trans->{suffix} -r $excludes" .
+ (
+ @$files
+ ? ' -f ' . join ' -f ', @$files
+ : ''
+ )
}
}
+sub create_messages {
+ my $self = shift;
+
+ print "Create messages ($self->{lang})\n" if $self->{verbose};
+ system
+ "$self->{cp} $self->{domain}.pot " .
+ "$self->{path_po}/$self->{lang}-$self->{domain}.po";
+}
-sub install {
+sub update_messages {
my $self = shift;
+
+ my $pofile = "$self->{path_po}/$self->{lang}-$self->{domain}.po";
+ print "Update messages ($self->{lang})\n" if $self->{verbose};
+ if ( not -f $pofile ) {
+ print "File $pofile does not exist\n" if $self->{verbose};
+ $self->create_messages();
+ }
+ system "$self->{msgmerge} -U $pofile $self->{domain}.pot";
+}
+
+sub extract_messages {
+ my $self = shift;
+
+ my $intranetdir = $self->{context}->config('intranetdir');
+ my @files_to_scan;
+ my @directories_to_scan = ('.');
+ my @blacklist = qw(blib koha-tmpl skel tmp t);
+ while (@directories_to_scan) {
+ my $dir = shift @directories_to_scan;
+ opendir DIR, "$intranetdir/$dir" or die "Unable to open $dir: $!";
+ foreach my $entry (readdir DIR) {
+ next if $entry =~ /^\./;
+ my $relentry = "$dir/$entry";
+ $relentry =~ s|^\./||;
+ if (-d "$intranetdir/$relentry" and not grep /^$relentry$/, @blacklist) {
+ push @directories_to_scan, "$relentry";
+ } elsif (-f "$intranetdir/$relentry" and $relentry =~ /(pl|pm)$/) {
+ push @files_to_scan, "$relentry";
+ }
+ }
+ }
+
+ my $xgettext_cmd = "$self->{xgettext} -L Perl --from-code=UTF-8 " .
+ "-o $Bin/$self->{domain}.pot -D $intranetdir";
+ $xgettext_cmd .= " $_" foreach (@files_to_scan);
+
+ if (system($xgettext_cmd) != 0) {
+ die "system call failed: $xgettext_cmd";
+ }
+
+ if ( -f "$Bin/$self->{domain}.pot" ) {
+ my $replace_charset_cmd = "$self->{sed} --in-place " .
+ "$Bin/$self->{domain}.pot " .
+ "--expression='s/charset=CHARSET/charset=UTF-8/'";
+ if (system($replace_charset_cmd) != 0) {
+ die "system call failed: $replace_charset_cmd";
+ }
+ } else {
+ print "No messages found\n" if $self->{verbose};
+ return;
+ }
+ return 1;
+}
+
+sub remove_pot {
+ my $self = shift;
+
+ unlink "$Bin/$self->{domain}.pot";
+}
+
+sub install {
+ my ($self, $files) = @_;
return unless $self->{lang};
- $self->install_tmpl() unless $self->{pref_only};
+ $self->install_tmpl($files) unless $self->{pref_only};
$self->install_prefs();
}
sub get_all_langs {
my $self = shift;
opendir( my $dh, $self->{path_po} );
- my @files = grep { $_ =~ /-i-opac-t-prog-v-3002000.po$/ }
+ my @files = grep { $_ =~ /-i-opac-t-prog-v-3006000.po$/ }
readdir $dh;
- @files = map { $_ =~ s/-i-opac-t-prog-v-3002000.po$//; $_ } @files;
+ @files = map { $_ =~ s/-i-opac-t-prog-v-3006000.po$//; $_ } @files;
}
sub update {
- my $self = shift;
+ my ($self, $files) = @_;
my @langs = $self->{lang} ? ($self->{lang}) : $self->get_all_langs();
+ my $extract_ok = $self->extract_messages();
for my $lang ( @langs ) {
$self->set_lang( $lang );
- $self->update_tmpl() unless $self->{pref_only};
+ $self->update_tmpl($files) unless $self->{pref_only};
$self->update_prefs();
+ $self->update_messages() if $extract_ok;
}
+ $self->remove_pot() if $extract_ok;
}
sub create {
- my $self = shift;
+ my ($self, $files) = @_;
return unless $self->{lang};
- $self->create_tmpl() unless $self->{pref_only};
+ $self->create_tmpl($files) unless $self->{pref_only};
$self->create_prefs();
+ if ($self->extract_messages()) {
+ $self->create_messages();
+ $self->remove_pot();
+ }
}
projects / koha.git / blobdiff