Attachment #96540 for bug #24262

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




use C4::Context;
# WARNING: Any other tested YAML library fails to work properly in this
# script content
use YAML::Syck qw( Dump LoadFile DumpFile );
use Locale::PO;
use FindBin qw( $Bin );
use File::Basename;
use File::Find;
use File::Path qw( make_path );
use File::Copy;
use File::Slurp;
use File::Spec;
use File::Temp qw( tempdir tempfile );
use Template::Parser;
use PPI;


    $self->{msgmerge}        = `which msgmerge`;
    $self->{msgfmt}          = `which msgfmt`;
    $self->{msginit}         = `which msginit`;
    $self->{msgattrib}       = `which msgattrib`;
    $self->{xgettext}        = `which xgettext`;
    $self->{sed}             = `which sed`;
    chomp $self->{cp};
    chomp $self->{msgmerge};
    chomp $self->{msgfmt};
    chomp $self->{msginit};
    chomp $self->{msgattrib};
    chomp $self->{xgettext};
    chomp $self->{sed};


        };
    }

    # EN YAML installer files
    push @{$self->{installer}}, {
        name   => "YAML installer files",
        dirs   => [ 'installer/data/mysql/en/mandatory',
                    'installer/data/mysql/en/optional'],
        suffix => "-installer.po",
    };

    # EN MARC21 YAML installer files
    push @{$self->{installer}}, {
        name   => "MARC21 YAML installer files",
        dirs   => [ 'installer/data/mysql/en/marcflavour/marc21/mandatory',
                    'installer/data/mysql/en/marcflavour/marc21/optional'],
        suffix => "-installer-MARC21.po",
    };

    # EN UNIMARC YAML installer files
    push @{$self->{installer}}, {
        name   => "UNIMARC YAML installer files",
        dirs   => [ 'installer/data/mysql/en/marcflavour/unimarc/mandatory', ],
        suffix => "-installer-UNIMARC.po",
    };

    bless $self, $class;
}


