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