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