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