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