X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=misc%2Ftranslator%2FLangInstaller.pm;h=b89aaa87af7b5d7e83c661fad6a533f4b73859d2;hb=f021b52e71deaac0b46992fa33ef02f2b001e56d;hp=00daaf4499294f9cc4dced01c4fe5515b1c9ce5f;hpb=6eeb5180422d9439afb9e783aae70f7c1beb27e7;p=koha_fer

diff --git a/misc/translator/LangInstaller.pm b/misc/translator/LangInstaller.pm
index 00daaf4499..b89aaa87af 100644
--- a/misc/translator/LangInstaller.pm
+++ b/misc/translator/LangInstaller.pm
@@ -29,6 +29,19 @@ use FindBin qw( $Bin );
 $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) = @_;
 
@@ -52,7 +65,16 @@ sub new {
     $self->{verbose}         = $verbose;
     $self->{process}         = "$Bin/tmpl_process3.pl " . ($verbose ? '' : '-q');
     $self->{path_po}         = "$Bin/po";
-    $self->{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};
@@ -76,10 +98,15 @@ sub new {
             suffix => '-i-opac-t-prog-v-3006000.po',
         },
         {
-            name   => 'Intranet prog',
+            name   => 'Intranet prog UI',
             dir    => $context->config('intrahtdocs') . '/prog',
             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
@@ -222,8 +249,13 @@ sub get_po_from_prefs {
 
 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} );
+    Locale::PO->save_file_fromhash( $self->po_filename, $po );
     say "Saved in file: ", $self->po_filename if $self->{verbose};
 }
 
@@ -303,7 +335,7 @@ sub install_prefs {
 
 
 sub install_tmpl {
-    my $self = shift;
+    my ($self, $files) = @_;
     say "Install templates" if $self->{verbose};
     for my $trans ( @{$self->{interface}} ) {
         print
@@ -312,19 +344,29 @@ sub install_tmpl {
             "    To  : $trans->{dir}/$self->{lang}\n",
             "    With: $self->{path_po}/$self->{lang}$trans->{suffix}\n"
                 if $self->{verbose};
-        my $lang_dir = "$trans->{dir}/$self->{lang}";
+
+        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->{process} install " .
-            "-i $trans->{dir}/en/ " .
-            "-o $trans->{dir}/$self->{lang} ".
-            "-s $self->{path_po}/$self->{lang}$trans->{suffix} -r"
+            "-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) = @_;
 
     say "Update templates" if $self->{verbose};
     for my $trans ( @{$self->{interface}} ) {
@@ -335,10 +377,19 @@ sub update_tmpl {
                 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->{process} update " .
-            "-i $trans->{dir}/en/ " .
-            "-s $self->{path_po}/$self->{lang}$trans->{suffix} -r"
+            "-i $trans_dir " .
+            "-s $self->{path_po}/$self->{lang}$trans->{suffix} -r $excludes" .
+            (
+                @$files
+                    ? ' -f ' . join ' -f ', @$files
+                    : ''
+            )
     }
 }
 
@@ -356,7 +407,7 @@ sub create_prefs {
 
 
 sub create_tmpl {
-    my $self = shift;
+    my ($self, $files) = @_;
 
     say "Create templates\n" if $self->{verbose};
     for my $trans ( @{$self->{interface}} ) {
@@ -365,18 +416,97 @@ sub create_tmpl {
             "    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->{process} create " .
-            "-i $trans->{dir}/en/ " .
-            "-s $self->{path_po}/$self->{lang}$trans->{suffix} -r"
+            "-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();
 }
 
@@ -391,21 +521,28 @@ sub get_all_langs {
 
 
 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();
+    }
 }