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( Dump LoadFile );
  26 use Locale::PO;
  27 use FindBin qw( $Bin );
  28
  29 $YAML::Syck::ImplicitTyping = 1;
  30
  31
  32 # Default file header for .po syspref files
  33 my $default_pref_po_header = Locale::PO->new(-msgid => '', -msgstr =>
  34     "Project-Id-Version: PACKAGE VERSION\\n" .
  35     "PO-Revision-Date: YEAR-MO-DA HO:MI +ZONE\\n" .
  36     "Last-Translator: FULL NAME <EMAIL\@ADDRESS>\\n" .
  37     "Language-Team: Koha Translate List <koha-translate\@lists.koha-community.org>\\n" .
  38     "MIME-Version: 1.0\\n" .
  39     "Content-Type: text/plain; charset=UTF-8\\n" .
  40     "Content-Transfer-Encoding: 8bit\\n" .
  41     "Plural-Forms: nplurals=2; plural=(n > 1);\\n"
  42 );
  43
  44
  45 sub set_lang {
  46     my ($self, $lang) = @_;
  47
  48     $self->{lang} = $lang;
  49     $self->{po_path_lang} = $self->{context}->config('intrahtdocs') .
  50                             "/prog/$lang/modules/admin/preferences";
  51 }
  52
  53
  54 sub new {
  55     my ($class, $lang, $pref_only, $verbose) = @_;
  56
  57     my $self                 = { };
  58
  59     my $context              = C4::Context->new();
  60     $self->{context}         = $context;
  61     $self->{path_pref_en}    = $context->config('intrahtdocs') .
  62                                '/prog/en/modules/admin/preferences';
  63     set_lang( $self, $lang ) if $lang;
  64     $self->{pref_only}       = $pref_only;
  65     $self->{verbose}         = $verbose;
  66     $self->{process}         = "$Bin/tmpl_process3.pl " . ($verbose ? '' : '-q');
  67     $self->{path_po}         = "$Bin/po";
  68     $self->{po}              = { '' => $default_pref_po_header };
  69     $self->{domain}          = 'messages';
  70     $self->{cp}              = `which cp`;
  71     $self->{msgmerge}        = `which msgmerge`;
  72     $self->{xgettext}        = `which xgettext`;
  73     $self->{sed}             = `which sed`;
  74     chomp $self->{cp};
  75     chomp $self->{msgmerge};
  76     chomp $self->{xgettext};
  77     chomp $self->{sed};
  78
  79     # Get all .pref file names
  80     opendir my $fh, $self->{path_pref_en};
  81     my @pref_files = grep { /.pref/ } readdir($fh);
  82     close $fh;
  83     $self->{pref_files} = \@pref_files;
  84
  85     # Get all available language codes
  86     opendir $fh, $self->{path_po};
  87     my @langs =  map { ($_) =~ /(.*)-pref/ }
  88         grep { $_ =~ /.*-pref/ } readdir($fh);
  89     closedir $fh;
  90     $self->{langs} = \@langs;
  91
  92     # Map for both interfaces opac/intranet
  93     my $opachtdocs = $context->config('opachtdocs');
  94     $self->{interface} = [
  95         {
  96             name   => 'Intranet prog UI',
  97             dir    => $context->config('intrahtdocs') . '/prog',
  98             suffix => '-i-staff-t-prog-v-3006000.po',
  99         },
 100         {
 101             name   => 'Intranet prog help',
 102             dir    => $context->config('intrahtdocs') . '/prog/en/modules/help',
 103             suffix => '-staff-help.po',
 104         },
 105     ];
 106
 107     # OPAC themes
 108     opendir my $dh, $context->config('opachtdocs');
 109     for my $theme ( grep { not /^\.|lib/ } readdir($dh) ) {
 110         push @{$self->{interface}}, {
 111             name   => "OPAC $theme",
 112             dir    => "$opachtdocs/$theme",
 113             suffix => "-opac-$theme.po",
 114         };
 115     }
 116
 117     bless $self, $class;
 118 }
 119
 120
 121 sub po_filename {
 122     my $self = shift;
 123
 124     my $context    = C4::Context->new;
 125     my $trans_path = $Bin . '/po';
 126     my $trans_file = "$trans_path/" . $self->{lang} . "-pref.po";
 127     return $trans_file;
 128 }
 129
 130
 131 sub po_append {
 132     my ($self, $id, $comment) = @_;
 133     my $po = $self->{po};
 134     my $p = $po->{$id};
 135     if ( $p ) {
 136         $p->comment( $p->comment . "\n" . $comment );
 137     }
 138     else {
 139         $po->{$id} = Locale::PO->new(
 140             -comment => $comment,
 141             -msgid   => $id,
 142             -msgstr  => ''
 143         );
 144     }
 145 }
 146
 147
 148 sub add_prefs {
 149     my ($self, $comment, $prefs) = @_;
 150
 151     for my $pref ( @$prefs ) {
 152         my $pref_name = '';
 153         for my $element ( @$pref ) {
 154             if ( ref( $element) eq 'HASH' ) {
 155                 $pref_name = $element->{pref};
 156                 last;
 157             }
 158         }
 159         for my $element ( @$pref ) {
 160             if ( ref( $element) eq 'HASH' ) {
 161                 while ( my ($key, $value) = each(%$element) ) {
 162                     next unless $key eq 'choices';
 163                     next unless ref($value) eq 'HASH';
 164                     for my $ckey ( keys %$value ) {
 165                         my $id = $self->{file} . "#$pref_name# " . $value->{$ckey};
 166                         $self->po_append( $id, $comment );
 167                     }
 168                 }
 169             }
 170             elsif ( $element ) {
 171                 $self->po_append( $self->{file} . "#$pref_name# $element", $comment );
 172             }
 173         }
 174     }
 175 }
 176
 177
 178 sub get_trans_text {
 179     my ($self, $id) = @_;
 180
 181     my $po = $self->{po}->{$id};
 182     return unless $po;
 183     return Locale::PO->dequote($po->msgstr);
 184 }
 185
 186
 187 sub update_tab_prefs {
 188     my ($self, $pref, $prefs) = @_;
 189
 190     for my $p ( @$prefs ) {
 191         my $pref_name = '';
 192         next unless $p;
 193         for my $element ( @$p ) {
 194             if ( ref( $element) eq 'HASH' ) {
 195                 $pref_name = $element->{pref};
 196                 last;
 197             }
 198         }
 199         for my $i ( 0..@$p-1 ) {
 200             my $element = $p->[$i];
 201             if ( ref( $element) eq 'HASH' ) {
 202                 while ( my ($key, $value) = each(%$element) ) {
 203                     next unless $key eq 'choices';
 204                     next unless ref($value) eq 'HASH';
 205                     for my $ckey ( keys %$value ) {
 206                         my $id = $self->{file} . "#$pref_name# " . $value->{$ckey};
 207                         my $text = $self->get_trans_text( $id );
 208                         $value->{$ckey} = $text if $text;
 209                     }
 210                 }
 211             }
 212             elsif ( $element ) {
 213                 my $id = $self->{file} . "#$pref_name# $element";
 214                 my $text = $self->get_trans_text( $id );
 215                 $p->[$i] = $text if $text;
 216             }
 217         }
 218     }
 219 }
 220
 221
 222 sub get_po_from_prefs {
 223     my $self = shift;
 224
 225     for my $file ( @{$self->{pref_files}} ) {
 226         my $pref = LoadFile( $self->{path_pref_en} . "/$file" );
 227         $self->{file} = $file;
 228         # Entries for tab titles
 229         $self->po_append( $self->{file}, $_ ) for keys %$pref;
 230         while ( my ($tab, $tab_content) = each %$pref ) {
 231             if ( ref($tab_content) eq 'ARRAY' ) {
 232                 $self->add_prefs( $tab, $tab_content );
 233                 next;
 234             }
 235             while ( my ($section, $sysprefs) = each %$tab_content ) {
 236                 my $comment = "$tab > $section";
 237                 $self->po_append( $self->{file} . " " . $section, $comment );
 238                 $self->add_prefs( $comment, $sysprefs );
 239             }
 240         }
 241     }
 242 }
 243
 244
 245 sub save_po {
 246     my $self = shift;
 247
 248     # Create file header if it doesn't already exist
 249     my $po = $self->{po};
 250     $po->{''} ||= $default_pref_po_header;
 251
 252     # Write .po entries into a file put in Koha standard po directory
 253     Locale::PO->save_file_fromhash( $self->po_filename, $po );
 254     say "Saved in file: ", $self->po_filename if $self->{verbose};
 255 }
 256
 257
 258 sub get_po_merged_with_en {
 259     my $self = shift;
 260
 261     # Get po from current 'en' .pref files
 262     $self->get_po_from_prefs();
 263     my $po_current = $self->{po};
 264
 265     # Get po from previous generation
 266     my $po_previous = Locale::PO->load_file_ashash( $self->po_filename );
 267
 268     for my $id ( keys %$po_current ) {
 269         my $po =  $po_previous->{Locale::PO->quote($id)};
 270         next unless $po;
 271         my $text = Locale::PO->dequote( $po->msgstr );
 272         $po_current->{$id}->msgstr( $text );
 273     }
 274 }
 275
 276
 277 sub update_prefs {
 278     my $self = shift;
 279     print "Update '", $self->{lang},
 280           "' preferences .po file from 'en' .pref files\n" if $self->{verbose};
 281     $self->get_po_merged_with_en();
 282     $self->save_po();
 283 }
 284
 285
 286 sub install_prefs {
 287     my $self = shift;
 288
 289     unless ( -r $self->{po_path_lang} ) {
 290         print "Koha directories hierarchy for ", $self->{lang}, " must be created first\n";
 291         exit;
 292     }
 293
 294     # Get the language .po file merged with last modified 'en' preferences
 295     $self->get_po_merged_with_en();
 296
 297     for my $file ( @{$self->{pref_files}} ) {
 298         my $pref = LoadFile( $self->{path_pref_en} . "/$file" );
 299         $self->{file} = $file;
 300         # First, keys are replaced (tab titles)
 301         $pref = do {
 302             my %pref = map {
 303                 $self->get_trans_text( $self->{file} ) || $_ => $pref->{$_}
 304             } keys %$pref;
 305             \%pref;
 306         };
 307         while ( my ($tab, $tab_content) = each %$pref ) {
 308             if ( ref($tab_content) eq 'ARRAY' ) {
 309                 $self->update_tab_prefs( $pref, $tab_content );
 310                 next;
 311             }
 312             while ( my ($section, $sysprefs) = each %$tab_content ) {
 313                 $self->update_tab_prefs( $pref, $sysprefs );
 314             }
 315             my $ntab = {};
 316             for my $section ( keys %$tab_content ) {
 317                 my $id = $self->{file} . " $section";
 318                 my $text = $self->get_trans_text($id);
 319                 my $nsection = $text ? $text : $section;
 320                 $ntab->{$nsection} = $tab_content->{$section};
 321             }
 322             $pref->{$tab} = $ntab;
 323         }
 324         my $file_trans = $self->{po_path_lang} . "/$file";
 325         print "Write $file\n" if $self->{verbose};
 326         open my $fh, ">", $file_trans;
 327         print $fh Dump($pref);
 328     }
 329 }
 330
 331
 332 sub install_tmpl {
 333     my ($self, $files) = @_;
 334     say "Install templates" if $self->{verbose};
 335     for my $trans ( @{$self->{interface}} ) {
 336         print
 337             "  Install templates '$trans->{name}'\n",
 338             "    From: $trans->{dir}/en/\n",
 339             "    To  : $trans->{dir}/$self->{lang}\n",
 340             "    With: $self->{path_po}/$self->{lang}$trans->{suffix}\n"
 341                 if $self->{verbose};
 342
 343         my $trans_dir = ( $trans->{name} =~ /help/ )?"$trans->{dir}":"$trans->{dir}/en/";
 344         my $lang_dir  = ( $trans->{name} =~ /help/ )?"$trans->{dir}":"$trans->{dir}/$self->{lang}";
 345         $lang_dir =~ s|/en/|/$self->{lang}/|;
 346         mkdir $lang_dir unless -d $lang_dir;
 347         my $excludes  = ( $trans->{name} =~ /UI/   )?"-x 'help'":"";
 348
 349         system
 350             "$self->{process} install " .
 351             "-i $trans_dir " .
 352             "-o $lang_dir  ".
 353             "-s $self->{path_po}/$self->{lang}$trans->{suffix} -r $excludes" .
 354             (
 355                 @$files
 356                     ? ' -f ' . join ' -f ', @$files
 357                     : ''
 358             )
 359     }
 360 }
 361
 362
 363 sub update_tmpl {
 364     my ($self, $files) = @_;
 365
 366     say "Update templates" if $self->{verbose};
 367     for my $trans ( @{$self->{interface}} ) {
 368         print
 369             "  Update templates '$trans->{name}'\n",
 370             "    From: $trans->{dir}/en/\n",
 371             "    To  : $self->{path_po}/$self->{lang}$trans->{suffix}\n"
 372                 if $self->{verbose};
 373         my $lang_dir = "$trans->{dir}/$self->{lang}";
 374
 375         my $trans_dir = ( $trans->{name} =~ /help/ )?"$trans->{dir}":"$trans->{dir}/en/";
 376         my $excludes  = ( $trans->{name} =~ /UI/   )?"-x 'help'":"";
 377
 378         system
 379             "$self->{process} update " .
 380             "-i $trans_dir " .
 381             "-s $self->{path_po}/$self->{lang}$trans->{suffix} -r $excludes" .
 382             (
 383                 @$files
 384                     ? ' -f ' . join ' -f ', @$files
 385                     : ''
 386             )
 387     }
 388 }
 389
 390
 391 sub create_prefs {
 392     my $self = shift;
 393
 394     if ( -e $self->po_filename ) {
 395         say "Preferences .po file already exists. Delete it if you want to recreate it.";
 396         return;
 397     }
 398     $self->get_po_from_prefs();
 399     $self->save_po();
 400 }
 401
 402
 403 sub create_tmpl {
 404     my ($self, $files) = @_;
 405
 406     say "Create templates\n" if $self->{verbose};
 407     for my $trans ( @{$self->{interface}} ) {
 408         print
 409             "  Create templates .po files for '$trans->{name}'\n",
 410             "    From: $trans->{dir}/en/\n",
 411             "    To  : $self->{path_po}/$self->{lang}$trans->{suffix}\n"
 412                 if $self->{verbose};
 413
 414         my $trans_dir = ( $trans->{name} =~ /help/ )?"$trans->{dir}":"$trans->{dir}/en/";
 415         my $excludes  = ( $trans->{name} =~ /UI/   )?"-x 'help'":"";
 416
 417         system
 418             "$self->{process} create " .
 419             "-i $trans_dir " .
 420             "-s $self->{path_po}/$self->{lang}$trans->{suffix} -r $excludes" .
 421             (
 422                 @$files
 423                     ? ' -f ' . join ' -f ', @$files
 424                     : ''
 425             )
 426     }
 427 }
 428
 429 sub create_messages {
 430     my $self = shift;
 431
 432     print "Create messages ($self->{lang})\n" if $self->{verbose};
 433     system
 434         "$self->{cp} $self->{domain}.pot " .
 435         "$self->{path_po}/$self->{lang}-$self->{domain}.po";
 436 }
 437
 438 sub update_messages {
 439     my $self = shift;
 440
 441     my $pofile = "$self->{path_po}/$self->{lang}-$self->{domain}.po";
 442     print "Update messages ($self->{lang})\n" if $self->{verbose};
 443     if ( not -f $pofile ) {
 444         print "File $pofile does not exist\n" if $self->{verbose};
 445         $self->create_messages();
 446     }
 447     system "$self->{msgmerge} -U $pofile $self->{domain}.pot";
 448 }
 449
 450 sub extract_messages {
 451     my $self = shift;
 452
 453     my $intranetdir = $self->{context}->config('intranetdir');
 454     my @files_to_scan;
 455     my @directories_to_scan = ('.');
 456     my @blacklist = qw(blib koha-tmpl skel tmp t);
 457     while (@directories_to_scan) {
 458         my $dir = shift @directories_to_scan;
 459         opendir DIR, "$intranetdir/$dir" or die "Unable to open $dir: $!";
 460         foreach my $entry (readdir DIR) {
 461             next if $entry =~ /^\./;
 462             my $relentry = "$dir/$entry";
 463             $relentry =~ s|^\./||;
 464             if (-d "$intranetdir/$relentry" and not grep /^$relentry$/, @blacklist) {
 465                 push @directories_to_scan, "$relentry";
 466             } elsif (-f "$intranetdir/$relentry" and $relentry =~ /(pl|pm)$/) {
 467                 push @files_to_scan, "$relentry";
 468             }
 469         }
 470     }
 471
 472     my $xgettext_cmd = "$self->{xgettext} -L Perl --from-code=UTF-8 " .
 473         "-o $Bin/$self->{domain}.pot -D $intranetdir";
 474     $xgettext_cmd .= " $_" foreach (@files_to_scan);
 475
 476     if (system($xgettext_cmd) != 0) {
 477         die "system call failed: $xgettext_cmd";
 478     }
 479
 480     if ( -f "$Bin/$self->{domain}.pot" ) {
 481         my $replace_charset_cmd = "$self->{sed} --in-place " .
 482             "$Bin/$self->{domain}.pot " .
 483             "--expression='s/charset=CHARSET/charset=UTF-8/'";
 484         if (system($replace_charset_cmd) != 0) {
 485             die "system call failed: $replace_charset_cmd";
 486         }
 487     } else {
 488         print "No messages found\n" if $self->{verbose};
 489         return;
 490     }
 491     return 1;
 492 }
 493
 494 sub remove_pot {
 495     my $self = shift;
 496
 497     unlink "$Bin/$self->{domain}.pot";
 498 }
 499
 500 sub install {
 501     my ($self, $files) = @_;
 502     return unless $self->{lang};
 503     $self->install_tmpl($files) unless $self->{pref_only};
 504     $self->install_prefs();
 505 }
 506
 507
 508 sub get_all_langs {
 509     my $self = shift;
 510     opendir( my $dh, $self->{path_po} );
 511     my @files = grep { $_ =~ /-pref.po$/ }
 512         readdir $dh;
 513     @files = map { $_ =~ s/-pref.po$//; $_ } @files;
 514 }
 515
 516
 517 sub update {
 518     my ($self, $files) = @_;
 519     my @langs = $self->{lang} ? ($self->{lang}) : $self->get_all_langs();
 520     my $extract_ok = $self->extract_messages();
 521     for my $lang ( @langs ) {
 522         $self->set_lang( $lang );
 523         $self->update_tmpl($files) unless $self->{pref_only};
 524         $self->update_prefs();
 525         $self->update_messages() if $extract_ok;
 526     }
 527     $self->remove_pot() if $extract_ok;
 528 }
 529
 530
 531 sub create {
 532     my ($self, $files) = @_;
 533     return unless $self->{lang};
 534     $self->create_tmpl($files) unless $self->{pref_only};
 535     $self->create_prefs();
 536     if ($self->extract_messages()) {
 537         $self->create_messages();
 538         $self->remove_pot();
 539     }
 540 }
 541
 542
 543
 544 1;
 545
 546
 547 =head1 NAME
 548
 549 LangInstaller.pm - Handle templates and preferences translation
 550
 551 =head1 SYNOPSYS
 552
 553   my $installer = LangInstaller->new( 'fr-FR' );
 554   $installer->create();
 555   $installer->update();
 556   $installer->install();
 557   for my $lang ( @{$installer->{langs} ) {
 558     $installer->set_lang( $lan );
 559     $installer->install();
 560   }
 561
 562 =head1 METHODS
 563
 564 =head2 new
 565
 566 Create a new instance of the installer object.
 567
 568 =head2 create
 569
 570 For the current language, create .po files for templates and preferences based
 571 of the english ('en') version.
 572
 573 =head2 update
 574
 575 For the current language, update .po files.
 576
 577 =head2 install
 578
 579 For the current langage C<$self->{lang}, use .po files to translate the english
 580 version of templates and preferences files and copy those files in the
 581 appropriate directory.
 582
 583 =over
 584
 585 =item translate create F<lang>
 586
 587 Create 3 .po files in F<po> subdirectory: (1) from opac pages templates, (2)
 588 intranet templates, and (3) from preferences.
 589
 590 =over
 591
 592 =item F<lang>-opac-{theme}.po
 593
 594 Contains extracted text from english (en) OPAC templates found in
 595 <KOHA_ROOT>/koha-tmpl/opac-tmpl/{theme}/en/ directory.
 596
 597 =item F<lang>-intranet.po
 598
 599 Contains extracted text from english (en) intranet templates found in
 600 <KOHA_ROOT>/koha-tmpl/intranet-tmpl/prog/en/ directory.
 601
 602 =item F<lang>-pref.po
 603
 604 Contains extracted text from english (en) preferences. They are found in files
 605 located in <KOHA_ROOT>/koha-tmpl/intranet-tmpl/prog/en/admin/preferences
 606 directory.
 607
 608 =back
 609
 610 =item pref-trans update F<lang>
 611
 612 Update .po files in F<po> directory, named F<lang>-*.po.
 613
 614 =item pref-trans install F<lang>
 615
 616 =back
 617
 618 =cut
 619