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