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-84 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
    $self->{po2json}         = "$Bin/po2json";
87
    $self->{po2json}         = "$Bin/po2json";
Lines 88-93 sub new { Link Here
88
    chomp $self->{msgmerge};
91
    chomp $self->{msgmerge};
89
    chomp $self->{msgfmt};
92
    chomp $self->{msgfmt};
90
    chomp $self->{msginit};
93
    chomp $self->{msginit};
94
    chomp $self->{msgattrib};
91
    chomp $self->{xgettext};
95
    chomp $self->{xgettext};
92
    chomp $self->{sed};
96
    chomp $self->{sed};
93
    chomp $self->{gzip};
97
    chomp $self->{gzip};
Lines 145-160 sub new { Link Here
145
        };
149
        };
146
    }
150
    }
147
151
152
    # EN YAML installer files
153
    push @{$self->{installer}}, {
154
        name   => "YAML installer files",
155
        dirs   => [ 'installer/data/mysql/en/mandatory',
156
                    'installer/data/mysql/en/optional'],
157
        suffix => "-installer.po",
158
    };
159
160
    # EN MARC21 YAML installer files
161
    push @{$self->{installer}}, {
162
        name   => "MARC21 YAML installer files",
163
        dirs   => [ 'installer/data/mysql/en/marcflavour/marc21/mandatory',
164
                    'installer/data/mysql/en/marcflavour/marc21/optional'],
165
        suffix => "-installer-MARC21.po",
166
    };
167
168
    # EN UNIMARC YAML installer files
169
    push @{$self->{installer}}, {
170
        name   => "UNIMARC YAML installer files",
171
        dirs   => [ 'installer/data/mysql/en/marcflavour/unimarc/mandatory', ],
172
        suffix => "-installer-UNIMARC.po",
173
    };
174
148
    bless $self, $class;
175
    bless $self, $class;
