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