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

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

Return to bug 24262