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