Bug 21481: Remove *-staf-help.po files
[koha.git] / misc / translator / LangInstaller.pm
index c8a204a..ff42dcf 100644 (file)
@@ -4,21 +4,20 @@ package LangInstaller;
 #
 # This file is part of Koha.
 #
-# Koha is free software; you can redistribute it and/or modify it under the
-# terms of the GNU General Public License as published by the Free Software
-# Foundation; either version 2 of the License, or (at your option) any later
-# version.
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
 #
-# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
-# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
 #
-# You should have received a copy of the GNU General Public License along
-# with Koha; if not, write to the Free Software Foundation, Inc.,
-# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
 
-use strict;
-use warnings;
+use Modern::Perl;
 
 use C4::Context;
 # WARNING: Any other tested YAML library fails to work properly in this
@@ -29,6 +28,20 @@ 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) = @_;
 
@@ -39,7 +52,7 @@ sub set_lang {
 
 
 sub new {
-    my ($class, $lang, $pref_only) = @_;
+    my ($class, $lang, $pref_only, $verbose) = @_;
 
     my $self                 = { };
 
@@ -49,34 +62,71 @@ sub new {
                                '/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};
+
+    unless ($self->{xgettext}) {
+        die "Missing 'xgettext' executable. Have you installed the gettext package?\n";
+    }
 
     # Get all .pref file names
     opendir my $fh, $self->{path_pref_en};
-    my @pref_files = grep { /.pref/ } readdir($fh);
+    my @pref_files = grep { /\.pref$/ } readdir($fh);
     close $fh;
     $self->{pref_files} = \@pref_files;
 
     # Get all available language codes
     opendir $fh, $self->{path_po};
-    my @langs =  map { ($_) =~ /(.*)-i-opac/ } 
-        grep { $_ =~ /.*-opac-/ } readdir($fh);
+    my @langs =  map { ($_) =~ /(.*)-pref/ }
+        grep { $_ =~ /.*-pref/ } 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-3006000.po',
-        },
-        intranet => {
+    my $opachtdocs = $context->config('opachtdocs');
+    $self->{interface} = [
+        {
+            name   => 'Intranet prog UI',
             dir    => $context->config('intrahtdocs') . '/prog',
-            suffix => '-i-staff-t-prog-v-3006000.po',
+            suffix => '-staff-prog.po',
+        },
+    ];
+
+    # OPAC themes
+    opendir my $dh, $context->config('opachtdocs');
+    for my $theme ( grep { not /^\.|lib|xslt/ } readdir($dh) ) {
+        push @{$self->{interface}}, {
+            name   => "OPAC $theme",
+            dir    => "$opachtdocs/$theme",
+            suffix => "-opac-$theme.po",
+        };
+    }
+
+    # MARC flavours (hardcoded list)
+    for ( "MARC21", "UNIMARC", "NORMARC" ) {
+        # search for strings on staff & opac marc files
+        my $dirs = $context->config('intrahtdocs') . '/prog';
+        opendir $fh, $context->config('opachtdocs');
+        for ( grep { not /^\.|\.\.|lib$|xslt/ } readdir($fh) ) {
+            $dirs .= ' ' . "$opachtdocs/$_";
         }
-    };
+        push @{$self->{interface}}, {
+            name   => "$_",
+            dir    => $dirs,
+            suffix => "-marc-$_.po",
+        };
+    }
 
     bless $self, $class;
 }
@@ -131,7 +181,7 @@ sub add_prefs {
                     }
                 }
             }
-            elsif ( $element && $pref_name ) {
+            elsif ( $element ) {
                 $self->po_append( $self->{file} . "#$pref_name# $element", $comment );
             }
         }
@@ -173,7 +223,7 @@ sub update_tab_prefs {
                     }
                 }
             }
-            elsif ( $element && $pref_name ) {
+            elsif ( $element ) {
                 my $id = $self->{file} . "#$pref_name# $element";
                 my $text = $self->get_trans_text( $id );
                 $p->[$i] = $text if $text;
@@ -208,9 +258,14 @@ 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} );
-    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};
 }
 
 
@@ -236,7 +291,7 @@ sub get_po_merged_with_en {
 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();
 }
@@ -276,12 +331,17 @@ sub install_prefs {
                 my $id = $self->{file} . " $section";
                 my $text = $self->get_trans_text($id);
                 my $nsection = $text ? $text : $section;
-                $ntab->{$nsection} = $tab_content->{$section};
+                if( exists $ntab->{$nsection} ) {
+                    # When translations collide (see BZ 18634)
+                    push @{$ntab->{$nsection}}, @{$tab_content->{$section}};
+                } else {
+                    $ntab->{$nsection} = $tab_content->{$section};
+                }
             }
             $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);
     }
