View | Details | Raw Unified | Return to bug 24262
Collapse All | Expand All

(-)a/misc/translator/LangInstaller.pm (-9 / +282 lines)
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 @multiline = @{ $table->{$table_name}->{'multiline'} };      # to check multiline values
502
                my $rowc;
503
                for my $row ( @rows ) {                                         # each row
504
                    $rowc++;
505
                    for my $field ( @translatable ) {                           # each field
506
                        if ( @multiline and grep { $_ eq $field } @multiline ) {    # multiline fields, only notices ATM
507
                            my $mulc;
508
                            foreach my $line ( @{$row->{$field}} ) {
509
                                $mulc++;
510
                                next if ( $line =~ /^(\s*<.*?>\s*$|^\s*\[.*?\]\s*|\s*)$/ );                     # discard pure html, TT, empty
511
                                $line =~ s/(<<.*?>>|\[\%.*?\%\]|<.*?>)/\%s/g;                                   # put placeholders
512
                                next if ( $line =~ /^(\s|%s|-|[[:punct:]]|\(|\))*$/ or length($line) < 2 );     # discard non strings
513
                                if ( not $po->{ $line } ) {
514
                                    my $msg = new Locale::PO(
515
                                                -msgid => $line, -msgstr => '',
516
                                                -reference => "$dir/$file:$table_name:$tablec:row:$rowc:mul:$mulc" );
517
                                    $po->{ $line } = $msg;
518
                                }
519
                            }
520
                        } else {
521
                            if ( length($row->{$field}) > 1                         # discard small strings
522
                                 and not $po->{ $row->{$field} } ) {
523
                                my $msg = new Locale::PO(
524
                                            -msgid => $row->{$field}, -msgstr => '',
525
                                            -reference => "$dir/$file:$table_name:$tablec:row:$rowc" );
526
                                $po->{ $row->{$field} } = $msg;
527
                            }
528
                        }
529
                    }
530
                }
531
            }
532
            my $desccount;
533
            for my $description ( @{ $yaml->{'description'} } ) {
534
                $desccount++;
535
                if ( length($description) > 1 and not $po->{ $description } ) {
536
                    my $msg = new Locale::PO(
537
                                -msgid => $description, -msgstr => '',
538
                                -reference => "$dir/$file:description:$desccount" );
539
                    $po->{ $description } = $msg;
540
                }
541
            }
542
        }
543
    }
544
    $po->{''} = $po_head if ( $po );
545
546
    return $po;