sub po_filename {
    my $self   = shift;
    my $suffix = shift;

    my $context    = C4::Context->new;
    my $trans_path = $Bin . '/po';
    my $trans_file = "$trans_path/" . $self->{lang} . $suffix;
    return $trans_file;
}


    $po->{''} ||= $default_pref_po_header;

    # Write .po entries into a file put in Koha standard po directory
    Locale::PO->save_file_fromhash( $self->po_filename("-pref.po"), $po );
    say "Saved in file: ", $self->po_filename("-pref.po") if $self->{verbose};
}



    my $po_current = $self->{po};

    # Get po from previous generation
    my $po_previous = Locale::PO->load_file_ashash( $self->po_filename("-pref.po") );

    for my $id ( keys %$po_current ) {
        my $po =  $po_previous->{Locale::PO->quote($id)};

sub create_prefs {
    my $self = shift;

    if ( -e $self->po_filename("-pref.po") ) {
        say "Preferences .po file already exists. Delete it if you want to recreate it.";
        return;
    }

    $self->save_po();
}

sub get_po_from_target {
    my $self   = shift;
    my $target = shift;

    my $po;
    my $po_head = new Locale::PO;
    $po_head->{msgid}  = "\"\"";
    $po_head->{msgstr} = "".
        "Project-Id-Version: Koha Project - Installation files\\n" .
        "PO-Revision-Date: YEAR-MO-DA HO:MI +ZONE\\n" .
        "Last-Translator: FULL NAME <EMAIL\@ADDRESS>\\n" .
        "Language-Team: Koha Translation Team\\n" .
        "Language: ".$self->{lang}."\\n" .
        "MIME-Version: 1.0\\n" .
        "Content-Type: text/plain; charset=UTF-8\\n" .
        "Content-Transfer-Encoding: 8bit\\n";

    my @dirs = @{ $target->{dirs} };
    my $intradir = $self->{context}->config('intranetdir');
    for my $dir ( @dirs ) {                                                     # each dir
        opendir( my $dh, "$intradir/$dir" ) or die ("Can't open $intradir/$dir");
        my @filelist = grep { $_ =~ m/\.yml/ } readdir($dh);                    # Just yaml files
        close($dh);
        for my $file ( @filelist ) {                                            # each file
            my $yaml   = LoadFile( "$intradir/$dir/$file" );
            my @tables = @{ $yaml };
            my $tablec;
            for my $table ( @tables ) {                                         # each table
                $tablec++;
                my $table_name = ( keys %$table )[0];
                my @translatable = @{ $table->{$table_name}->{translatable} };
                my @rows = @{ $table->{$table_name}->{rows} };
                my $rowc;
                for my $row ( @rows ) {                                         # each row
                    $rowc++;
                    for my $field ( @translatable ) {                           # each field
                        if ( not $po->{ $row->{$field} } ) {
                            my $msg = new Locale::PO(
                                        -msgid => $row->{$field}, -msgstr => '',
                                        -reference => "$dir/$file:$table_name:$tablec:row:$rowc" );
                            $po->{ $row->{$field} } = $msg;
                        }
                    }
                }
            }
        }
    }
    $po->{''} = $po_head if ( $po );

    return $po;
}

sub create_installer {
    my $self = shift;
    return unless ( $self->{installer} );

    say "Create installer translation files\n" if $self->{verbose};

    my @targets = @{ $self->{installer} };             # each installer target (common,marc21,unimarc)

    for my $target ( @targets ) {
        if ( -e $self->po_filename( $target->{suffix} ) ) {
            say "$self->{lang}$target->{suffix} file already exists. Delete it if you want to recreate it.";
            return;
        }
    }

    for my $target ( @targets ) {
        my $po = get_po_from_target( $self, $target );
        # create output file only if there is something to write
        if ( $po ) {
            my $po_file = $self->po_filename( $target->{suffix} );
            Locale::PO->save_file_fromhash( $po_file, $po );
            say "Saved in file: ", $po_file if $self->{verbose};
        }
    }
}

sub update_installer {
    my $self = shift;
    return unless ( $self->{installer} );

    say "Update installer translation files\n" if $self->{verbose};

    my @targets = @{ $self->{installer} };             # each installer target (common,marc21,unimarc)

    for my $target ( @targets ) {
        my $po = get_po_from_target( $self, $target );
        # update file only if there is something to update
        if ( $po ) {
            my ( $fh, $po_temp ) = tempfile();
            binmode( $fh, ":utf8" );
            Locale::PO->save_file_fromhash( $po_temp, $po );
            my $po_file = $self->po_filename( $target->{suffix} );
            eval {
                my $st = system($self->{msgmerge}." ".($self->{verbose}?'':'-q').
                         " -s $po_file $po_temp -o - | ".$self->{msgattrib}." --no-obsolete -o $po_file");
            };
            say "Updated file: ", $po_file if $self->{verbose};
        }
    }
}

sub translate_yaml {
    my $self   = shift;
    my $target = shift;
    my $srcyml = shift;

    my $po_file = $self->po_filename( $target->{suffix} );
    return $srcyml unless ( -e $po_file );

    my $po_ref  = Locale::PO->load_file_ashash( $po_file );

    my $dstyml   = LoadFile( $srcyml );
    my @tables = @{ $dstyml };
    for my $table ( @tables ) {                                                         # each table
        my $table_name = ( keys %$table )[0];
        my @translatable = @{ $table->{$table_name}->{translatable} };
        my @rows = @{ $table->{$table_name}->{rows} };
        for my $row ( @rows ) {                                                         # each row
            for my $field ( @translatable ) {                                           # each translatable field
                my $po = $po_ref->{"\"$row->{$field}\""};                               # quoted key
                if ( $po  and not defined( $po->fuzzy() )                               # not fuzzy
                          and length( $po->msgstr() ) > 2 ) {                           # not empty
                    $row->{$field} = $po->dequote( $po->msgstr() );
                }
            }
        }
    }

    return $dstyml;
}

sub install_installer {
    my $self = shift;
    return unless ( $self->{installer} );

    my $intradir  = $self->{context}->config('intranetdir');
    my $db_scheme = $self->{context}->config('db_scheme');
    my $langdir  = "$intradir/installer/data/$db_scheme/$self->{lang}";
    if ( -d $langdir ) {
        say "Installer language dir $langdir already exists.\nDelete it if you want to recreate it.";
        return;
    }

    say "Install installer files\n" if $self->{verbose};

    for my $target ( @{ $self->{installer} } ) {
        for my $dir ( @{ $target->{dirs} } ) {
            ( my $tdir = "$dir" ) =~ s|/en/|/$self->{lang}/|;
            make_path("$intradir/$tdir");

            opendir( my $dh, "$intradir/$dir" ) or die ("Can't open $intradir/$dir");
            my @files = grep { ! /^\.+$/ } readdir($dh);
            close($dh);

            for my $file ( @files ) {
                if ( $file =~ /yml$/ ) {
                    my $translated_yaml = translate_yaml( $self, $target, "$intradir/$dir/$file" );
                    open(my $fh, ">:encoding(UTF-8)", "$intradir/$tdir/$file");
                    DumpFile( $fh, $translated_yaml );
                    close($fh);
                } else {
                    File::Copy::copy( "$intradir/$dir/$file", "$intradir/$tdir/$file" );
                }
            }
        }
    }
}

sub create_tmpl {
    my ($self, $files) = @_;

    $self->install_prefs();
    $self->install_messages();
    $self->remove_pot();
    $self->install_installer();
}



        $self->update_tmpl($files) unless $self->{pref_only};
        $self->update_prefs();
        $self->update_messages();
        $self->update_installer();
    }
    $self->remove_pot();
}

    $self->create_prefs();
    $self->create_messages();
    $self->remove_pot();
    $self->create_installer();
}


- 

Return to bug 24262

Lines 22-36 use Modern::Perl; Link Here

(-)a/misc/translator/LangInstaller.pm (-9 / +207 lines)
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	-