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