547
}
548
549
sub create_installer {
550
    my $self = shift;
551
    return unless ( $self->{installer} );
552
553
    say "Create installer translation files\n" if $self->{verbose};
554
555
    my @targets = @{ $self->{installer} };             # each installer target (common,marc21,unimarc)
556
557
    for my $target ( @targets ) {
558
        if ( -e $self->po_filename( $target->{suffix} ) ) {
559
            say "$self->{lang}$target->{suffix} file already exists. Delete it if you want to recreate it.";
560
            return;
561
        }
562
    }
563
564
    for my $target ( @targets ) {
565
        my $po = get_po_from_target( $self, $target );
566
        # create output file only if there is something to write
567
        if ( $po ) {
568
            my $po_file = $self->po_filename( $target->{suffix} );
569
            Locale::PO->save_file_fromhash( $po_file, $po );
570
            say "Saved in file: ", $po_file if $self->{verbose};
571
        }
572
    }
573
}
574
575
sub update_installer {
576
    my $self = shift;
577
    return unless ( $self->{installer} );
578
579
    say "Update installer translation files\n" if $self->{verbose};
580
581
    my @targets = @{ $self->{installer} };             # each installer target (common,marc21,unimarc)
582
583
    for my $target ( @targets ) {
584
        return unless ( -e $self->po_filename( $target->{suffix} ) );
585
        my $po = get_po_from_target( $self, $target );
586
        # update file only if there is something to update
587
        if ( $po ) {
588
            my ( $fh, $po_temp ) = tempfile();
589
            binmode( $fh, ":encoding(UTF-8)" );
590
            Locale::PO->save_file_fromhash( $po_temp, $po );
591
            my $po_file = $self->po_filename( $target->{suffix} );
592
            eval {
593
                my $st = system($self->{msgmerge}." ".($self->{verbose}?'':'-q').
594
                         " -s $po_file $po_temp -o - | ".$self->{msgattrib}." --no-obsolete -o $po_file");
595
            };
596
            say "Updated file: ", $po_file if $self->{verbose};
597
        }
598
    }
599
}
600
601
sub translate_yaml {
602
    my $self   = shift;
603
    my $target = shift;
604
    my $srcyml = shift;
605
606
    my $po_file = $self->po_filename( $target->{suffix} );
607
    return $srcyml unless ( -e $po_file );
608
609
    my $po_ref  = Locale::PO->load_file_ashash( $po_file );
610
611
    my $dstyml   = LoadFile( $srcyml );
612
613
    # translate fields in table rows
614
    my @tables = @{ $dstyml->{'tables'} };
615
    for my $table ( @tables ) {                                                         # each table
616
        my $table_name = ( keys %$table )[0];
617
        my @translatable = @{ $table->{$table_name}->{translatable} };
618
        my @rows = @{ $table->{$table_name}->{rows} };
619
        my @multiline = @{ $table->{$table_name}->{'multiline'} };                      # to check multiline values
620
        for my $row ( @rows ) {                                                         # each row
621
            for my $field ( @translatable ) {                                           # each translatable field
622
                if ( @multiline and grep { $_ eq $field } @multiline ) {                # multiline fields, only notices ATM
623
                    foreach my $line ( @{$row->{$field}} ) {
624
                        next if ( $line =~ /^(\s*<.*?>\s*$|^\s*\[.*?\]\s*|\s*)$/ );     # discard pure html, TT, empty
625
                        my @ttvar;
626
                        while ( $line =~ s/(<<.*?>>|\[\%.*?\%\]|<.*?>)/\%s/ ) {         # put placeholders, save matches
627
                            my $var = $1;
628
                            push @ttvar, $var;
629
                        }
630
631
                        if ( $line =~ /^(\s|%s|-|[[:punct:]]|\(|\))*$/ ) {              # ignore non strings
632
                            while ( @ttvar ) {                                          # restore placeholders
633
                                my $var = shift @ttvar;
634
                                $line =~ s/\%s/$var/;
635
                            }
636
                            next;
637
                        } else {
638
                            my $po = $po_ref->{"\"$line\""};                            # quoted key
639
                            if ( $po  and not defined( $po->fuzzy() )                   # not fuzzy
640
                                      and length( $po->msgid() ) > 2                    # not empty msgid
641
                                      and length( $po->msgstr() ) > 2 ) {               # not empty msgstr
642
                                $line = $po->dequote( $po->msgstr() );
643
                            }
644
                            while ( @ttvar ) {                                          # restore placeholders
645
                                my $var = shift @ttvar;
646
                                $line =~ s/\%s/$var/;
647
                            }
648
                        }
649
                    }
650
                } else {
651
                    my $po = $po_ref->{"\"$row->{$field}\""};                           # quoted key
652
                    if ( $po  and not defined( $po->fuzzy() )                           # not fuzzy
653
                              and length( $po->msgid() ) > 2                            # not empty msgid
654
                              and length( $po->msgstr() ) > 2 ) {                       # not empty msgstr
655
                        $row->{$field} = $po->dequote( $po->msgstr() );
656
                    }
657
                }
658
            }
659
        }
660
    }
661
662
    # translate descriptions
663
    for my $description ( @{ $dstyml->{'description'} } ) {
664
        my $po = $po_ref->{"\"$description\""};
665
        if ( $po  and not defined( $po->fuzzy() )
666
                  and length( $po->msgid() ) > 2
667
                  and length( $po->msgstr() ) > 2 ) {
668
            $description = $po->dequote( $po->msgstr() );
669
        }
670
    }
671
672
    return $dstyml;
673
}
674
675
sub install_installer {
676
    my $self = shift;
677
    return unless ( $self->{installer} );
678
679
    my $intradir  = $self->{context}->config('intranetdir');
680
    my $db_scheme = $self->{context}->config('db_scheme');
681
    my $langdir  = "$intradir/installer/data/$db_scheme/$self->{lang}";
682
    if ( -d $langdir ) {
683
        say "$self->{lang} installer dir $langdir already exists.\nDelete it if you want to recreate it.";
684
        return;
685
    }
686
687
    say "Install installer files\n" if $self->{verbose};
688
689
    for my $target ( @{ $self->{installer} } ) {
690
        return unless ( -e $self->po_filename( $target->{suffix} ) );
691
        for my $dir ( @{ $target->{dirs} } ) {
692
            ( my $tdir = "$dir" ) =~ s|/en/|/$self->{lang}/|;
693
            make_path("$intradir/$tdir");
694
695
            opendir( my $dh, "$intradir/$dir" ) or die ("Can't open $intradir/$dir");
696
            my @files = grep { ! /^\.+$/ } readdir($dh);
697
            close($dh);
698
699
            for my $file ( @files ) {
700
                if ( $file =~ /yml$/ ) {
701
                    my $translated_yaml = translate_yaml( $self, $target, "$intradir/$dir/$file" );
702
                    open(my $fh, ">:encoding(UTF-8)", "$intradir/$tdir/$file");
703
                    DumpFile( $fh, $translated_yaml );
704
                    close($fh);
705
                } else {
706
                    File::Copy::copy( "$intradir/$dir/$file", "$intradir/$tdir/$file" );
707
                }
708
            }
709
        }
710
    }
711
}
441
712
442
sub create_tmpl {
713
sub create_tmpl {
443
    my ($self, $files) = @_;
714
    my ($self, $files) = @_;
Lines 723-728 sub install { Link Here
723
    $self->install_prefs();
994
    $self->install_prefs();
724
    $self->install_messages();
995
    $self->install_messages();
725
    $self->remove_pot();
996
    $self->remove_pot();
997
    $self->install_installer();
726
}
998
}
727
999
728
1000
Lines 743-748 sub update { Link Here
743
        $self->update_tmpl($files) unless $self->{pref_only};
1015
        $self->update_tmpl($files) unless $self->{pref_only};
744
        $self->update_prefs();
1016
        $self->update_prefs();
745
        $self->update_messages();
1017
        $self->update_messages();
1018
        $self->update_installer();
746
    }
1019
    }
747
    $self->remove_pot();
1020
    $self->remove_pot();
748
}
1021
}
Lines 755-760 sub create { Link Here
755
    $self->create_prefs();
1028
    $self->create_prefs();
756
    $self->create_messages();
1029
    $self->create_messages();
757
    $self->remove_pot();
1030
    $self->remove_pot();
1031
    $self->create_installer();
758
}
1032
}
759
1033
760
1034
761
- 

Return to bug 24262