Bug 8044: new module for translating strings in Perl source files

You have to use the new module Koha::I18N

Code example:
  use Koha::I18N;
  use CGI;

  my $input = new CGI;
  my $lh = Koha::I18N->get_handle_from_context($input, 'intranet');

  print $lh->maketext("Localized string!");

PO files are in misc/translator/po/LANG-messages.po.
Creation of PO files are integrated to existing workflow, so to create
PO file for a language, just run in misc/translator:
  ./translate create LANG
To update:
  ./translate update LANG
You can then translate the PO with your favorite editor. Strings will be
localized at runtime.

Signed-off-by: Marcel de Rooy <m.de.rooy@rijksmuseum.nl>
Works as advertised. Some details needing further attention noted on bug
report.

Signed-off-by: Kyle M Hall <kyle@bywatersolutions.com>
Signed-off-by: Galen Charlton <gmc@esilibrary.com>

diff --git a/Koha/I18N.pm b/Koha/I18N.pm
new file mode 100644 (file)
index 0000000..dba57da
--- /dev/null
+++ b/Koha/I18N.pm
@@ -0,0 +1,34 @@
+package Koha::I18N;
+
+use base qw(Locale::Maketext);
+
+use C4::Templates;
+use C4::Context;
+
+use Locale::Maketext::Lexicon {
+    'en' => ['Auto'],
+    '*' => [
+        Gettext =>
+            C4::Context->config('intranetdir')
+            . '/misc/translator/po/*-messages.po'
+    ],
+    '_AUTO' => 1,
+};
+
+sub get_handle_from_context {
+    my ($class, $cgi, $interface) = @_;
+
+    my $lh;
+    my $lang = C4::Templates::getlanguage($cgi, $interface);
+    if ($lang) {
+        $lh = $class->get_handle($lang)
+            or die "No language handle for '$lang'";
+    } else {
+        $lh = $class->get_handle()
+            or die "Can't get a language handle";
+    }
+
+    return $lh;
+}
+
+1;

diff --git a/misc/translator/LangInstaller.pm b/misc/translator/LangInstaller.pm
index 158ca22..15efc0b 100644 (file)
--- a/misc/translator/LangInstaller.pm
+++ b/misc/translator/LangInstaller.pm
@@ -66,6 +66,13 @@ sub new {
     $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`;
+    chomp $self->{cp};
+    chomp $self->{msgmerge};
+    chomp $self->{xgettext};
 
     # Get all .pref file names
     opendir my $fh, $self->{path_pref_en};
@@ -423,6 +430,59 @@ sub create_tmpl {
     }
 }
 
+sub create_messages {
+    my $self = shift;
+
+    system
+        "$self->{cp} $self->{domain}.pot " .
+        "$self->{path_po}/$self->{lang}-$self->{domain}.po";
+}
+
+sub update_messages {
+    my $self = shift;
+
+    system
+        "$self->{msgmerge} -U " .
+        "$self->{path_po}/$self->{lang}-$self->{domain}.po " .
+        "$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 " .
+        "-kmaketext -o $Bin/$self->{domain}.pot -D $intranetdir";
+    $xgettext_cmd .= " $_" foreach (@files_to_scan);
+
+    if (system($xgettext_cmd) != 0) {
+        die "system call failed: $xgettext_cmd";
+    }
+}
+
+sub remove_pot {
+    my $self = shift;
+
+    unlink "$Bin/$self->{domain}.pot";
+}
 
 sub install {
     my ($self, $files) = @_;
@@ -444,11 +504,14 @@ sub get_all_langs {
 sub update {
     my ($self, $files) = @_;
     my @langs = $self->{lang} ? ($self->{lang}) : $self->get_all_langs();
+    $self->extract_messages();
     for my $lang ( @langs ) {
         $self->set_lang( $lang );
         $self->update_tmpl($files) unless $self->{pref_only};
         $self->update_prefs();
+        $self->update_messages();
     }
+    $self->remove_pot();
 }
 
 
@@ -457,6 +520,9 @@ sub create {
     return unless $self->{lang};
     $self->create_tmpl($files) unless $self->{pref_only};
     $self->create_prefs();
+    $self->extract_messages();
+    $self->create_messages();
+    $self->remove_pot();
 }