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