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