149
}
176
}
150
177
151
178
152
sub po_filename {
179
sub po_filename {
153
    my $self = shift;
180
    my $self   = shift;
181
    my $suffix = shift;
154
182
155
    my $context    = C4::Context->new;
183
    my $context    = C4::Context->new;
156
    my $trans_path = $Bin . '/po';
184
    my $trans_path = $Bin . '/po';
157
    my $trans_file = "$trans_path/" . $self->{lang} . "-pref.po";
185
    my $trans_file = "$trans_path/" . $self->{lang} . $suffix;
158
    return $trans_file;
186
    return $trans_file;
159
}
187
}
160
188
Lines 281-288 sub save_po { Link Here
281
    $po->{''} ||= $default_pref_po_header;
309
    $po->{''} ||= $default_pref_po_header;
282
310
283
    # Write .po entries into a file put in Koha standard po directory
311
    # Write .po entries into a file put in Koha standard po directory
284
    Locale::PO->save_file_fromhash( $self->po_filename, $po );
312
    Locale::PO->save_file_fromhash( $self->po_filename("-pref.po"), $po );
285
    say "Saved in file: ", $self->po_filename if $self->{verbose};
313
    say "Saved in file: ", $self->po_filename("-pref.po") if $self->{verbose};
286
}
314
}
287
315
288
316
Lines 294-300 sub get_po_merged_with_en { Link Here
294
    my $po_current = $self->{po};
322
    my $po_current = $self->{po};
295
323
296
    # Get po from previous generation
324
    # Get po from previous generation
297
    my $po_previous = Locale::PO->load_file_ashash( $self->po_filename );
325
    my $po_previous = Locale::PO->load_file_ashash( $self->po_filename("-pref.po") );
298
326
299
    for my $id ( keys %$po_current ) {
327
    for my $id ( keys %$po_current ) {
300
        my $po =  $po_previous->{Locale::PO->quote($id)};
328
        my $po =  $po_previous->{Locale::PO->quote($id)};
Lines 435-441 sub update_tmpl { Link Here
435
sub create_prefs {
463
sub create_prefs {
436
    my $self = shift;
464
    my $self = shift;
437
465
438
    if ( -e $self->po_filename ) {
466
    if ( -e $self->po_filename("-pref.po") ) {
439
        say "Preferences .po file already exists. Delete it if you want to recreate it.";
467
        say "Preferences .po file already exists. Delete it if you want to recreate it.";
440
        return;
468
        return;
441
    }
469
    }
Lines 443-448 sub create_prefs { Link Here
443
    $self->save_po();
471
    $self->save_po();
444
}
472
}
445
473
474
sub get_po_from_target {
475
    my $self   = shift;
476
    my $target = shift;
477
478
    my $po;
479
    my $po_head = new Locale::PO;
480
    $po_head->{msgid}  = "\"\"";
481
    $po_head->{msgstr} = "".
482
        "Project-Id-Version: Koha Project - Installation files\\n" .
483
        "PO-Revision-Date: YEAR-MO-DA HO:MI +ZONE\\n" .
484
        "Last-Translator: FULL NAME <EMAIL\@ADDRESS>\\n" .
485
        "Language-Team: Koha Translation Team\\n" .
486
        "Language: ".$self->{lang}."\\n" .
487
        "MIME-Version: 1.0\\n" .
488
        "Content-Type: text/plain; charset=UTF-8\\n" .
489
        "Content-Transfer-Encoding: 8bit\\n";
490
491
    my @dirs = @{ $target->{dirs} };
492
    my $intradir = $self->{context}->config('intranetdir');
493
    for my $dir ( @dirs ) {                                                     # each dir
494
        opendir( my $dh, "$intradir/$dir" ) or die ("Can't open $intradir/$dir");
495
        my @filelist = grep { $_ =~ m/\.yml/ } readdir($dh);                    # Just yaml files
496
        close($dh);
497
        for my $file ( @filelist ) {                                            # each file
498
            my $yaml   = LoadFile( "$intradir/$dir/$file" );
499
            my @tables = @{ $yaml->{'tables'} };
500
            my $tablec;
501
            for my $table ( @tables ) {                                         # each table
502
                $tablec++;
503
                my $table_name = ( keys %$table )[0];
504
                my @translatable = @{ $table->{$table_name}->{translatable} };
505
                my @rows = @{ $table->{$table_name}->{rows} };
506
                my @multiline = @{ $table->{$table_name}->{'multiline'} };      # to check multiline values
507
                my $rowc;
508
                for my $row ( @rows ) {                                         # each row
509
                    $rowc++;
510
                    for my $field ( @translatable ) {                           # each field
511
                        if ( @multiline and grep { $_ eq $field } @multiline ) {    # multiline fields, only notices ATM
512
                            my $mulc;
513
                            foreach my $line ( @{$row->{$field}} ) {
514
                                $mulc++;
515
                                next if ( $line =~ /^(\s*<.*?>\s*$|^\s*\[.*?\]\s*|\s*)$/ );                     # discard pure html, TT, empty
516
                                $line =~ s/(<<.*?>>|\[\%.*?\%\]|<.*?>)/\%s/g;                                   # put placeholders
517
                                next if ( $line =~ /^(\s|%s|-|[[:punct:]]|\(|\))*$/ or length($line) < 2 );     # discard non strings
518
                                if ( not $po->{ $line } ) {
519
                                    my $msg = new Locale::PO(
520
                                                -msgid => $line, -msgstr => '',
521
                                                -reference => "$dir/$file:$table_name:$tablec:row:$rowc:mul:$mulc" );
522
                                    $po->{ $line } = $msg;
523
                                }
524
                            }
525
                        } else {
526
                            if ( length($row->{$field}) > 1                         # discard small strings
527
                                 and not $po->{ $row->{$field} } ) {
528
                                my $msg = new Locale::PO(
529
                                            -msgid => $row->{$field}, -msgstr => '',
530
                                            -reference => "$dir/$file:$table_name:$tablec:row:$rowc" );
531
                                $po->{ $row->{$field} } = $msg;
532
                            }
533
                        }
534
                    }
535
                }
536
            }
537
            my $desccount;
538
            for my $description ( @{ $yaml->{'description'} } ) {
539
                $desccount++;
540
                if ( length($description) > 1 and not $po->{ $description } ) {
541
                    my $msg = new Locale::PO(
542
                                -msgid => $description, -msgstr => '',
543
                                -reference => "$dir/$file:description:$desccount" );
544
                    $po->{ $description } = $msg;
545
                }
546
            }
547
        }
548
    }
549
    $po->{''} = $po_head if ( $po );
550
551
    return $po;
552
}
553
554
sub create_installer {
555
    my $self = shift;
556
    return unless ( $self->{installer} );
557
558
    say "Create installer translation files\n" if $self->{verbose};
559
560
    my @targets = @{ $self->{installer} };             # each installer target (common,marc21,unimarc)
561
562
    for my $target ( @targets ) {
563
        if ( -e $self->po_filename( $target->{suffix} ) ) {
564
            say "$self->{lang}$target->{suffix} file already exists. Delete it if you want to recreate it.";
565
            return;
566
        }
567
    }
568
569
    for my $target ( @targets ) {
570
        my $po = get_po_from_target( $self, $target );
571
        # create output file only if there is something to write
572
        if ( $po ) {
573
            my $po_file = $self->po_filename( $target->{suffix} );
574
            Locale::PO->save_file_fromhash( $po_file, $po );
575
            say "Saved in file: ", $po_file if $self->{verbose};
576
        }
577
    }
578
}
579
580
sub update_installer {
581
    my $self = shift;
582
    return unless ( $self->{installer} );
583
584
    say "Update installer translation files\n" if $self->{verbose};
585
586
    my @targets = @{ $self->{installer} };             # each installer target (common,marc21,unimarc)
587
588
    for my $target ( @targets ) {
589
        return unless ( -e $self->po_filename( $target->{suffix} ) );
590
        my $po = get_po_from_target( $self, $target );
591
        # update file only if there is something to update
592
        if ( $po ) {
593
            my ( $fh, $po_temp ) = tempfile();
594
            binmode( $fh, ":encoding(UTF-8)" );
595
            Locale::PO->save_file_fromhash( $po_temp, $po );
596
            my $po_file = $self->po_filename( $target->{suffix} );
597
            eval {
598
                my $st = system($self->{msgmerge}." ".($self->{verbose}?'':'-q').
599
                         " -s $po_file $po_temp -o - | ".$self->{msgattrib}." --no-obsolete -o $po_file");
600
            };
601
            say "Updated file: ", $po_file if $self->{verbose};
602
        }
603
    }
604
}
605
606
sub translate_yaml {
607
    my $self   = shift;
608
    my $target = shift;
609
    my $srcyml = shift;
610
611
    my $po_file = $self->po_filename( $target->{suffix} );
612
    return $srcyml unless ( -e $po_file );
613
614
    my $po_ref  = Locale::PO->load_file_ashash( $po_file );
615
616
    my $dstyml   = LoadFile( $srcyml );
617
618
    # translate fields in table rows
619
    my @tables = @{ $dstyml->{'tables'} };
620
    for my $table ( @tables ) {                                                         # each table
621
        my $table_name = ( keys %$table )[0];
622
        my @translatable = @{ $table->{$table_name}->{translatable} };
623
        my @rows = @{ $table->{$table_name}->{rows} };
624
        my @multiline = @{ $table->{$table_name}->{'multiline'} };                      # to check multiline values
625
        for my $row ( @rows ) {                                                         # each row
626
            for my $field ( @translatable ) {                                           # each translatable field
627
                if ( @multiline and grep { $_ eq $field } @multiline ) {                # multiline fields, only notices ATM
628
                    foreach my $line ( @{$row->{$field}} ) {
629
                        next if ( $line =~ /^(\s*<.*?>\s*$|^\s*\[.*?\]\s*|\s*)$/ );     # discard pure html, TT, empty
630
                        my @ttvar;
631
                        while ( $line =~ s/(<<.*?>>|\[\%.*?\%\]|<.*?>)/\%s/ ) {         # put placeholders, save matches
632
                            my $var = $1;
633
                            push @ttvar, $var;
634
                        }
635
636
                        if ( $line =~ /^(\s|%s|-|[[:punct:]]|\(|\))*$/ ) {              # ignore non strings
637
                            while ( @ttvar ) {                                          # restore placeholders
638
                                my $var = shift @ttvar;
639
                                $line =~ s/\%s/$var/;
640
                            }
641
                            next;
642
                        } else {
643
                            my $po = $po_ref->{"\"$line\""};                            # quoted key
644
                            if ( $po  and not defined( $po->fuzzy() )                   # not fuzzy
645
                                      and length( $po->msgid() ) > 2                    # not empty msgid
646
                                      and length( $po->msgstr() ) > 2 ) {               # not empty msgstr
647
                                $line = $po->dequote( $po->msgstr() );
648
                            }
649
                            while ( @ttvar ) {                                          # restore placeholders
650
                                my $var = shift @ttvar;
651
                                $line =~ s/\%s/$var/;
652
                            }
653
                        }
654
                    }
655
                } else {
656
                    my $po = $po_ref->{"\"$row->{$field}\""};                           # quoted key
657
                    if ( $po  and not defined( $po->fuzzy() )                           # not fuzzy
658
                              and length( $po->msgid() ) > 2                            # not empty msgid
659
                              and length( $po->msgstr() ) > 2 ) {                       # not empty msgstr
660
                        $row->{$field} = $po->dequote( $po->msgstr() );
661
                    }
662
                }
663
            }
664
        }
665
    }
666
667
    # translate descriptions
668
    for my $description ( @{ $dstyml->{'description'} } ) {
669
        my $po = $po_ref->{"\"$description\""};
670
        if ( $po  and not defined( $po->fuzzy() )
671
                  and length( $po->msgid() ) > 2
672
                  and length( $po->msgstr() ) > 2 ) {
673
            $description = $po->dequote( $po->msgstr() );
674
        }
675
    }
676
677
    return $dstyml;
678
}
679
680
sub install_installer {
681
    my $self = shift;
682
    return unless ( $self->{installer} );
683
684
    my $intradir  = $self->{context}->config('intranetdir');
685
    my $db_scheme = $self->{context}->config('db_scheme');
686
    my $langdir  = "$intradir/installer/data/$db_scheme/$self->{lang}";
687
    if ( -d $langdir ) {
688
        say "$self->{lang} installer dir $langdir already exists.\nDelete it if you want to recreate it.";
689
        return;
690
    }
691
692
    say "Install installer files\n" if $self->{verbose};
693
694
    for my $target ( @{ $self->{installer} } ) {
695
        return unless ( -e $self->po_filename( $target->{suffix} ) );
696
        for my $dir ( @{ $target->{dirs} } ) {
697
            ( my $tdir = "$dir" ) =~ s|/en/|/$self->{lang}/|;
698
            make_path("$intradir/$tdir");
699
700
            opendir( my $dh, "$intradir/$dir" ) or die ("Can't open $intradir/$dir");
701
            my @files = grep { ! /^\.+$/ } readdir($dh);
702
            close($dh);
703
704
            for my $file ( @files ) {
705
                if ( $file =~ /yml$/ ) {
706
                    my $translated_yaml = translate_yaml( $self, $target, "$intradir/$dir/$file" );
707
                    open(my $fh, ">:encoding(UTF-8)", "$intradir/$tdir/$file");
708
                    DumpFile( $fh, $translated_yaml );
709
                    close($fh);
710
                } else {
711
                    File::Copy::copy( "$intradir/$dir/$file", "$intradir/$tdir/$file" );
712
                }
713
            }
714
        }
715
    }
716
}
446
717
447
sub create_tmpl {
718
sub create_tmpl {
448
    my ($self, $files) = @_;
719
    my ($self, $files) = @_;
Lines 806-811 sub install { Link Here
806
    $self->install_prefs();
1077
    $self->install_prefs();
807
    $self->install_messages();
1078
    $self->install_messages();
808
    $self->remove_pot();
1079
    $self->remove_pot();
1080
    $self->install_installer();
809
}
1081
}
810
1082
811
1083
Lines 827-832 sub update { Link Here
827
        $self->update_tmpl($files) unless $self->{pref_only};
1099
        $self->update_tmpl($files) unless $self->{pref_only};
828
        $self->update_prefs();
1100
        $self->update_prefs();
829
        $self->update_messages();
1101
        $self->update_messages();
1102
        $self->update_installer();
830
    }
1103
    }
831
    $self->remove_pot();
1104
    $self->remove_pot();
832
}
1105
}
Lines 839-844 sub create { Link Here
839
    $self->create_prefs();
1112
    $self->create_prefs();
840
    $self->create_messages();
1113
    $self->create_messages();
841
    $self->remove_pot();
1114
    $self->remove_pot();
1115
    $self->create_installer();
842
}
1116
}
843
1117
844
1118
845
- 

Return to bug 24262