| Lines 22-39
          use Modern::Perl;
      
      
        Link Here | 
        
          | 22 | use C4::Context; | 22 | use C4::Context; | 
        
          | 23 | # WARNING: Any other tested YAML library fails to work properly in this | 23 | # WARNING: Any other tested YAML library fails to work properly in this | 
        
          | 24 | # script content | 24 | # script content | 
          
            
              | 25 | use YAML::Syck qw( Dump LoadFile ); | 25 | use YAML::Syck qw( Dump LoadFile DumpFile ); | 
        
          | 26 | use Locale::PO; | 26 | use Locale::PO; | 
        
          | 27 | use FindBin qw( $Bin ); | 27 | use FindBin qw( $Bin ); | 
        
          | 28 | use File::Basename; | 28 | use File::Basename; | 
        
          | 29 | use File::Find; | 29 | use File::Find; | 
        
          | 30 | use File::Path qw( make_path ); | 30 | use File::Path qw( make_path ); | 
            
              |  |  | 31 | use File::Copy; | 
        
          | 31 | use File::Slurp; | 32 | use File::Slurp; | 
        
          | 32 | use File::Spec; | 33 | use File::Spec; | 
          
            
              | 33 | use File::Temp qw( tempdir ); | 34 | use File::Temp qw( tempdir tempfile ); | 
        
          | 34 | use Template::Parser; | 35 | use Template::Parser; | 
        
          | 35 | use PPI; | 36 | use PPI; | 
        
          | 36 |  | 37 |  | 
            
              |  |  | 38 |  | 
        
          | 37 | $YAML::Syck::ImplicitTyping = 1; | 39 | $YAML::Syck::ImplicitTyping = 1; | 
        
          | 38 |  | 40 |  | 
        
          | 39 |  | 41 |  | 
  
    | Lines 79-90
          sub new {
      
      
        Link Here | 
        
          | 79 |     $self->{msgmerge}        = `which msgmerge`; | 81 |     $self->{msgmerge}        = `which msgmerge`; | 
        
          | 80 |     $self->{msgfmt}          = `which msgfmt`; | 82 |     $self->{msgfmt}          = `which msgfmt`; | 
        
          | 81 |     $self->{msginit}         = `which msginit`; | 83 |     $self->{msginit}         = `which msginit`; | 
            
              |  |  | 84 |     $self->{msgattrib}       = `which msgattrib`; | 
        
          | 82 |     $self->{xgettext}        = `which xgettext`; | 85 |     $self->{xgettext}        = `which xgettext`; | 
        
          | 83 |     $self->{sed}             = `which sed`; | 86 |     $self->{sed}             = `which sed`; | 
        
          | 84 |     chomp $self->{cp}; | 87 |     chomp $self->{cp}; | 
        
          | 85 |     chomp $self->{msgmerge}; | 88 |     chomp $self->{msgmerge}; | 
        
          | 86 |     chomp $self->{msgfmt}; | 89 |     chomp $self->{msgfmt}; | 
        
          | 87 |     chomp $self->{msginit}; | 90 |     chomp $self->{msginit}; | 
            
              |  |  | 91 |     chomp $self->{msgattrib}; | 
        
          | 88 |     chomp $self->{xgettext}; | 92 |     chomp $self->{xgettext}; | 
        
          | 89 |     chomp $self->{sed}; | 93 |     chomp $self->{sed}; | 
        
          | 90 |  | 94 |  | 
  
    | Lines 140-155
          sub new {
      
      
        Link Here | 
        
          | 140 |         }; | 144 |         }; | 
        
          | 141 |     } | 145 |     } | 
        
          | 142 |  | 146 |  | 
            
              |  |  | 147 |     # EN YAML installer files | 
            
              | 148 |     push @{$self->{installer}}, { | 
            
              | 149 |         name   => "YAML installer files", | 
            
              | 150 |         dirs   => [ 'installer/data/mysql/en/mandatory', | 
            
              | 151 |                     'installer/data/mysql/en/optional'], | 
            
              | 152 |         suffix => "-installer.po", | 
            
              | 153 |     }; | 
            
              | 154 |  | 
            
              | 155 |     # EN MARC21 YAML installer files | 
            
              | 156 |     push @{$self->{installer}}, { | 
            
              | 157 |         name   => "MARC21 YAML installer files", | 
            
              | 158 |         dirs   => [ 'installer/data/mysql/en/marcflavour/marc21/mandatory', | 
            
              | 159 |                     'installer/data/mysql/en/marcflavour/marc21/optional'], | 
            
              | 160 |         suffix => "-installer-MARC21.po", | 
            
              | 161 |     }; | 
            
              | 162 |  | 
            
              | 163 |     # EN UNIMARC YAML installer files | 
            
              | 164 |     push @{$self->{installer}}, { | 
            
              | 165 |         name   => "UNIMARC YAML installer files", | 
            
              | 166 |         dirs   => [ 'installer/data/mysql/en/marcflavour/unimarc/mandatory', ], | 
            
              | 167 |         suffix => "-installer-UNIMARC.po", | 
            
              | 168 |     }; | 
            
              | 169 |  | 
        
          | 143 |     bless $self, $class; | 170 |     bless $self, $class; | 
        
          | 144 | } | 171 | } | 
        
          | 145 |  | 172 |  | 
        
          | 146 |  | 173 |  | 
        
          | 147 | sub po_filename { | 174 | sub po_filename { | 
          
            
              | 148 |     my $self = shift; | 175 |     my $self   = shift; | 
            
              |  |  | 176 |     my $suffix = shift; | 
        
          | 149 |  | 177 |  | 
        
          | 150 |     my $context    = C4::Context->new; | 178 |     my $context    = C4::Context->new; | 
        
          | 151 |     my $trans_path = $Bin . '/po'; | 179 |     my $trans_path = $Bin . '/po'; | 
          
            
              | 152 |     my $trans_file = "$trans_path/" . $self->{lang} . "-pref.po"; | 180 |     my $trans_file = "$trans_path/" . $self->{lang} . $suffix; | 
        
          | 153 |     return $trans_file; | 181 |     return $trans_file; | 
        
          | 154 | } | 182 | } | 
        
          | 155 |  | 183 |  | 
  
    | Lines 276-283
          sub save_po {
      
      
        Link Here | 
        
          | 276 |     $po->{''} ||= $default_pref_po_header; | 304 |     $po->{''} ||= $default_pref_po_header; | 
        
          | 277 |  | 305 |  | 
        
          | 278 |     # Write .po entries into a file put in Koha standard po directory | 306 |     # Write .po entries into a file put in Koha standard po directory | 
          
            
              | 279 |     Locale::PO->save_file_fromhash( $self->po_filename, $po ); | 307 |     Locale::PO->save_file_fromhash( $self->po_filename("-pref.po"), $po ); | 
            
              | 280 |     say "Saved in file: ", $self->po_filename if $self->{verbose}; | 308 |     say "Saved in file: ", $self->po_filename("-pref.po") if $self->{verbose}; | 
        
          | 281 | } | 309 | } | 
        
          | 282 |  | 310 |  | 
        
          | 283 |  | 311 |  | 
  
    | Lines 289-295
          sub get_po_merged_with_en {
      
      
        Link Here | 
        
          | 289 |     my $po_current = $self->{po}; | 317 |     my $po_current = $self->{po}; | 
        
          | 290 |  | 318 |  | 
        
          | 291 |     # Get po from previous generation | 319 |     # Get po from previous generation | 
          
            
              | 292 |     my $po_previous = Locale::PO->load_file_ashash( $self->po_filename ); | 320 |     my $po_previous = Locale::PO->load_file_ashash( $self->po_filename("-pref.po") ); | 
        
          | 293 |  | 321 |  | 
        
          | 294 |     for my $id ( keys %$po_current ) { | 322 |     for my $id ( keys %$po_current ) { | 
        
          | 295 |         my $po =  $po_previous->{Locale::PO->quote($id)}; | 323 |         my $po =  $po_previous->{Locale::PO->quote($id)}; | 
  
    | Lines 430-436
          sub update_tmpl {
      
      
        Link Here | 
        
          | 430 | sub create_prefs { | 458 | sub create_prefs { | 
        
          | 431 |     my $self = shift; | 459 |     my $self = shift; | 
        
          | 432 |  | 460 |  | 
          
            
              | 433 |     if ( -e $self->po_filename ) { | 461 |     if ( -e $self->po_filename("-pref.po") ) { | 
        
          | 434 |         say "Preferences .po file already exists. Delete it if you want to recreate it."; | 462 |         say "Preferences .po file already exists. Delete it if you want to recreate it."; | 
        
          | 435 |         return; | 463 |         return; | 
        
          | 436 |     } | 464 |     } | 
  
    | Lines 438-443
          sub create_prefs {
      
      
        Link Here | 
        
          | 438 |     $self->save_po(); | 466 |     $self->save_po(); | 
        
          | 439 | } | 467 | } | 
        
          | 440 |  | 468 |  | 
            
              |  |  | 469 | sub get_po_from_target { | 
            
              | 470 |     my $self   = shift; | 
            
              | 471 |     my $target = shift; | 
            
              | 472 |  | 
            
              | 473 |     my $po; | 
            
              | 474 |     my $po_head = new Locale::PO; | 
            
              | 475 |     $po_head->{msgid}  = "\"\""; | 
            
              | 476 |     $po_head->{msgstr} = "". | 
            
              | 477 |         "Project-Id-Version: Koha Project - Installation files\\n" . | 
            
              | 478 |         "PO-Revision-Date: YEAR-MO-DA HO:MI +ZONE\\n" . | 
            
              | 479 |         "Last-Translator: FULL NAME <EMAIL\@ADDRESS>\\n" . | 
            
              | 480 |         "Language-Team: Koha Translation Team\\n" . | 
            
              | 481 |         "Language: ".$self->{lang}."\\n" . | 
            
              | 482 |         "MIME-Version: 1.0\\n" . | 
            
              | 483 |         "Content-Type: text/plain; charset=UTF-8\\n" . | 
            
              | 484 |         "Content-Transfer-Encoding: 8bit\\n"; | 
            
              | 485 |  | 
            
              | 486 |     my @dirs = @{ $target->{dirs} }; | 
            
              | 487 |     my $intradir = $self->{context}->config('intranetdir'); | 
            
              | 488 |     for my $dir ( @dirs ) {                                                     # each dir | 
            
              | 489 |         opendir( my $dh, "$intradir/$dir" ) or die ("Can't open $intradir/$dir"); | 
            
              | 490 |         my @filelist = grep { $_ =~ m/\.yml/ } readdir($dh);                    # Just yaml files | 
            
              | 491 |         close($dh); | 
            
              | 492 |         for my $file ( @filelist ) {                                            # each file | 
            
              | 493 |             my $yaml   = LoadFile( "$intradir/$dir/$file" ); | 
            
              | 494 |             my @tables = @{ $yaml->{'tables'} }; | 
            
              | 495 |             my $tablec; | 
            
              | 496 |             for my $table ( @tables ) {                                         # each table | 
            
              | 497 |                 $tablec++; | 
            
              | 498 |                 my $table_name = ( keys %$table )[0]; | 
            
              | 499 |                 my @translatable = @{ $table->{$table_name}->{translatable} }; | 
            
              | 500 |                 my @rows = @{ $table->{$table_name}->{rows} }; | 
            
              | 501 |                 my $rowc; | 
            
              | 502 |                 for my $row ( @rows ) {                                         # each row | 
            
              | 503 |                     $rowc++; | 
            
              | 504 |                     for my $field ( @translatable ) {                           # each field | 
            
              | 505 |                         if ( not $po->{ $row->{$field} } ) { | 
            
              | 506 |                             my $msg = new Locale::PO( | 
            
              | 507 |                                         -msgid => $row->{$field}, -msgstr => '', | 
            
              | 508 |                                         -reference => "$dir/$file:$table_name:$tablec:row:$rowc" ); | 
            
              | 509 |                             $po->{ $row->{$field} } = $msg; | 
            
              | 510 |                         } | 
            
              | 511 |                     } | 
            
              | 512 |                 } | 
            
              | 513 |             } | 
            
              | 514 |             my $desccount; | 
            
              | 515 |             for my $description ( @{ $yaml->{'description'} } ) { | 
            
              | 516 |                 $desccount++; | 
            
              | 517 |                 if ( not $po->{ $description } ) { | 
            
              | 518 |                     my $msg = new Locale::PO( | 
            
              | 519 |                                 -msgid => $description, -msgstr => '', | 
            
              | 520 |                                 -reference => "$dir/$file:description:$desccount" ); | 
            
              | 521 |                     $po->{ $description } = $msg; | 
            
              | 522 |                 } | 
            
              | 523 |             } | 
            
              | 524 |         } | 
            
              | 525 |     } | 
            
              | 526 |     $po->{''} = $po_head if ( $po ); | 
            
              | 527 |  | 
            
              | 528 |     return $po; | 
            
              | 529 | } | 
            
              | 530 |  | 
            
              | 531 | sub create_installer { | 
            
              | 532 |     my $self = shift; | 
            
              | 533 |     return unless ( $self->{installer} ); | 
            
              | 534 |  | 
            
              | 535 |     say "Create installer translation files\n" if $self->{verbose}; | 
            
              | 536 |  | 
            
              | 537 |     my @targets = @{ $self->{installer} };             # each installer target (common,marc21,unimarc) | 
            
              | 538 |  | 
            
              | 539 |     for my $target ( @targets ) { | 
            
              | 540 |         if ( -e $self->po_filename( $target->{suffix} ) ) { | 
            
              | 541 |             say "$self->{lang}$target->{suffix} file already exists. Delete it if you want to recreate it."; | 
            
              | 542 |             return; | 
            
              | 543 |         } | 
            
              | 544 |     } | 
            
              | 545 |  | 
            
              | 546 |     for my $target ( @targets ) { | 
            
              | 547 |         my $po = get_po_from_target( $self, $target ); | 
            
              | 548 |         # create output file only if there is something to write | 
            
              | 549 |         if ( $po ) { | 
            
              | 550 |             my $po_file = $self->po_filename( $target->{suffix} ); | 
            
              | 551 |             Locale::PO->save_file_fromhash( $po_file, $po ); | 
            
              | 552 |             say "Saved in file: ", $po_file if $self->{verbose}; | 
            
              | 553 |         } | 
            
              | 554 |     } | 
            
              | 555 | } | 
            
              | 556 |  | 
            
              | 557 | sub update_installer { | 
            
              | 558 |     my $self = shift; | 
            
              | 559 |     return unless ( $self->{installer} ); | 
            
              | 560 |  | 
            
              | 561 |     say "Update installer translation files\n" if $self->{verbose}; | 
            
              | 562 |  | 
            
              | 563 |     my @targets = @{ $self->{installer} };             # each installer target (common,marc21,unimarc) | 
            
              | 564 |  | 
            
              | 565 |     for my $target ( @targets ) { | 
            
              | 566 |         return unless ( -e $self->po_filename( $target->{suffix} ) ); | 
            
              | 567 |         my $po = get_po_from_target( $self, $target ); | 
            
              | 568 |         # update file only if there is something to update | 
            
              | 569 |         if ( $po ) { | 
            
              | 570 |             my ( $fh, $po_temp ) = tempfile(); | 
            
              | 571 |             binmode( $fh, ":encoding(UTF-8)" ); | 
            
              | 572 |             Locale::PO->save_file_fromhash( $po_temp, $po ); | 
            
              | 573 |             my $po_file = $self->po_filename( $target->{suffix} ); | 
            
              | 574 |             eval { | 
            
              | 575 |                 my $st = system($self->{msgmerge}." ".($self->{verbose}?'':'-q'). | 
            
              | 576 |                          " -s $po_file $po_temp -o - | ".$self->{msgattrib}." --no-obsolete -o $po_file"); | 
            
              | 577 |             }; | 
            
              | 578 |             say "Updated file: ", $po_file if $self->{verbose}; | 
            
              | 579 |         } | 
            
              | 580 |     } | 
            
              | 581 | } | 
            
              | 582 |  | 
            
              | 583 | sub translate_yaml { | 
            
              | 584 |     my $self   = shift; | 
            
              | 585 |     my $target = shift; | 
            
              | 586 |     my $srcyml = shift; | 
            
              | 587 |  | 
            
              | 588 |     my $po_file = $self->po_filename( $target->{suffix} ); | 
            
              | 589 |     return $srcyml unless ( -e $po_file ); | 
            
              | 590 |  | 
            
              | 591 |     my $po_ref  = Locale::PO->load_file_ashash( $po_file ); | 
            
              | 592 |  | 
            
              | 593 |     my $dstyml   = LoadFile( $srcyml ); | 
            
              | 594 |     my @tables = @{ $dstyml->{'tables'} }; | 
            
              | 595 |     for my $table ( @tables ) {                                                         # each table | 
            
              | 596 |         my $table_name = ( keys %$table )[0]; | 
            
              | 597 |         my @translatable = @{ $table->{$table_name}->{translatable} }; | 
            
              | 598 |         my @rows = @{ $table->{$table_name}->{rows} }; | 
            
              | 599 |         for my $row ( @rows ) {                                                         # each row | 
            
              | 600 |             for my $field ( @translatable ) {                                           # each translatable field | 
            
              | 601 |                 my $po = $po_ref->{"\"$row->{$field}\""};                               # quoted key | 
            
              | 602 |                 if ( $po  and not defined( $po->fuzzy() )                               # not fuzzy | 
            
              | 603 |                           and length( $po->msgstr() ) > 2 ) {                           # not empty | 
            
              | 604 |                     $row->{$field} = $po->dequote( $po->msgstr() ); | 
            
              | 605 |                 } | 
            
              | 606 |             } | 
            
              | 607 |         } | 
            
              | 608 |     } | 
            
              | 609 |     for my $description ( @{ $dstyml->{'description'} } ) { | 
            
              | 610 |         my $po = $po_ref->{"\"$description\""}; | 
            
              | 611 |         if ( $po  and not defined( $po->fuzzy() ) | 
            
              | 612 |                   and length( $po->msgstr() ) > 2 ) { | 
            
              | 613 |             $description = $po->dequote( $po->msgstr() ); | 
            
              | 614 |         } | 
            
              | 615 |     } | 
            
              | 616 |  | 
            
              | 617 |     return $dstyml; | 
            
              | 618 | } | 
            
              | 619 |  | 
            
              | 620 | sub install_installer { | 
            
              | 621 |     my $self = shift; | 
            
              | 622 |     return unless ( $self->{installer} ); | 
            
              | 623 |  | 
            
              | 624 |     my $intradir  = $self->{context}->config('intranetdir'); | 
            
              | 625 |     my $db_scheme = $self->{context}->config('db_scheme'); | 
            
              | 626 |     my $langdir  = "$intradir/installer/data/$db_scheme/$self->{lang}"; | 
            
              | 627 |     if ( -d $langdir ) { | 
            
              | 628 |         say "$self->{language} installer dir $langdir already exists.\nDelete it if you want to recreate it."; | 
            
              | 629 |         return; | 
            
              | 630 |     } | 
            
              | 631 |  | 
            
              | 632 |     say "Install installer files\n" if $self->{verbose}; | 
            
              | 633 |  | 
            
              | 634 |     for my $target ( @{ $self->{installer} } ) { | 
            
              | 635 |         return unless ( -e $self->po_filename( $target->{suffix} ) ); | 
            
              | 636 |         for my $dir ( @{ $target->{dirs} } ) { | 
            
              | 637 |             ( my $tdir = "$dir" ) =~ s|/en/|/$self->{lang}/|; | 
            
              | 638 |             make_path("$intradir/$tdir"); | 
            
              | 639 |  | 
            
              | 640 |             opendir( my $dh, "$intradir/$dir" ) or die ("Can't open $intradir/$dir"); | 
            
              | 641 |             my @files = grep { ! /^\.+$/ } readdir($dh); | 
            
              | 642 |             close($dh); | 
            
              | 643 |  | 
            
              | 644 |             for my $file ( @files ) { | 
            
              | 645 |                 if ( $file =~ /yml$/ ) { | 
            
              | 646 |                     my $translated_yaml = translate_yaml( $self, $target, "$intradir/$dir/$file" ); | 
            
              | 647 |                     open(my $fh, ">:encoding(UTF-8)", "$intradir/$tdir/$file"); | 
            
              | 648 |                     DumpFile( $fh, $translated_yaml ); | 
            
              | 649 |                     close($fh); | 
            
              | 650 |                 } else { | 
            
              | 651 |                     File::Copy::copy( "$intradir/$dir/$file", "$intradir/$tdir/$file" ); | 
            
              | 652 |                 } | 
            
              | 653 |             } | 
            
              | 654 |         } | 
            
              | 655 |     } | 
            
              | 656 | } | 
        
          | 441 |  | 657 |  | 
        
          | 442 | sub create_tmpl { | 658 | sub create_tmpl { | 
        
          | 443 |     my ($self, $files) = @_; | 659 |     my ($self, $files) = @_; | 
  
    | Lines 723-728
          sub install {
      
      
        Link Here | 
        
          | 723 |     $self->install_prefs(); | 939 |     $self->install_prefs(); | 
        
          | 724 |     $self->install_messages(); | 940 |     $self->install_messages(); | 
        
          | 725 |     $self->remove_pot(); | 941 |     $self->remove_pot(); | 
            
              |  |  | 942 |     $self->install_installer(); | 
        
          | 726 | } | 943 | } | 
        
          | 727 |  | 944 |  | 
        
          | 728 |  | 945 |  | 
  
    | Lines 743-748
          sub update {
      
      
        Link Here | 
        
          | 743 |         $self->update_tmpl($files) unless $self->{pref_only}; | 960 |         $self->update_tmpl($files) unless $self->{pref_only}; | 
        
          | 744 |         $self->update_prefs(); | 961 |         $self->update_prefs(); | 
        
          | 745 |         $self->update_messages(); | 962 |         $self->update_messages(); | 
            
              |  |  | 963 |         $self->update_installer(); | 
        
          | 746 |     } | 964 |     } | 
        
          | 747 |     $self->remove_pot(); | 965 |     $self->remove_pot(); | 
        
          | 748 | } | 966 | } | 
  
    | Lines 755-760
          sub create {
      
      
        Link Here | 
        
          | 755 |     $self->create_prefs(); | 973 |     $self->create_prefs(); | 
        
          | 756 |     $self->create_messages(); | 974 |     $self->create_messages(); | 
        
          | 757 |     $self->remove_pot(); | 975 |     $self->remove_pot(); | 
            
              |  |  | 976 |     $self->create_installer(); | 
        
          | 758 | } | 977 | } | 
        
          | 759 |  | 978 |  | 
        
          | 760 |  | 979 |  | 
            
              | 761 | -  |  |  |