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