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