misc/translator/LangInstaller.pm

   1 package LangInstaller;
   2
   3 # Copyright (C) 2010 Tamil s.a.r.l.
   4 #
   5 # This file is part of Koha.
   6 #
   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.
  11 #
  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.
  16 #
  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>.
  19
  20 use Modern::Perl;
  21
  22 use C4::Context;
  23 # WARNING: Any other tested YAML library fails to work properly in this
  24 # script content
  25 # FIXME Really?
  26 use YAML::XS;
  27 use Locale::PO;
  28 use FindBin qw( $Bin );
  29 use File::Path qw( make_path );
  30 use File::Copy;
  31
  32 sub set_lang {
  33     my ($self, $lang) = @_;
  34
  35     $self->{lang} = $lang;
  36     $self->{po_path_lang} = C4::Context->config('intrahtdocs') .
  37                             "/prog/$lang/modules/admin/preferences";
  38 }
  39
  40 sub new {
  41     my ($class, $lang, $pref_only, $verbose) = @_;
  42
  43     my $self                 = { };
  44
  45     $self->{path_pref_en}    = C4::Context->config('intrahtdocs') .
  46                                '/prog/en/modules/admin/preferences';
  47     set_lang( $self, $lang ) if $lang;
  48     $self->{pref_only}       = $pref_only;
  49     $self->{verbose}         = $verbose;
  50     $self->{process}         = "$Bin/tmpl_process3.pl " . ($verbose ? '' : '-q');
  51     $self->{path_po}         = "$Bin/po";
  52     $self->{po}              = {};
  53     $self->{domain}          = 'Koha';
  54     $self->{msgfmt}          = `which msgfmt`;
  55     $self->{po2json}         = "$Bin/po2json";
  56     $self->{gzip}            = `which gzip`;
  57     $self->{gunzip}          = `which gunzip`;
  58     chomp $self->{msgfmt};
  59     chomp $self->{gzip};
  60     chomp $self->{gunzip};
  61
  62     # Get all .pref file names
  63     opendir my $fh, $self->{path_pref_en};
  64     my @pref_files = grep { /\.pref$/ } readdir($fh);
  65     close $fh;
  66     $self->{pref_files} = \@pref_files;
  67
  68     # Get all available language codes
  69     opendir $fh, $self->{path_po};
  70     my @langs =  map { ($_) =~ /(.*)-pref/ }
  71         grep { $_ =~ /.*-pref/ } readdir($fh);
  72     closedir $fh;
  73     $self->{langs} = \@langs;
  74
  75     # Map for both interfaces opac/intranet
  76     my $opachtdocs = C4::Context->config('opachtdocs');
  77     $self->{interface} = [
  78         {
  79             name   => 'Intranet prog UI',
  80             dir    => C4::Context->config('intrahtdocs') . '/prog',
  81             suffix => '-staff-prog.po',
  82         },
  83     ];
  84
  85     # OPAC themes
  86     opendir my $dh, C4::Context->config('opachtdocs');
  87     for my $theme ( grep { not /^\.|lib|xslt/ } readdir($dh) ) {
  88         push @{$self->{interface}}, {
  89             name   => "OPAC $theme",
  90             dir    => "$opachtdocs/$theme",
  91             suffix => "-opac-$theme.po",
  92         };
  93     }
  94
  95     # MARC flavours (hardcoded list)
  96     for ( "MARC21", "UNIMARC" ) {
  97         # search for strings on staff & opac marc files
  98         my $dirs = C4::Context->config('intrahtdocs') . '/prog';
  99         opendir $fh, C4::Context->config('opachtdocs');
 100         for ( grep { not /^\.|\.\.|lib$|xslt/ } readdir($fh) ) {
 101             $dirs .= ' ' . "$opachtdocs/$_";
 102         }
 103         push @{$self->{interface}}, {
 104             name   => "$_",
 105             dir    => $dirs,
 106             suffix => "-marc-$_.po",
 107         };
 108     }
 109
 110     # EN YAML installer files
 111     push @{$self->{installer}}, {
 112         name   => "YAML installer files",
 113         dirs   => [ 'installer/data/mysql/en/mandatory',
 114                     'installer/data/mysql/en/optional'],
 115         suffix => "-installer.po",
 116     };
 117
 118     # EN MARC21 YAML installer files
 119     push @{$self->{installer}}, {
 120         name   => "MARC21 YAML installer files",
 121         dirs   => [ 'installer/data/mysql/en/marcflavour/marc21/mandatory',
 122                     'installer/data/mysql/en/marcflavour/marc21/optional'],
 123         suffix => "-installer-MARC21.po",
 124     };
 125
 126     # EN UNIMARC YAML installer files
 127     push @{$self->{installer}}, {
 128         name   => "UNIMARC YAML installer files",
 129         dirs   => [ 'installer/data/mysql/en/marcflavour/unimarc/mandatory',
 130                     'installer/data/mysql/en/marcflavour/unimarc/optional'],
 131         suffix => "-installer-UNIMARC.po",
 132     };
 133
 134     bless $self, $class;
 135 }
 136
 137 sub po_filename {
 138     my $self   = shift;
 139     my $suffix = shift;
 140
 141     my $trans_path = $Bin . '/po';
 142     my $trans_file = "$trans_path/" . $self->{lang} . $suffix;
 143     return $trans_file;
 144 }
 145
 146 sub get_trans_text {
 147     my ($self, $msgid, $default) = @_;
 148
 149     my $po = $self->{po}->{Locale::PO->quote($msgid)};
 150     if ( $po and not defined( $po->fuzzy() ) ) {
 151         my $msgstr = Locale::PO->dequote($po->msgstr);
 152         if ($msgstr and length($msgstr) > 0) {
 153             return $msgstr;
 154         }
 155     }
 156
 157     return $default;
 158 }
 159
 160 sub get_translated_tab_content {
 161     my ($self, $file, $tab_content) = @_;
 162
 163     if ( ref($tab_content) eq 'ARRAY' ) {
 164         return $self->get_translated_prefs($file, $tab_content);
 165     }
 166
 167     my $translated_tab_content = {
 168         map {
 169             my $section = $_;
 170             my $sysprefs = $tab_content->{$section};
 171             my $msgid = sprintf('%s %s', $file, $section);
 172
 173             $self->get_trans_text($msgid, $section) => $self->get_translated_prefs($file, $sysprefs);
 174         } keys %$tab_content
 175     };
 176
 177     if ( keys %$translated_tab_content != keys %$tab_content ) {
 178         my %duplicates;
 179         for my $section (keys %$tab_content) {
 180             push @{$duplicates{$self->get_trans_text("$file $section", $section)}}, $section;
 181         }
 182         for my $translation (keys %duplicates) {
 183             if (@{$duplicates{$translation}} > 1) {
 184                 warn qq(In file "$file", "$translation" is a translation for sections ") . join('", "', @{$duplicates{$translation}}) . '"';
 185             }
 186         }
 187     }
 188
 189     return $translated_tab_content;
 190 }
 191
 192 sub get_translated_prefs {
 193     my ($self, $file, $sysprefs) = @_;
 194
 195     my $translated_prefs = [
 196         map {
 197             my ($pref_elt) = grep { ref($_) eq 'HASH' && exists $_->{pref} } @$_;
 198             my $pref_name = $pref_elt ? $pref_elt->{pref} : '';
 199
 200             my $translated_syspref = [
 201                 map {
 202                     $self->get_translated_pref($file, $pref_name, $_);
 203                 } @$_
 204             ];
 205
 206             $translated_syspref;
 207         } @$sysprefs
 208     ];
 209
 210     return $translated_prefs;
 211 }
 212
 213 sub get_translated_pref {
 214     my ($self, $file, $pref_name, $syspref) = @_;
 215
 216     unless (ref($syspref)) {
 217         $syspref //= '';
 218         my $msgid = sprintf('%s#%s# %s', $file, $pref_name, $syspref);
 219         return $self->get_trans_text($msgid, $syspref);
 220     }
 221
 222     my $translated_pref = {
 223         map {
 224             my $key = $_;
 225             my $value = $syspref->{$key};
 226
 227             my $translated_value = $value;
 228             if (($key eq 'choices' || $key eq 'multiple') && ref($value) eq 'HASH') {
 229                 $translated_value = {
 230                     map {
 231                         my $msgid = sprintf('%s#%s# %s', $file, $pref_name, $value->{$_});
 232                         $_ => $self->get_trans_text($msgid, $value->{$_})
 233                     } keys %$value
 234                 }
 235             }
 236
 237             $key => $translated_value
 238         } keys %$syspref
 239     };
 240
 241     return $translated_pref;
 242 }
 243
 244 sub install_prefs {
 245     my $self = shift;
 246
 247     unless ( -r $self->{po_path_lang} ) {
 248         print "Koha directories hierarchy for ", $self->{lang}, " must be created first\n";
 249         exit;
 250     }
 251
 252     $self->{po} = Locale::PO->load_file_ashash($self->po_filename("-pref.po"), 'utf8');
 253
 254     for my $file ( @{$self->{pref_files}} ) {
 255         my $pref = YAML::XS::LoadFile( $self->{path_pref_en} . "/$file" );
 256
 257         my $translated_pref = {
 258             map {
 259                 my $tab = $_;
 260                 my $tab_content = $pref->{$tab};
 261
 262                 $self->get_trans_text($file, $tab) => $self->get_translated_tab_content($file, $tab_content);
 263             } keys %$pref
 264         };
 265
 266         if ( keys %$translated_pref != keys %$pref ) {
 267             my %duplicates;
 268             for my $tab (keys %$pref) {
 269                 push @{$duplicates{$self->get_trans_text($file, $tab)}}, $tab;
 270             }
 271             for my $translation (keys %duplicates) {
 272                 if (@{$duplicates{$translation}} > 1) {
 273                     warn qq(In file "$file", "$translation" is a translation for tabs ") . join('", "', @{$duplicates{$translation}}) . '"';
 274                 }
 275             }
 276         }
 277
 278         my $file_trans = $self->{po_path_lang} . "/$file";
 279         print "Write $file\n" if $self->{verbose};
 280         YAML::XS::DumpFile($file_trans, $translated_pref);
 281     }
 282 }
 283
 284
 285 sub install_tmpl {
 286     my ($self, $files) = @_;
 287     say "Install templates" if $self->{verbose};
 288     for my $trans ( @{$self->{interface}} ) {
 289         my @t_dirs = split(" ", $trans->{dir});
 290         for my $t_dir ( @t_dirs ) {
 291             my @files   = @$files;
 292             my @nomarc = ();
 293             print
 294                 "  Install templates '$trans->{name}'\n",
 295                 "    From: $t_dir/en/\n",
 296                 "    To  : $t_dir/$self->{lang}\n",
 297                 "    With: $self->{path_po}/$self->{lang}$trans->{suffix}\n"
 298                 if $self->{verbose};
 299
 300             my $trans_dir = "$t_dir/en/";
 301             my $lang_dir  = "$t_dir/$self->{lang}";
 302             $lang_dir =~ s|/en/|/$self->{lang}/|;
 303             mkdir $lang_dir unless -d $lang_dir;
 304             # if installing MARC po file, only touch corresponding files
 305             my $marc     = ( $trans->{name} =~ /MARC/ )?"-m \"$trans->{name}\"":"";            # for MARC translations
 306             # if not installing MARC po file, ignore all MARC files
 307             @nomarc      = ( 'marc21', 'unimarc' ) if ( $trans->{name} !~ /MARC/ ); # hardcoded MARC variants
 308
 309             system
 310                 "$self->{process} install " .
 311                 "-i $trans_dir " .
 312                 "-o $lang_dir  ".
 313                 "-s $self->{path_po}/$self->{lang}$trans->{suffix} -r " .
 314                 "$marc " .
 315                 ( @files   ? ' -f ' . join ' -f ', @files : '') .
 316                 ( @nomarc  ? ' -n ' . join ' -n ', @nomarc : '');
 317         }
 318     }
 319 }
 320
 321 sub translate_yaml {
 322     my $self   = shift;
 323     my $target = shift;
 324     my $srcyml = shift;
 325
 326     my $po_file = $self->po_filename( $target->{suffix} );
 327     return $srcyml unless ( -e $po_file );
 328
 329     my $po_ref  = Locale::PO->load_file_ashash( $po_file, 'utf8' );
 330
 331     my $dstyml   = YAML::XS::LoadFile( $srcyml );
 332
 333     # translate fields in table rows
 334     my @tables = @{ $dstyml->{'tables'} };
 335     for my $table ( @tables ) {                                                         # each table
 336         my $table_name = ( keys %$table )[0];
 337         my @translatable = @{ $table->{$table_name}->{translatable} };
 338         my @rows = @{ $table->{$table_name}->{rows} };
 339         my @multiline = @{ $table->{$table_name}->{'multiline'} };                      # to check multiline values
 340         for my $row ( @rows ) {                                                         # each row
 341             for my $field ( @translatable ) {                                           # each translatable field
 342                 if ( @multiline and grep { $_ eq $field } @multiline ) {                # multiline fields, only notices ATM
 343                     foreach my $line ( @{$row->{$field}} ) {
 344                         my @ttvar;
 345                         while ( $line =~ s/(<<.*?>>|\[\%.*?\%\]|<.*?>)/\%s/ ) {         # put placeholders, save matches
 346                             my $var = $1;
 347                             push @ttvar, $var;
 348                         }
 349
 350                         if ( $line =~ /^(\s|%s|-|[[:punct:]]|\(|\))*$/ ) {              # ignore non strings
 351                             while ( @ttvar ) {                                          # restore placeholders
 352                                 my $var = shift @ttvar;
 353                                 $line =~ s/\%s/$var/;
 354                             }
 355                             next;
 356                         } else {
 357                             my $po = $po_ref->{"\"$line\""};                            # quoted key
 358                             if ( $po  and not defined( $po->fuzzy() )                   # not fuzzy
 359                                       and length( $po->msgid() ) > 2                    # not empty msgid
 360                                       and length( $po->msgstr() ) > 2 ) {               # not empty msgstr
 361                                 $line = $po->dequote( $po->msgstr() );
 362                             }
 363                             while ( @ttvar ) {                                          # restore placeholders
 364                                 my $var = shift @ttvar;
 365                                 $line =~ s/\%s/$var/;
 366                             }
 367                         }
 368                     }
 369                 } else {
 370                     next unless defined $row->{$field};                                 # next if null value
 371                     my $po = $po_ref->{"\"$row->{$field}\""};                           # quoted key
 372                     if ( $po  and not defined( $po->fuzzy() )                           # not fuzzy
 373                               and length( $po->msgid() ) > 2                            # not empty msgid
 374                               and length( $po->msgstr() ) > 2 ) {                       # not empty msgstr
 375                         $row->{$field} = $po->dequote( $po->msgstr() );
 376                     }
 377                 }
 378             }
 379         }
 380     }
 381
 382     # translate descriptions
 383     for my $description ( @{ $dstyml->{'description'} } ) {
 384         my $po = $po_ref->{"\"$description\""};
 385         if ( $po  and not defined( $po->fuzzy() )
 386                   and length( $po->msgid() ) > 2
 387                   and length( $po->msgstr() ) > 2 ) {
 388             $description = $po->dequote( $po->msgstr() );
 389         }
 390     }
 391
 392     return $dstyml;
 393 }
 394
 395 sub install_installer {
 396     my $self = shift;
 397     return unless ( $self->{installer} );
 398
 399     my $intradir  = C4::Context->config('intranetdir');
 400     my $db_scheme = C4::Context->config('db_scheme');
 401     my $langdir  = "$intradir/installer/data/$db_scheme/$self->{lang}";
 402
 403     say "Install installer files\n" if $self->{verbose};
 404
 405     for my $target ( @{ $self->{installer} } ) {
 406         return unless ( -e $self->po_filename( $target->{suffix} ) );
 407         for my $dir ( @{ $target->{dirs} } ) {
 408             ( my $tdir = "$dir" ) =~ s|/en/|/$self->{lang}/|;
 409             make_path("$intradir/$tdir");
 410
 411             opendir( my $dh, "$intradir/$dir" ) or die ("Can't open $intradir/$dir");
 412             my @files = grep { ! /^\.+$/ } readdir($dh);
 413             close($dh);
 414
 415             for my $file ( @files ) {
 416                 if ( $file =~ /yml$/ ) {
 417                     my $translated_yaml = translate_yaml( $self, $target, "$intradir/$dir/$file" );
 418                     YAML::XS::DumpFile( "$intradir/$tdir/$file", $translated_yaml );
 419                 } else {
 420                     File::Copy::copy( "$intradir/$dir/$file", "$intradir/$tdir/$file" );
 421                 }
 422             }
 423         }
 424     }
 425 }
 426
 427 sub locale_name {
 428     my $self = shift;
 429
 430     my ($language, $region, $country) = split /-/, $self->{lang};
 431     $country //= $region;
 432     my $locale = $language;
 433     if ($country && length($country) == 2) {
 434         $locale .= '_' . $country;
 435     }
 436
 437     return $locale;
 438 }
 439
 440 sub install_messages {
 441     my ($self) = @_;
 442
 443     my $locale = $self->locale_name();
 444     my $modir = "$self->{path_po}/$locale/LC_MESSAGES";
 445     my $pofile = "$self->{path_po}/$self->{lang}-messages.po";
 446     my $mofile = "$modir/$self->{domain}.mo";
 447     my $js_pofile = "$self->{path_po}/$self->{lang}-messages-js.po";
 448
 449     unless ( -f $pofile && -f $js_pofile ) {
 450         die "PO files for language '$self->{lang}' do not exist";
 451     }
 452
 453     say "Install messages ($locale)" if $self->{verbose};
 454     make_path($modir);
 455     system "$self->{msgfmt} -o $mofile $pofile";
 456
 457     my $js_locale_data = 'var json_locale_data = {"Koha":' . `$self->{po2json} $js_pofile` . '};';
 458     my $progdir = C4::Context->config('intrahtdocs') . '/prog';
 459     mkdir "$progdir/$self->{lang}/js";
 460     open my $fh, '>', "$progdir/$self->{lang}/js/locale_data.js";
 461     print $fh $js_locale_data;
 462     close $fh;
 463
 464     my $opachtdocs = C4::Context->config('opachtdocs');
 465     opendir(my $dh, $opachtdocs);
 466     for my $theme ( grep { not /^\.|lib|xslt/ } readdir($dh) ) {
 467         mkdir "$opachtdocs/$theme/$self->{lang}/js";
 468         open my $fh, '>', "$opachtdocs/$theme/$self->{lang}/js/locale_data.js";
 469         print $fh $js_locale_data;
 470         close $fh;
 471     }
 472 }
 473
 474 sub compress {
 475     my ($self, $files) = @_;
 476     my @langs = $self->{lang} ? ($self->{lang}) : $self->get_all_langs();
 477     for my $lang ( @langs ) {
 478         $self->set_lang( $lang );
 479         opendir( my $dh, $self->{path_po} );
 480         my @files = grep { $_ =~ /^$self->{lang}.*po$/ } readdir $dh;
 481         foreach my $file ( @files ) {
 482             say "Compress file $file" if $self->{verbose};
 483             system "$self->{gzip} -9 $self->{path_po}/$file";
 484         }
 485     }
 486 }
 487
 488 sub uncompress {
 489     my ($self, $files) = @_;
 490     my @langs = $self->{lang} ? ($self->{lang}) : $self->get_all_langs();
 491     for my $lang ( @langs ) {
 492         opendir( my $dh, $self->{path_po} );
 493         $self->set_lang( $lang );
 494         my @files = grep { $_ =~ /^$self->{lang}.*po.gz$/ } readdir $dh;
 495         foreach my $file ( @files ) {
 496             say "Uncompress file $file" if $self->{verbose};
 497             system "$self->{gunzip} $self->{path_po}/$file";
 498         }
 499     }
 500 }
 501
 502 sub install {
 503     my ($self, $files) = @_;
 504     return unless $self->{lang};
 505     $self->uncompress();
 506
 507     if ($self->{pref_only}) {
 508         $self->install_prefs();
 509     } else {
 510         $self->install_tmpl($files);
 511         $self->install_prefs();
 512         $self->install_messages();
 513         $self->install_installer();
 514     }
 515 }
 516
 517
 518 sub get_all_langs {
 519     my $self = shift;
 520     opendir( my $dh, $self->{path_po} );
 521     my @files = grep { $_ =~ /-pref.(po|po.gz)$/ }
 522         readdir $dh;
 523     @files = map { $_ =~ s/-pref.(po|po.gz)$//r } @files;
 524 }
 525
 526 1;
 527
 528
 529 =head1 NAME
 530
 531 LangInstaller.pm - Handle templates and preferences translation
 532
 533 =head1 SYNOPSYS
 534
 535   my $installer = LangInstaller->new( 'fr-FR' );
 536   $installer->create();
 537   $installer->update();
 538   $installer->install();
 539   for my $lang ( @{$installer->{langs} ) {
 540     $installer->set_lang( $lan );
 541     $installer->install();
 542   }
 543
 544 =head1 METHODS
 545
 546 =head2 new
 547
 548 Create a new instance of the installer object.
 549
 550 =head2 create
 551
 552 For the current language, create .po files for templates and preferences based
 553 of the english ('en') version.
 554
 555 =head2 update
 556
 557 For the current language, update .po files.
 558
 559 =head2 install
 560
 561 For the current langage C<$self->{lang}, use .po files to translate the english
 562 version of templates and preferences files and copy those files in the
 563 appropriate directory.
 564
 565 =over
 566
 567 =item translate create F<lang>
 568
 569 Create 4 kinds of .po files in F<po> subdirectory:
 570 (1) one from each theme on opac pages templates,
 571 (2) intranet templates,
 572 (3) preferences, and
 573 (4) one for each MARC dialect.
 574
 575
 576 =over
 577
 578 =item F<lang>-opac-{theme}.po
 579
 580 Contains extracted text from english (en) OPAC templates found in
 581 <KOHA_ROOT>/koha-tmpl/opac-tmpl/{theme}/en/ directory.
 582
 583 =item F<lang>-staff-prog.po
 584
 585 Contains extracted text from english (en) intranet templates found in
 586 <KOHA_ROOT>/koha-tmpl/intranet-tmpl/prog/en/ directory.
 587
 588 =item F<lang>-pref.po
 589
 590 Contains extracted text from english (en) preferences. They are found in files
 591 located in <KOHA_ROOT>/koha-tmpl/intranet-tmpl/prog/en/admin/preferences
 592 directory.
 593
 594 =item F<lang>-marc-{MARC}.po
 595
 596 Contains extracted text from english (en) files from opac and intranet,
 597 related with MARC dialects.
 598
 599 =back
 600
 601 =item pref-trans update F<lang>
 602
 603 Update .po files in F<po> directory, named F<lang>-*.po.
 604
 605 =item pref-trans install F<lang>
 606
 607 =back
 608
 609 =cut
 610