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     chomp $self->{cp};
  74     chomp $self->{msgmerge};
  75     chomp $self->{xgettext};
  76
  77     # Get all .pref file names
  78     opendir my $fh, $self->{path_pref_en};
  79     my @pref_files = grep { /.pref/ } readdir($fh);
  80     close $fh;
  81     $self->{pref_files} = \@pref_files;
  82
  83     # Get all available language codes
  84     opendir $fh, $self->{path_po};
  85     my @langs =  map { ($_) =~ /(.*)-i-opac/ }
  86         grep { $_ =~ /.*-opac-t-prog/ } readdir($fh);
  87     closedir $fh;
  88     $self->{langs} = \@langs;
  89
  90     # Map for both interfaces opac/intranet
  91     my $opachtdocs = $context->config('opachtdocs');
  92     $self->{interface} = [
  93         {
  94             name   => 'OPAC prog',
  95             dir    => "$opachtdocs/prog",
  96             suffix => '-i-opac-t-prog-v-3006000.po',
  97         },
  98         {
  99             name   => 'Intranet prog UI',
 100             dir    => $context->config('intrahtdocs') . '/prog',
 101             suffix => '-i-staff-t-prog-v-3006000.po',
 102         },
 103         {
 104             name   => 'Intranet prog help',
 105             dir    => $context->config('intrahtdocs') . '/prog/en/modules/help',
 106             suffix => '-staff-help.po',
 107         },
 108     ];
 109
 110     # Alternate opac themes
 111     opendir $fh, $context->config('opachtdocs');
 112     for ( grep { not /^\.|\.\.|prog|lib$/ } readdir($fh) ) {
 113         push @{$self->{interface}}, {
 114             name   => "OPAC $_",
 115             dir    => "$opachtdocs/$_",
 116             suffix => "-opac-$_.po",
 117         };
 118     }
 119
 120     bless $self, $class;
 121 }
 122
 123
 124 sub po_filename {
 125     my $self = shift;
 126
 127     my $context    = C4::Context->new;
 128     my $trans_path = $Bin . '/po';
 129     my $trans_file = "$trans_path/" . $self->{lang} . "-pref.po";
 130     return $trans_file;
 131 }
 132
 133
 134 sub po_append {
 135     my ($self, $id, $comment) = @_;
 136     my $po = $self->{po};
 137     my $p = $po->{$id};
 138     if ( $p ) {
 139         $p->comment( $p->comment . "\n" . $comment );
 140     }
 141     else {
 142         $po->{$id} = Locale::PO->new(
 143             -comment => $comment,
 144             -msgid   => $id,
 145             -msgstr  => ''
 146         );
 147     }
 148 }
 149
 150
 151 sub add_prefs {
 152     my ($self, $comment, $prefs) = @_;
 153
 154     for my $pref ( @$prefs ) {
 155         my $pref_name = '';
 156         for my $element ( @$pref ) {
 157             if ( ref( $element) eq 'HASH' ) {
 158                 $pref_name = $element->{pref};
 159                 last;
 160             }
 161         }
 162         for my $element ( @$pref ) {
 163             if ( ref( $element) eq 'HASH' ) {
 164                 while ( my ($key, $value) = each(%$element) ) {
 165                     next unless $key eq 'choices';
 166                     next unless ref($value) eq 'HASH';
 167                     for my $ckey ( keys %$value ) {
 168                         my $id = $self->{file} . "#$pref_name# " . $value->{$ckey};
 169                         $self->po_append( $id, $comment );
 170                     }
 171                 }
 172             }
 173             elsif ( $element && $pref_name ) {
 174                 $self->po_append( $self->{file} . "#$pref_name# $element", $comment );
 175             }
 176         }
 177     }
 178 }
 179
 180
 181 sub get_trans_text {
 182     my ($self, $id) = @_;
 183
 184     my $po = $self->{po}->{$id};
 185     return unless $po;
 186     return Locale::PO->dequote($po->msgstr);
 187 }
 188
 189
 190 sub update_tab_prefs {
 191     my ($self, $pref, $prefs) = @_;
 192
 193     for my $p ( @$prefs ) {
 194         my $pref_name = '';
 195         next unless $p;
 196         for my $element ( @$p ) {
 197             if ( ref( $element) eq 'HASH' ) {
 198                 $pref_name = $element->{pref};
 199                 last;
 200             }
 201         }
 202         for my $i ( 0..@$p-1 ) {
 203             my $element = $p->[$i];
 204             if ( ref( $element) eq 'HASH' ) {
 205                 while ( my ($key, $value) = each(%$element) ) {
 206                     next unless $key eq 'choices';
 207                     next unless ref($value) eq 'HASH';
 208                     for my $ckey ( keys %$value ) {
 209                         my $id = $self->{file} . "#$pref_name# " . $value->{$ckey};
 210                         my $text = $self->get_trans_text( $id );
 211                         $value->{$ckey} = $text if $text;
 212                     }
 213                 }
 214             }
 215             elsif ( $element && $pref_name ) {
 216                 my $id = $self->{file} . "#$pref_name# $element";
 217                 my $text = $self->get_trans_text( $id );
 218                 $p->[$i] = $text if $text;
 219             }
 220         }
 221     }
 222 }
 223
 224
 225 sub get_po_from_prefs {
 226     my $self = shift;
 227
 228     for my $file ( @{$self->{pref_files}} ) {
 229         my $pref = LoadFile( $self->{path_pref_en} . "/$file" );
 230         $self->{file} = $file;
 231         # Entries for tab titles
 232         $self->po_append( $self->{file}, $_ ) for keys %$pref;
 233         while ( my ($tab, $tab_content) = each %$pref ) {
 234             if ( ref($tab_content) eq 'ARRAY' ) {
 235                 $self->add_prefs( $tab, $tab_content );
 236                 next;
 237             }
 238             while ( my ($section, $sysprefs) = each %$tab_content ) {
 239                 my $comment = "$tab > $section";
 240                 $self->po_append( $self->{file} . " " . $section, $comment );
 241                 $self->add_prefs( $comment, $sysprefs );
 242             }
 243         }
 244     }
 245 }
 246
 247
 248 sub save_po {
 249     my $self = shift;
 250
 251     # Create file header if it doesn't already exist
 252     my $po = $self->{po};
 253     $po->{''} ||= $default_pref_po_header;
 254
 255     # Write .po entries into a file put in Koha standard po directory
 256     Locale::PO->save_file_fromhash( $self->po_filename, $po );
 257     say "Saved in file: ", $self->po_filename if $self->{verbose};
 258 }
 259
 260
 261 sub get_po_merged_with_en {
 262     my $self = shift;
 263
 264     # Get po from current 'en' .pref files
 265     $self->get_po_from_prefs();
 266     my $po_current = $self->{po};
 267
 268     # Get po from previous generation
 269     my $po_previous = Locale::PO->load_file_ashash( $self->po_filename );
 270
 271     for my $id ( keys %$po_current ) {
 272         my $po =  $po_previous->{Locale::PO->quote($id)};
 273         next unless $po;
 274         my $text = Locale::PO->dequote( $po->msgstr );
 275         $po_current->{$id}->msgstr( $text );
 276     }
 277 }
 278
 279
 280 sub update_prefs {
 281     my $self = shift;
 282     print "Update '", $self->{lang},
 283           "' preferences .po file from 'en' .pref files\n" if $self->{verbose};
 284     $self->get_po_merged_with_en();
 285     $self->save_po();
 286 }
 287
 288
 289 sub install_prefs {
 290     my $self = shift;
 291
 292     unless ( -r $self->{po_path_lang} ) {
 293         print "Koha directories hierarchy for ", $self->{lang}, " must be created first\n";
 294         exit;
 295     }
 296
 297     # Get the language .po file merged with last modified 'en' preferences
 298     $self->get_po_merged_with_en();
 299
 300     for my $file ( @{$self->{pref_files}} ) {
 301         my $pref = LoadFile( $self->{path_pref_en} . "/$file" );
 302         $self->{file} = $file;
 303         # First, keys are replaced (tab titles)
 304         $pref = do {
 305             my %pref = map {
 306                 $self->get_trans_text( $self->{file} ) || $_ => $pref->{$_}
 307             } keys %$pref;
 308             \%pref;
 309         };
 310         while ( my ($tab, $tab_content) = each %$pref ) {
 311             if ( ref($tab_content) eq 'ARRAY' ) {
 312                 $self->update_tab_prefs( $pref, $tab_content );
 313                 next;
 314             }
 315             while ( my ($section, $sysprefs) = each %$tab_content ) {
 316                 $self->update_tab_prefs( $pref, $sysprefs );
 317             }
 318             my $ntab = {};
 319             for my $section ( keys %$tab_content ) {
 320                 my $id = $self->{file} . " $section";
 321                 my $text = $self->get_trans_text($id);
 322                 my $nsection = $text ? $text : $section;
 323                 $ntab->{$nsection} = $tab_content->{$section};
 324             }
 325             $pref->{$tab} = $ntab;
 326         }
 327         my $file_trans = $self->{po_path_lang} . "/$file";
 328         print "Write $file\n" if $self->{verbose};
 329         open my $fh, ">", $file_trans;
 330         print $fh Dump($pref);
 331     }
 332 }
 333
 334
 335 sub install_tmpl {
 336     my ($self, $files) = @_;
 337     say "Install templates" if $self->{verbose};
 338     for my $trans ( @{$self->{interface}} ) {
 339         print
 340             "  Install templates '$trans->{name}'\n",
 341             "    From: $trans->{dir}/en/\n",
 342             "    To  : $trans->{dir}/$self->{lang}\n",
 343             "    With: $self->{path_po}/$self->{lang}$trans->{suffix}\n"
 344                 if $self->{verbose};
 345
 346         my $trans_dir = ( $trans->{name} =~ /help/ )?"$trans->{dir}":"$trans->{dir}/en/";
 347         my $lang_dir  = ( $trans->{name} =~ /help/ )?"$trans->{dir}":"$trans->{dir}/$self->{lang}";
 348         $lang_dir =~ s|/en/|/$self->{lang}/|;
 349         mkdir $lang_dir unless -d $lang_dir;
 350         my $excludes  = ( $trans->{name} =~ /UI/   )?"-x 'help'":"";
 351
 352         system
 353             "$self->{process} install " .
 354             "-i $trans_dir " .
 355             "-o $lang_dir  ".
 356             "-s $self->{path_po}/$self->{lang}$trans->{suffix} -r $excludes" .
 357             (
 358                 @$files
 359                     ? ' -f ' . join ' -f ', @$files
 360                     : ''
 361             )
 362     }
 363 }
 364
 365
 366 sub update_tmpl {
 367     my ($self, $files) = @_;
 368
 369     say "Update templates" if $self->{verbose};
 370     for my $trans ( @{$self->{interface}} ) {
 371         print
 372             "  Update templates '$trans->{name}'\n",
 373             "    From: $trans->{dir}/en/\n",
 374             "    To  : $self->{path_po}/$self->{lang}$trans->{suffix}\n"
 375                 if $self->{verbose};
 376         my $lang_dir = "$trans->{dir}/$self->{lang}";
 377         mkdir $lang_dir unless -d $lang_dir;
 378
 379         my $trans_dir = ( $trans->{name} =~ /help/ )?"$trans->{dir}":"$trans->{dir}/en/";
 380         my $excludes  = ( $trans->{name} =~ /UI/   )?"-x 'help'":"";
 381
 382         system
 383             "$self->{process} update " .
 384             "-i $trans_dir " .
 385             "-s $self->{path_po}/$self->{lang}$trans->{suffix} -r $excludes" .
 386             (
 387                 @$files
 388                     ? ' -f ' . join ' -f ', @$files
 389                     : ''
 390             )
 391     }
 392 }
 393
 394
 395 sub create_prefs {
 396     my $self = shift;
 397
 398     if ( -e $self->po_filename ) {
 399         say "Preferences .po file already exists. Delete it if you want to recreate it.";
 400         return;
 401     }
 402     $self->get_po_from_prefs();
 403     $self->save_po();
 404 }
 405
 406
 407 sub create_tmpl {
 408     my ($self, $files) = @_;
 409
 410     say "Create templates\n" if $self->{verbose};
 411     for my $trans ( @{$self->{interface}} ) {
 412         print
 413             "  Create templates .po files for '$trans->{name}'\n",
 414             "    From: $trans->{dir}/en/\n",
 415             "    To  : $self->{path_po}/$self->{lang}$trans->{suffix}\n"
 416                 if $self->{verbose};
 417
 418         my $trans_dir = ( $trans->{name} =~ /help/ )?"$trans->{dir}":"$trans->{dir}/en/";
 419         my $excludes  = ( $trans->{name} =~ /UI/   )?"-x 'help'":"";
 420
 421         system
 422             "$self->{process} create " .
 423             "-i $trans_dir " .
 424             "-s $self->{path_po}/$self->{lang}$trans->{suffix} -r $excludes" .
 425             (
 426                 @$files
 427                     ? ' -f ' . join ' -f ', @$files
 428                     : ''
 429             )
 430     }
 431 }
 432
 433 sub create_messages {
 434     my $self = shift;
 435
 436     system
 437         "$self->{cp} $self->{domain}.pot " .
 438         "$self->{path_po}/$self->{lang}-$self->{domain}.po";
 439 }
 440
 441 sub update_messages {
 442     my $self = shift;
 443
 444     system
 445         "$self->{msgmerge} -U " .
 446         "$self->{path_po}/$self->{lang}-$self->{domain}.po " .
 447         "$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         "-kmaketext -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
 481 sub remove_pot {
 482     my $self = shift;
 483
 484     unlink "$Bin/$self->{domain}.pot";
 485 }
 486
 487 sub install {
 488     my ($self, $files) = @_;
 489     return unless $self->{lang};
 490     $self->install_tmpl($files) unless $self->{pref_only};
 491     $self->install_prefs();
 492 }
 493
 494
 495 sub get_all_langs {
 496     my $self = shift;
 497     opendir( my $dh, $self->{path_po} );
 498     my @files = grep { $_ =~ /-i-opac-t-prog-v-3006000.po$/ }
 499         readdir $dh;
 500     @files = map { $_ =~ s/-i-opac-t-prog-v-3006000.po$//; $_ } @files;
 501 }
 502
 503
 504 sub update {
 505     my ($self, $files) = @_;
 506     my @langs = $self->{lang} ? ($self->{lang}) : $self->get_all_langs();
 507     $self->extract_messages();
 508     for my $lang ( @langs ) {
 509         $self->set_lang( $lang );
 510         $self->update_tmpl($files) unless $self->{pref_only};
 511         $self->update_prefs();
 512         $self->update_messages();
 513     }
 514     $self->remove_pot();
 515 }
 516
 517
 518 sub create {
 519     my ($self, $files) = @_;
 520     return unless $self->{lang};
 521     $self->create_tmpl($files) unless $self->{pref_only};
 522     $self->create_prefs();
 523     $self->extract_messages();
 524     $self->create_messages();
 525     $self->remove_pot();
 526 }
 527
 528
 529
 530 1;
 531
 532
 533 =head1 NAME
 534
 535 LangInstaller.pm - Handle templates and preferences translation
 536
 537 =head1 SYNOPSYS
 538
 539   my $installer = LangInstaller->new( 'fr-FR' );
 540   $installer->create();
 541   $installer->update();
 542   $installer->install();
 543   for my $lang ( @{$installer->{langs} ) {
 544     $installer->set_lang( $lan );
 545     $installer->install();
 546   }
 547
 548 =head1 METHODS
 549
 550 =head2 new
 551
 552 Create a new instance of the installer object.
 553
 554 =head2 create
 555
 556 For the current language, create .po files for templates and preferences based
 557 of the english ('en') version.
 558
 559 =head2 update
 560
 561 For the current language, update .po files.
 562
 563 =head2 install
 564
 565 For the current langage C<$self->{lang}, use .po files to translate the english
 566 version of templates and preferences files and copy those files in the
 567 appropriate directory.
 568
 569 =over
 570
 571 =item translate create F<lang>
 572
 573 Create 3 .po files in F<po> subdirectory: (1) from opac pages templates, (2)
 574 intranet templates, and (3) from preferences.
 575
 576 =over
 577
 578 =item F<lang>-opac.po
 579
 580 Contains extracted text from english (en) OPAC templates found in
 581 <KOHA_ROOT>/koha-tmpl/opac-tmpl/prog/en/ directory.
 582
 583 =item F<lang>-intranet.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 =back
 595
 596 =item pref-trans update F<lang>
 597
 598 Update .po files in F<po> directory, named F<lang>-*.po.
 599
 600 =item pref-trans install F<lang>
 601
 602 =back
 603
 604 =cut
 605