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
   8 # under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  19
  20 use Modern::Perl;
  21
  22 use C4::Context;
  23 # WARNING: Any other tested YAML library fails to work properly in this
  24 # script content
  25 use YAML::Syck qw( Dump LoadFile );
  26 use Locale::PO;
  27 use FindBin qw( $Bin );
  28 use File::Basename;
  29 use File::Find;
  30 use File::Path qw( make_path );
  31 use File::Slurp;
  32 use File::Spec;
  33 use File::Temp qw( tempdir );
  34 use Template::Parser;
  35 use PPI;
  36
  37 $YAML::Syck::ImplicitTyping = 1;
  38
  39
  40 # Default file header for .po syspref files
  41 my $default_pref_po_header = Locale::PO->new(-msgid => '', -msgstr =>
  42     "Project-Id-Version: PACKAGE VERSION\\n" .
  43     "PO-Revision-Date: YEAR-MO-DA HO:MI +ZONE\\n" .
  44     "Last-Translator: FULL NAME <EMAIL\@ADDRESS>\\n" .
  45     "Language-Team: Koha Translate List <koha-translate\@lists.koha-community.org>\\n" .
  46     "MIME-Version: 1.0\\n" .
  47     "Content-Type: text/plain; charset=UTF-8\\n" .
  48     "Content-Transfer-Encoding: 8bit\\n" .
  49     "Plural-Forms: nplurals=2; plural=(n > 1);\\n"
  50 );
  51
  52
  53 sub set_lang {
  54     my ($self, $lang) = @_;
  55
  56     $self->{lang} = $lang;
  57     $self->{po_path_lang} = $self->{context}->config('intrahtdocs') .
  58                             "/prog/$lang/modules/admin/preferences";
  59 }
  60
  61
  62 sub new {
  63     my ($class, $lang, $pref_only, $verbose) = @_;
  64
  65     my $self                 = { };
  66
  67     my $context              = C4::Context->new();
  68     $self->{context}         = $context;
  69     $self->{path_pref_en}    = $context->config('intrahtdocs') .
  70                                '/prog/en/modules/admin/preferences';
  71     set_lang( $self, $lang ) if $lang;
  72     $self->{pref_only}       = $pref_only;
  73     $self->{verbose}         = $verbose;
  74     $self->{process}         = "$Bin/tmpl_process3.pl " . ($verbose ? '' : '-q');
  75     $self->{path_po}         = "$Bin/po";
  76     $self->{po}              = { '' => $default_pref_po_header };
  77     $self->{domain}          = 'Koha';
  78     $self->{cp}              = `which cp`;
  79     $self->{msgmerge}        = `which msgmerge`;
  80     $self->{msgfmt}          = `which msgfmt`;
  81     $self->{msginit}         = `which msginit`;
  82     $self->{xgettext}        = `which xgettext`;
  83     $self->{sed}             = `which sed`;
  84     $self->{po2json}         = "$Bin/po2json";
  85     $self->{gzip}            = `which gzip`;
  86     $self->{gunzip}          = `which gunzip`;
  87     chomp $self->{cp};
  88     chomp $self->{msgmerge};
  89     chomp $self->{msgfmt};
  90     chomp $self->{msginit};
  91     chomp $self->{xgettext};
  92     chomp $self->{sed};
  93     chomp $self->{gzip};
  94     chomp $self->{gunzip};
  95
  96     unless ($self->{xgettext}) {
  97         die "Missing 'xgettext' executable. Have you installed the gettext package?\n";
  98     }
  99
 100     # Get all .pref file names
 101     opendir my $fh, $self->{path_pref_en};
 102     my @pref_files = grep { /\.pref$/ } readdir($fh);
 103     close $fh;
 104     $self->{pref_files} = \@pref_files;
 105
 106     # Get all available language codes
 107     opendir $fh, $self->{path_po};
 108     my @langs =  map { ($_) =~ /(.*)-pref/ }
 109         grep { $_ =~ /.*-pref/ } readdir($fh);
 110     closedir $fh;
 111     $self->{langs} = \@langs;
 112
 113     # Map for both interfaces opac/intranet
 114     my $opachtdocs = $context->config('opachtdocs');
 115     $self->{interface} = [
 116         {
 117             name   => 'Intranet prog UI',
 118             dir    => $context->config('intrahtdocs') . '/prog',
 119             suffix => '-staff-prog.po',
 120         },
 121     ];
 122
 123     # OPAC themes
 124     opendir my $dh, $context->config('opachtdocs');
 125     for my $theme ( grep { not /^\.|lib|xslt/ } readdir($dh) ) {
 126         push @{$self->{interface}}, {
 127             name   => "OPAC $theme",
 128             dir    => "$opachtdocs/$theme",
 129             suffix => "-opac-$theme.po",
 130         };
 131     }
 132
 133     # MARC flavours (hardcoded list)
 134     for ( "MARC21", "UNIMARC", "NORMARC" ) {
 135         # search for strings on staff & opac marc files
 136         my $dirs = $context->config('intrahtdocs') . '/prog';
 137         opendir $fh, $context->config('opachtdocs');
 138         for ( grep { not /^\.|\.\.|lib$|xslt/ } readdir($fh) ) {
 139             $dirs .= ' ' . "$opachtdocs/$_";
 140         }
 141         push @{$self->{interface}}, {
 142             name   => "$_",
 143             dir    => $dirs,
 144             suffix => "-marc-$_.po",
 145         };
 146     }
 147
 148     bless $self, $class;
 149 }
 150
 151
 152 sub po_filename {
 153     my $self = shift;
 154
 155     my $context    = C4::Context->new;
 156     my $trans_path = $Bin . '/po';
 157     my $trans_file = "$trans_path/" . $self->{lang} . "-pref.po";
 158     return $trans_file;
 159 }
 160
 161
 162 sub po_append {
 163     my ($self, $id, $comment) = @_;
 164     my $po = $self->{po};
 165     my $p = $po->{$id};
 166     if ( $p ) {
 167         $p->comment( $p->comment . "\n" . $comment );
 168     }
 169     else {
 170         $po->{$id} = Locale::PO->new(
 171             -comment => $comment,
 172             -msgid   => $id,
 173             -msgstr  => ''
 174         );
 175     }
 176 }
 177
 178
 179 sub add_prefs {
 180     my ($self, $comment, $prefs) = @_;
 181
 182     for my $pref ( @$prefs ) {
 183         my $pref_name = '';
 184         for my $element ( @$pref ) {
 185             if ( ref( $element) eq 'HASH' ) {
 186                 $pref_name = $element->{pref};
 187                 last;
 188             }
 189         }
 190         for my $element ( @$pref ) {
 191             if ( ref( $element) eq 'HASH' ) {
 192                 while ( my ($key, $value) = each(%$element) ) {
 193                     next unless $key eq 'choices' or $key eq 'multiple';
 194                     next unless ref($value) eq 'HASH';
 195                     for my $ckey ( keys %$value ) {
 196                         my $id = $self->{file} . "#$pref_name# " . $value->{$ckey};
 197                         $self->po_append( $id, $comment );
 198                     }
 199                 }
 200             }
 201             elsif ( $element ) {
 202                 $self->po_append( $self->{file} . "#$pref_name# $element", $comment );
 203             }
 204         }
 205     }
 206 }
 207
 208
 209 sub get_trans_text {
 210     my ($self, $id) = @_;
 211
 212     my $po = $self->{po}->{$id};
 213     return unless $po;
 214     return Locale::PO->dequote($po->msgstr);
 215 }
 216
 217
 218 sub update_tab_prefs {
 219     my ($self, $pref, $prefs) = @_;
 220
 221     for my $p ( @$prefs ) {
 222         my $pref_name = '';
 223         next unless $p;
 224         for my $element ( @$p ) {
 225             if ( ref( $element) eq 'HASH' ) {
 226                 $pref_name = $element->{pref};
 227                 last;
 228             }
 229         }
 230         for my $i ( 0..@$p-1 ) {
 231             my $element = $p->[$i];
 232             if ( ref( $element) eq 'HASH' ) {
 233                 while ( my ($key, $value) = each(%$element) ) {
 234                     next unless $key eq 'choices' or $key eq 'multiple';
 235                     next unless ref($value) eq 'HASH';
 236                     for my $ckey ( keys %$value ) {
 237                         my $id = $self->{file} . "#$pref_name# " . $value->{$ckey};
 238                         my $text = $self->get_trans_text( $id );
 239                         $value->{$ckey} = $text if $text;
 240                     }
 241                 }
 242             }
 243             elsif ( $element ) {
 244                 my $id = $self->{file} . "#$pref_name# $element";
 245                 my $text = $self->get_trans_text( $id );
 246                 $p->[$i] = $text if $text;
 247             }
 248         }
 249     }
 250 }
 251
 252
 253 sub get_po_from_prefs {
 254     my $self = shift;
 255
 256     for my $file ( @{$self->{pref_files}} ) {
 257         my $pref = LoadFile( $self->{path_pref_en} . "/$file" );
 258         $self->{file} = $file;
 259         # Entries for tab titles
 260         $self->po_append( $self->{file}, $_ ) for keys %$pref;
 261         while ( my ($tab, $tab_content) = each %$pref ) {
 262             if ( ref($tab_content) eq 'ARRAY' ) {
 263                 $self->add_prefs( $tab, $tab_content );
 264                 next;
 265             }
 266             while ( my ($section, $sysprefs) = each %$tab_content ) {
 267                 my $comment = "$tab > $section";
 268                 $self->po_append( $self->{file} . " " . $section, $comment );
 269                 $self->add_prefs( $comment, $sysprefs );
 270             }
 271         }
 272     }
 273 }
 274
 275
 276 sub save_po {
 277     my $self = shift;
 278
 279     # Create file header if it doesn't already exist
 280     my $po = $self->{po};
 281     $po->{''} ||= $default_pref_po_header;
 282
 283     # Write .po entries into a file put in Koha standard po directory
 284     Locale::PO->save_file_fromhash( $self->po_filename, $po );
 285     say "Saved in file: ", $self->po_filename if $self->{verbose};
 286 }
 287
 288
 289 sub get_po_merged_with_en {
 290     my $self = shift;
 291
 292     # Get po from current 'en' .pref files
 293     $self->get_po_from_prefs();
 294     my $po_current = $self->{po};
 295
 296     # Get po from previous generation
 297     my $po_previous = Locale::PO->load_file_ashash( $self->po_filename );
 298
 299     for my $id ( keys %$po_current ) {
 300         my $po =  $po_previous->{Locale::PO->quote($id)};
 301         next unless $po;
 302         my $text = Locale::PO->dequote( $po->msgstr );
 303         $po_current->{$id}->msgstr( $text );
 304     }
 305 }
 306
 307
 308 sub update_prefs {
 309     my $self = shift;
 310     print "Update '", $self->{lang},
 311           "' preferences .po file from 'en' .pref files\n" if $self->{verbose};
 312     $self->get_po_merged_with_en();
 313     $self->save_po();
 314 }
 315
 316
 317 sub install_prefs {
 318     my $self = shift;
 319
 320     unless ( -r $self->{po_path_lang} ) {
 321         print "Koha directories hierarchy for ", $self->{lang}, " must be created first\n";
 322         exit;
 323     }
 324
 325     # Get the language .po file merged with last modified 'en' preferences
 326     $self->get_po_merged_with_en();
 327
 328     for my $file ( @{$self->{pref_files}} ) {
 329         my $pref = LoadFile( $self->{path_pref_en} . "/$file" );
 330         $self->{file} = $file;
 331         # First, keys are replaced (tab titles)
 332         $pref = do {
 333             my %pref = map {
 334                 $self->get_trans_text( $self->{file} ) || $_ => $pref->{$_}
 335             } keys %$pref;
 336             \%pref;
 337         };
 338         while ( my ($tab, $tab_content) = each %$pref ) {
 339             if ( ref($tab_content) eq 'ARRAY' ) {
 340                 $self->update_tab_prefs( $pref, $tab_content );
 341                 next;
 342             }
 343             while ( my ($section, $sysprefs) = each %$tab_content ) {
 344                 $self->update_tab_prefs( $pref, $sysprefs );
 345             }
 346             my $ntab = {};
 347             for my $section ( keys %$tab_content ) {
 348                 my $id = $self->{file} . " $section";
 349                 my $text = $self->get_trans_text($id);
 350                 my $nsection = $text ? $text : $section;
 351                 if( exists $ntab->{$nsection} ) {
 352                     # When translations collide (see BZ 18634)
 353                     push @{$ntab->{$nsection}}, @{$tab_content->{$section}};
 354                 } else {
 355                     $ntab->{$nsection} = $tab_content->{$section};
 356                 }
 357             }
 358             $pref->{$tab} = $ntab;
 359         }
 360         my $file_trans = $self->{po_path_lang} . "/$file";
 361         print "Write $file\n" if $self->{verbose};
 362         open my $fh, ">", $file_trans;
 363         print $fh Dump($pref);
 364     }
 365 }
 366
 367
 368 sub install_tmpl {
 369     my ($self, $files) = @_;
 370     say "Install templates" if $self->{verbose};
 371     for my $trans ( @{$self->{interface}} ) {
 372         my @t_dirs = split(" ", $trans->{dir});
 373         for my $t_dir ( @t_dirs ) {
 374             my @files   = @$files;
 375             my @nomarc = ();
 376             print
 377                 "  Install templates '$trans->{name}'\n",
 378                 "    From: $t_dir/en/\n",
 379                 "    To  : $t_dir/$self->{lang}\n",
 380                 "    With: $self->{path_po}/$self->{lang}$trans->{suffix}\n"
 381                 if $self->{verbose};
 382
 383             my $trans_dir = "$t_dir/en/";
 384             my $lang_dir  = "$t_dir/$self->{lang}";
 385             $lang_dir =~ s|/en/|/$self->{lang}/|;
 386             mkdir $lang_dir unless -d $lang_dir;
 387             # if installing MARC po file, only touch corresponding files
 388             my $marc     = ( $trans->{name} =~ /MARC/ )?"-m \"$trans->{name}\"":"";            # for MARC translations
 389             # if not installing MARC po file, ignore all MARC files
 390             @nomarc      = ( 'marc21', 'unimarc', 'normarc' ) if ( $trans->{name} !~ /MARC/ ); # hardcoded MARC variants
 391
 392             system
 393                 "$self->{process} install " .
 394                 "-i $trans_dir " .
 395                 "-o $lang_dir  ".
 396                 "-s $self->{path_po}/$self->{lang}$trans->{suffix} -r " .
 397                 "$marc " .
 398                 ( @files   ? ' -f ' . join ' -f ', @files : '') .
 399                 ( @nomarc  ? ' -n ' . join ' -n ', @nomarc : '');
 400         }
 401     }
 402 }
 403
 404
 405 sub update_tmpl {
 406     my ($self, $files) = @_;
 407
 408     say "Update templates" if $self->{verbose};
 409     for my $trans ( @{$self->{interface}} ) {
 410         my @files   = @$files;
 411         my @nomarc = ();
 412         print
 413             "  Update templates '$trans->{name}'\n",
 414             "    From: $trans->{dir}/en/\n",
 415             "    To  : $self->{path_po}/$self->{lang}$trans->{suffix}\n"
 416                 if $self->{verbose};
 417
 418         my $trans_dir = join("/en/ -i ",split(" ",$trans->{dir}))."/en/"; # multiple source dirs
 419         # if processing MARC po file, only use corresponding files
 420         my $marc      = ( $trans->{name} =~ /MARC/ )?"-m \"$trans->{name}\"":"";            # for MARC translations
 421         # if not processing MARC po file, ignore all MARC files
 422         @nomarc       = ( 'marc21', 'unimarc', 'normarc' ) if ( $trans->{name} !~ /MARC/ );      # hardcoded MARC variants
 423
 424         system
 425             "$self->{process} update " .
 426             "-i $trans_dir " .
 427             "-s $self->{path_po}/$self->{lang}$trans->{suffix} -r " .
 428             "$marc "     .
 429             ( @files   ? ' -f ' . join ' -f ', @files : '') .
 430             ( @nomarc  ? ' -n ' . join ' -n ', @nomarc : '');
 431     }
 432 }
 433
 434
 435 sub create_prefs {
 436     my $self = shift;
 437
 438     if ( -e $self->po_filename ) {
 439         say "Preferences .po file already exists. Delete it if you want to recreate it.";
 440         return;
 441     }
 442     $self->get_po_from_prefs();
 443     $self->save_po();
 444 }
 445
 446
 447 sub create_tmpl {
 448     my ($self, $files) = @_;
 449
 450     say "Create templates\n" if $self->{verbose};
 451     for my $trans ( @{$self->{interface}} ) {
 452         my @files   = @$files;
 453         my @nomarc = ();
 454         print
 455             "  Create templates .po files for '$trans->{name}'\n",
 456             "    From: $trans->{dir}/en/\n",
 457             "    To  : $self->{path_po}/$self->{lang}$trans->{suffix}\n"
 458                 if $self->{verbose};
 459
 460         my $trans_dir = join("/en/ -i ",split(" ",$trans->{dir}))."/en/"; # multiple source dirs
 461         # if processing MARC po file, only use corresponding files
 462         my $marc      = ( $trans->{name} =~ /MARC/ )?"-m \"$trans->{name}\"":"";            # for MARC translations
 463         # if not processing MARC po file, ignore all MARC files
 464         @nomarc       = ( 'marc21', 'unimarc', 'normarc' ) if ( $trans->{name} !~ /MARC/ ); # hardcoded MARC variants
 465
 466         system
 467             "$self->{process} create " .
 468             "-i $trans_dir " .
 469             "-s $self->{path_po}/$self->{lang}$trans->{suffix} -r " .
 470             "$marc " .
 471             ( @files  ? ' -f ' . join ' -f ', @files   : '') .
 472             ( @nomarc ? ' -n ' . join ' -n ', @nomarc : '');
 473     }
 474 }
 475
 476 sub locale_name {
 477     my $self = shift;
 478
 479     my ($language, $region, $country) = split /-/, $self->{lang};
 480     $country //= $region;
 481     my $locale = $language;
 482     if ($country && length($country) == 2) {
 483         $locale .= '_' . $country;
 484     }
 485
 486     return $locale;
 487 }
 488
 489 sub create_messages {
 490     my $self = shift;
 491
 492     my $pot = "$Bin/$self->{domain}.pot";
 493     my $po = "$self->{path_po}/$self->{lang}-messages.po";
 494     my $js_pot = "$self->{domain}-js.pot";
 495     my $js_po = "$self->{path_po}/$self->{lang}-messages-js.po";
 496
 497     unless ( -f $pot && -f $js_pot ) {
 498         $self->extract_messages();
 499     }
 500
 501     say "Create messages ($self->{lang})" if $self->{verbose};
 502     my $locale = $self->locale_name();
 503     system "$self->{msginit} -i $pot -o $po -l $locale --no-translator 2> /dev/null";
 504     warn "Problems creating $pot ".$? if ( $? == -1 );
 505     system "$self->{msginit} -i $js_pot -o $js_po -l $locale --no-translator 2> /dev/null";
 506     warn "Problems creating $js_pot ".$? if ( $? == -1 );
 507
 508     # If msginit failed to correctly set Plural-Forms, set a default one
 509     system "$self->{sed} --in-place "
 510         . "--expression='s/Plural-Forms: nplurals=INTEGER; plural=EXPRESSION/Plural-Forms: nplurals=2; plural=(n != 1)/' "
 511         . "$po $js_po";
 512 }
 513
 514 sub update_messages {
 515     my $self = shift;
 516
 517     my $pot = "$Bin/$self->{domain}.pot";
 518     my $po = "$self->{path_po}/$self->{lang}-messages.po";
 519     my $js_pot = "$self->{domain}-js.pot";
 520     my $js_po = "$self->{path_po}/$self->{lang}-messages-js.po";
 521
 522     unless ( -f $pot && -f $js_pot ) {
 523         $self->extract_messages();
 524     }
 525
 526     if ( -f $po && -f $js_pot ) {
 527         say "Update messages ($self->{lang})" if $self->{verbose};
 528         system "$self->{msgmerge} --backup=off --quiet -U $po $pot";
 529         system "$self->{msgmerge} --backup=off --quiet -U $js_po $js_pot";
 530     } else {
 531         $self->create_messages();
 532     }
 533 }
 534
 535 sub extract_messages_from_templates {
 536     my ($self, $tempdir, $type, @files) = @_;
 537
 538     my $htdocs = $type eq 'intranet' ? 'intrahtdocs' : 'opachtdocs';
 539     my $dir = $self->{context}->config($htdocs);
 540     my @keywords = qw(t tx tn txn tnx tp tpx tnp tnpx);
 541     my $parser = Template::Parser->new();
 542
 543     foreach my $file (@files) {
 544         say "Extract messages from $file" if $self->{verbose};
 545         my $template = read_file(File::Spec->catfile($dir, $file));
 546
 547         # No need to process a file that doesn't use the i18n.inc file.
 548         next unless $template =~ /i18n\.inc/;
 549
 550         my $data = $parser->parse($template);
 551         unless ($data) {
 552             warn "Error at $file : " . $parser->error();
 553             next;
 554         }
 555
 556         my $destfile = $type eq 'intranet' ?
 557             File::Spec->catfile($tempdir, 'koha-tmpl', 'intranet-tmpl', $file) :
 558             File::Spec->catfile($tempdir, 'koha-tmpl', 'opac-tmpl', $file);
 559
 560         make_path(dirname($destfile));
 561         open my $fh, '>', $destfile;
 562
 563         my @blocks = ($data->{BLOCK}, values %{ $data->{DEFBLOCKS} });
 564         foreach my $block (@blocks) {
 565             my $document = PPI::Document->new(\$block);
 566
 567             # [% t('foo') %] is compiled to
 568             # $output .= $stash->get(['t', ['foo']]);
 569             # We try to find all nodes corresponding to keyword (here 't')
 570             my $nodes = $document->find(sub {
 571                 my ($topnode, $element) = @_;
 572
 573                 # Filter out non-valid keywords
 574                 return 0 unless ($element->isa('PPI::Token::Quote::Single'));
 575                 return 0 unless (grep {$element->content eq qq{'$_'}} @keywords);
 576
 577                 # keyword (e.g. 't') should be the first element of the arrayref
 578                 # passed to $stash->get()
 579                 return 0 if $element->sprevious_sibling;
 580
 581                 return 0 unless $element->snext_sibling
 582                     && $element->snext_sibling->snext_sibling
 583                     && $element->snext_sibling->snext_sibling->isa('PPI::Structure::Constructor');
 584
 585                 # Check that it's indeed a call to $stash->get()
 586                 my $statement = $element->statement->parent->statement->parent->statement;
 587                 return 0 unless grep { $_->isa('PPI::Token::Symbol') && $_->content eq '$stash' } $statement->children;
 588                 return 0 unless grep { $_->isa('PPI::Token::Operator') && $_->content eq '->' } $statement->children;
 589                 return 0 unless grep { $_->isa('PPI::Token::Word') && $_->content eq 'get' } $statement->children;
 590
 591                 return 1;
 592             });
 593
 594             next unless $nodes;
 595
 596             # Write the Perl equivalent of calls to t* functions family, so
 597             # xgettext can extract the strings correctly
 598             foreach my $node (@$nodes) {
 599                 my @args = map {
 600                     $_->significant && !$_->isa('PPI::Token::Operator') ? $_->content : ()
 601                 } $node->snext_sibling->snext_sibling->find_first('PPI::Statement')->children;
 602
 603                 my $keyword = $node->content;
 604                 $keyword =~ s/^'t(.*)'$/__$1/;
 605
 606                 # Only keep required args to have a clean output
 607                 my @required_args = shift @args;
 608                 push @required_args, shift @args if $keyword =~ /n/;
 609                 push @required_args, shift @args if $keyword =~ /p/;
 610
 611                 say $fh "$keyword(" . join(', ', @required_args) . ");";
 612             }
 613
 614         }
 615
 616         close $fh;
 617     }
 618
 619     return $tempdir;
 620 }
 621
 622 sub extract_messages {
 623     my $self = shift;
 624
 625     say "Extract messages into POT file" if $self->{verbose};
 626
 627     my $intranetdir = $self->{context}->config('intranetdir');
 628     my $opacdir = $self->{context}->config('opacdir');
 629
 630     # Find common ancestor directory
 631     my @intranetdirs = File::Spec->splitdir($intranetdir);
 632     my @opacdirs = File::Spec->splitdir($opacdir);
 633     my @basedirs;
 634     while (@intranetdirs and @opacdirs) {
 635         my ($dir1, $dir2) = (shift @intranetdirs, shift @opacdirs);
 636         last if $dir1 ne $dir2;
 637         push @basedirs, $dir1;
 638     }
 639     my $basedir = File::Spec->catdir(@basedirs);
 640
 641     my @files_to_scan;
 642     my @directories_to_scan = ('.');
 643     my @blacklist = map { File::Spec->catdir(@intranetdirs, $_) } qw(blib koha-tmpl skel tmp t);
 644     while (@directories_to_scan) {
 645         my $dir = shift @directories_to_scan;
 646         opendir DIR, File::Spec->catdir($basedir, $dir) or die "Unable to open $dir: $!";
 647         foreach my $entry (readdir DIR) {
 648             next if $entry =~ /^\./;
 649             my $relentry = File::Spec->catfile($dir, $entry);
 650             my $abspath = File::Spec->catfile($basedir, $relentry);
 651             if (-d $abspath and not grep { $_ eq $relentry } @blacklist) {
 652                 push @directories_to_scan, $relentry;
 653             } elsif (-f $abspath and $relentry =~ /\.(pl|pm)$/) {
 654                 push @files_to_scan, $relentry;
 655             }
 656         }
 657     }
 658
 659     my $intrahtdocs = $self->{context}->config('intrahtdocs');
 660     my $opachtdocs = $self->{context}->config('opachtdocs');
 661
 662     my @intranet_tt_files;
 663     find(sub {
 664         if ($File::Find::dir =~ m|/en/| && $_ =~ m/\.(tt|inc)$/) {
 665             my $filename = $File::Find::name;
 666             $filename =~ s|^$intrahtdocs/||;
 667             push @intranet_tt_files, $filename;
 668         }
 669     }, $intrahtdocs);
 670
 671     my @opac_tt_files;
 672     find(sub {
 673         if ($File::Find::dir =~ m|/en/| && $_ =~ m/\.(tt|inc)$/) {
 674             my $filename = $File::Find::name;
 675             $filename =~ s|^$opachtdocs/||;
 676             push @opac_tt_files, $filename;
 677         }
 678     }, $opachtdocs);
 679
 680     my $tempdir = tempdir('Koha-translate-XXXX', TMPDIR => 1, CLEANUP => 1);
 681     $self->extract_messages_from_templates($tempdir, 'intranet', @intranet_tt_files);
 682     $self->extract_messages_from_templates($tempdir, 'opac', @opac_tt_files);
 683
 684     @intranet_tt_files = map { File::Spec->catfile('koha-tmpl', 'intranet-tmpl', $_) } @intranet_tt_files;
 685     @opac_tt_files = map { File::Spec->catfile('koha-tmpl', 'opac-tmpl', $_) } @opac_tt_files;
 686     my @tt_files = grep { -e File::Spec->catfile($tempdir, $_) } @intranet_tt_files, @opac_tt_files;
 687
 688     push @files_to_scan, @tt_files;
 689
 690     my $xgettext_common_args = "--force-po --from-code=UTF-8 "
 691         . "--package-name=Koha --package-version='' "
 692         . "-k -k__ -k__x -k__n:1,2 -k__nx:1,2 -k__xn:1,2 -k__p:1c,2 "
 693         . "-k__px:1c,2 -k__np:1c,2,3 -k__npx:1c,2,3 -kN__ -kN__n:1,2 "
 694         . "-kN__p:1c,2 -kN__np:1c,2,3 ";
 695     my $xgettext_cmd = "$self->{xgettext} -L Perl $xgettext_common_args "
 696         . "-o $Bin/$self->{domain}.pot -D $tempdir -D $basedir";
 697     $xgettext_cmd .= " $_" foreach (@files_to_scan);
 698
 699     if (system($xgettext_cmd) != 0) {
 700         die "system call failed: $xgettext_cmd";
 701     }
 702
 703     my @js_dirs = (
 704         "$intranetdir/koha-tmpl/intranet-tmpl/prog/js",
 705         "$intranetdir/koha-tmpl/opac-tmpl/bootstrap/js",
 706     );
 707
 708     my @js_files;
 709     find(sub {
 710         if ($_ =~ m/\.js$/) {
 711             my $filename = $File::Find::name;
 712             $filename =~ s|^$intranetdir/||;
 713             push @js_files, $filename;
 714         }
 715     }, @js_dirs);
 716
 717     $xgettext_cmd = "$self->{xgettext} -L JavaScript $xgettext_common_args "
 718         . "-o $Bin/$self->{domain}-js.pot -D $intranetdir";
 719     $xgettext_cmd .= " $_" foreach (@js_files);
 720
 721     if (system($xgettext_cmd) != 0) {
 722         die "system call failed: $xgettext_cmd";
 723     }
 724
 725     my $replace_charset_cmd = "$self->{sed} --in-place " .
 726         "--expression='s/charset=CHARSET/charset=UTF-8/' " .
 727         "$Bin/$self->{domain}.pot $Bin/$self->{domain}-js.pot";
 728     if (system($replace_charset_cmd) != 0) {
 729         die "system call failed: $replace_charset_cmd";
 730     }
 731 }
 732
 733 sub install_messages {
 734     my ($self) = @_;
 735
 736     my $locale = $self->locale_name();
 737     my $modir = "$self->{path_po}/$locale/LC_MESSAGES";
 738     my $pofile = "$self->{path_po}/$self->{lang}-messages.po";
 739     my $mofile = "$modir/$self->{domain}.mo";
 740     my $js_pofile = "$self->{path_po}/$self->{lang}-messages-js.po";
 741
 742     unless ( -f $pofile && -f $js_pofile ) {
 743         $self->create_messages();
 744     }
 745     say "Install messages ($locale)" if $self->{verbose};
 746     make_path($modir);
 747     system "$self->{msgfmt} -o $mofile $pofile";
 748
 749     my $js_locale_data = 'var json_locale_data = {"Koha":' . `$self->{po2json} $js_pofile` . '};';
 750     my $progdir = $self->{context}->config('intrahtdocs') . '/prog';
 751     mkdir "$progdir/$self->{lang}/js";
 752     open my $fh, '>', "$progdir/$self->{lang}/js/locale_data.js";
 753     print $fh $js_locale_data;
 754     close $fh;
 755
 756     my $opachtdocs = $self->{context}->config('opachtdocs');
 757     opendir(my $dh, $opachtdocs);
 758     for my $theme ( grep { not /^\.|lib|xslt/ } readdir($dh) ) {
 759         mkdir "$opachtdocs/$theme/$self->{lang}/js";
 760         open my $fh, '>', "$opachtdocs/$theme/$self->{lang}/js/locale_data.js";
 761         print $fh $js_locale_data;
 762         close $fh;
 763     }
 764 }
 765
 766 sub remove_pot {
 767     my $self = shift;
 768
 769     unlink "$Bin/$self->{domain}.pot";
 770     unlink "$Bin/$self->{domain}-js.pot";
 771 }
 772
 773 sub compress {
 774     my ($self, $files) = @_;
 775     my @langs = $self->{lang} ? ($self->{lang}) : $self->get_all_langs();
 776     for my $lang ( @langs ) {
 777         $self->set_lang( $lang );
 778         opendir( my $dh, $self->{path_po} );
 779         my @files = grep { $_ =~ /^$self->{lang}.*po$/ } readdir $dh;
 780         foreach my $file ( @files ) {
 781             say "Compress file $file" if $self->{verbose};
 782             system "$self->{gzip} -9 $self->{path_po}/$file";
 783         }
 784     }
 785 }
 786
 787 sub uncompress {
 788     my ($self, $files) = @_;
 789     my @langs = $self->{lang} ? ($self->{lang}) : $self->get_all_langs();
 790     for my $lang ( @langs ) {
 791         opendir( my $dh, $self->{path_po} );
 792         $self->set_lang( $lang );
 793         my @files = grep { $_ =~ /^$self->{lang}.*po.gz$/ } readdir $dh;
 794         foreach my $file ( @files ) {
 795             say "Uncompress file $file" if $self->{verbose};
 796             system "$self->{gunzip} $self->{path_po}/$file";
 797         }
 798     }
 799 }
 800
 801 sub install {
 802     my ($self, $files) = @_;
 803     return unless $self->{lang};
 804     $self->uncompress();
 805     $self->install_tmpl($files) unless $self->{pref_only};
 806     $self->install_prefs();
 807     $self->install_messages();
 808     $self->remove_pot();
 809 }
 810
 811
 812 sub get_all_langs {
 813     my $self = shift;
 814     opendir( my $dh, $self->{path_po} );
 815     my @files = grep { $_ =~ /-pref.(po|po.gz)$/ }
 816         readdir $dh;
 817     @files = map { $_ =~ s/-pref.(po|po.gz)$//; $_ } @files;
 818 }
 819
 820
 821 sub update {
 822     my ($self, $files) = @_;
 823     my @langs = $self->{lang} ? ($self->{lang}) : $self->get_all_langs();
 824     for my $lang ( @langs ) {
 825         $self->set_lang( $lang );
 826         $self->uncompress();
 827         $self->update_tmpl($files) unless $self->{pref_only};
 828         $self->update_prefs();
 829         $self->update_messages();
 830     }
 831     $self->remove_pot();
 832 }
 833
 834
 835 sub create {
 836     my ($self, $files) = @_;
 837     return unless $self->{lang};
 838     $self->create_tmpl($files) unless $self->{pref_only};
 839     $self->create_prefs();
 840     $self->create_messages();
 841     $self->remove_pot();
 842 }
 843
 844
 845
 846 1;
 847
 848
 849 =head1 NAME
 850
 851 LangInstaller.pm - Handle templates and preferences translation
 852
 853 =head1 SYNOPSYS
 854
 855   my $installer = LangInstaller->new( 'fr-FR' );
 856   $installer->create();
 857   $installer->update();
 858   $installer->install();
 859   for my $lang ( @{$installer->{langs} ) {
 860     $installer->set_lang( $lan );
 861     $installer->install();
 862   }
 863
 864 =head1 METHODS
 865
 866 =head2 new
 867
 868 Create a new instance of the installer object.
 869
 870 =head2 create
 871
 872 For the current language, create .po files for templates and preferences based
 873 of the english ('en') version.
 874
 875 =head2 update
 876
 877 For the current language, update .po files.
 878
 879 =head2 install
 880
 881 For the current langage C<$self->{lang}, use .po files to translate the english
 882 version of templates and preferences files and copy those files in the
 883 appropriate directory.
 884
 885 =over
 886
 887 =item translate create F<lang>
 888
 889 Create 4 kinds of .po files in F<po> subdirectory:
 890 (1) one from each theme on opac pages templates,
 891 (2) intranet templates,
 892 (3) preferences, and
 893 (4) one for each MARC dialect.
 894
 895
 896 =over
 897
 898 =item F<lang>-opac-{theme}.po
 899
 900 Contains extracted text from english (en) OPAC templates found in
 901 <KOHA_ROOT>/koha-tmpl/opac-tmpl/{theme}/en/ directory.
 902
 903 =item F<lang>-staff-prog.po
 904
 905 Contains extracted text from english (en) intranet templates found in
 906 <KOHA_ROOT>/koha-tmpl/intranet-tmpl/prog/en/ directory.
 907
 908 =item F<lang>-pref.po
 909
 910 Contains extracted text from english (en) preferences. They are found in files
 911 located in <KOHA_ROOT>/koha-tmpl/intranet-tmpl/prog/en/admin/preferences
 912 directory.
 913
 914 =item F<lang>-marc-{MARC}.po
 915
 916 Contains extracted text from english (en) files from opac and intranet,
 917 related with MARC dialects.
 918
 919 =back
 920
 921 =item pref-trans update F<lang>
 922
 923 Update .po files in F<po> directory, named F<lang>-*.po.
 924
 925 =item pref-trans install F<lang>
 926
 927 =back
 928
 929 =cut
 930