@@ -289,43 +349,68 @@ sub install_prefs {
 
 
 sub install_tmpl {
-    my $self = shift;
-
-    print
-        "Install templates\n";
-    while ( my ($interface, $tmpl) = each %{$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}";
-        mkdir $lang_dir unless -d $lang_dir;
-        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"
+    my ($self, $files) = @_;
+    say "Install templates" if $self->{verbose};
+    for my $trans ( @{$self->{interface}} ) {
+        my @t_dirs = split(" ", $trans->{dir});
+        for my $t_dir ( @t_dirs ) {
+            my @files   = @$files;
+            my @nomarc = ();
+            print
+                "  Install templates '$trans->{name}'\n",
+                "    From: $t_dir/en/\n",
+                "    To  : $t_dir/$self->{lang}\n",
+                "    With: $self->{path_po}/$self->{lang}$trans->{suffix}\n"
+                if $self->{verbose};
+
+            my $trans_dir = "$t_dir/en/";
+            my $lang_dir  = "$t_dir/$self->{lang}";
+            $lang_dir =~ s|/en/|/$self->{lang}/|;
+            mkdir $lang_dir unless -d $lang_dir;
+            # if installing MARC po file, only touch corresponding files
+            my $marc     = ( $trans->{name} =~ /MARC/ )?"-m \"$trans->{name}\"":"";            # for MARC translations
+            # if not installing MARC po file, ignore all MARC files
+            @nomarc      = ( 'marc21', 'unimarc', 'normarc' ) if ( $trans->{name} !~ /MARC/ ); # hardcoded MARC variants
+
+            system
+                "$self->{process} install " .
+                "-i $trans_dir " .
+                "-o $lang_dir  ".
+                "-s $self->{path_po}/$self->{lang}$trans->{suffix} -r " .
+                "$marc " .
+                ( @files   ? ' -f ' . join ' -f ', @files : '') .
+                ( @nomarc  ? ' -n ' . join ' -n ', @nomarc : '');
+        }
     }
 }
 
 
 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}} ) {
+        my @files   = @$files;
+        my @nomarc = ();
         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}";
-        mkdir $lang_dir unless -d $lang_dir;
+            "  Update templates '$trans->{name}'\n",
+            "    From: $trans->{dir}/en/\n",
+            "    To  : $self->{path_po}/$self->{lang}$trans->{suffix}\n"
+                if $self->{verbose};
+
+        my $trans_dir = join("/en/ -i ",split(" ",$trans->{dir}))."/en/"; # multiple source dirs
+        # if processing MARC po file, only use corresponding files
+        my $marc      = ( $trans->{name} =~ /MARC/ )?"-m \"$trans->{name}\"":"";            # for MARC translations
+        # if not processing MARC po file, ignore all MARC files
+        @nomarc       = ( 'marc21', 'unimarc', 'normarc' ) if ( $trans->{name} !~ /MARC/ );      # hardcoded MARC variants
+
         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 " .
+            "$marc "     .
+            ( @files   ? ' -f ' . join ' -f ', @files : '') .
+            ( @nomarc  ? ' -n ' . join ' -n ', @nomarc : '');
     }
 }
 
@@ -333,33 +418,119 @@ sub update_tmpl {
 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}} ) {
+        my @files   = @$files;
+        my @nomarc = ();
         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 = join("/en/ -i ",split(" ",$trans->{dir}))."/en/"; # multiple source dirs
+        # if processing MARC po file, only use corresponding files
+        my $marc      = ( $trans->{name} =~ /MARC/ )?"-m \"$trans->{name}\"":"";            # for MARC translations
+        # if not processing MARC po file, ignore all MARC files
+        @nomarc       = ( 'marc21', 'unimarc', 'normarc' ) if ( $trans->{name} !~ /MARC/ ); # hardcoded MARC variants
+
         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 " .
+            "$marc " .
+            ( @files  ? ' -f ' . join ' -f ', @files   : '') .
+            ( @nomarc ? ' -n ' . join ' -n ', @nomarc : '');
     }
 }
 
+sub create_messages {
+    my $self = shift;
 
-sub install {
+    print "Create messages ($self->{lang})\n" if $self->{verbose};
+    system
+        "$self->{cp} $self->{domain}.pot " .
+        "$self->{path_po}/$self->{lang}-$self->{domain}.po";
+}
+
+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();
 }
 
@@ -367,28 +538,35 @@ sub install {
 sub get_all_langs {
     my $self = shift;
     opendir( my $dh, $self->{path_po} );
-    my @files = grep { $_ =~ /-i-opac-t-prog-v-3006000.po$/ }
+    my @files = grep { $_ =~ /-pref.po$/ }
         readdir $dh;
-    @files = map { $_ =~ s/-i-opac-t-prog-v-3006000.po$//; $_ } @files;
+    @files = map { $_ =~ s/-pref.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();
+    }
 }
 
 
@@ -436,17 +614,21 @@ appropriate directory.
 
 =item translate create F<lang>
 
-Create 3 .po files in F<po> subdirectory: (1) from opac pages templates, (2)
-intranet templates, and (3) from preferences.
+Create 4 kinds of .po files in F<po> subdirectory:
+(1) one from each theme on opac pages templates,
+(2) intranet templates,
+(3) preferences, and
+(4) one for each MARC dialect.
+
 
 =over
 
-=item F<lang>-opac.po
+=item F<lang>-opac-{theme}.po
 
 Contains extracted text from english (en) OPAC templates found in
-<KOHA_ROOT>/koha-tmpl/opac-tmpl/prog/en/ directory.
+<KOHA_ROOT>/koha-tmpl/opac-tmpl/{theme}/en/ directory.
 
-=item F<lang>-intranet.po
+=item F<lang>-staff-prog.po
 
 Contains extracted text from english (en) intranet templates found in
 <KOHA_ROOT>/koha-tmpl/intranet-tmpl/prog/en/ directory.
@@ -457,6 +639,11 @@ Contains extracted text from english (en) preferences. They are found in files
 located in <KOHA_ROOT>/koha-tmpl/intranet-tmpl/prog/en/admin/preferences
 directory.
 
+=item F<lang>-marc-{MARC}.po
+
+Contains extracted text from english (en) files from opac and intranet,
+related with MARC dialects.
+
 =back
 
 =item pref-trans update F<lang>