Attachment #99396 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;


$YAML::Syck::ImplicitTyping = 1;



    $self->{msgmerge}        = `which msgmerge`;
    $self->{msgfmt}          = `which msgfmt`;
    $self->{msginit}         = `which msginit`;
    $self->{msgattrib}       = `which msgattrib`;
    $self->{xgettext}        = `which xgettext`;
    $self->{sed}             = `which sed`;
    $self->{po2json}         = "$Bin/po2json";

    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->{'tables'} };
            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 @multiline = @{ $table->{$table_name}->{'multiline'} };      # to check multiline values
                my $rowc;
                for my $row ( @rows ) {                                         # each row
                    $rowc++;
                    for my $field ( @translatable ) {                           # each field
                        if ( @multiline and grep { $_ eq $field } @multiline ) {    # multiline fields, only notices ATM
                            my $mulc;
                            foreach my $line ( @{$row->{$field}} ) {
                                $mulc++;
                                next if ( $line =~ /^(\s*<.*?>\s*$|^\s*\[.*?\]\s*|\s*)$/ );                     # discard pure html, TT, empty
                                $line =~ s/(<<.*?>>|\[\%.*?\%\]|<.*?>)/\%s/g;                                   # put placeholders
                                next if ( $line =~ /^(\s|%s|-|[[:punct:]]|\(|\))*$/ or length($line) < 2 );     # discard non strings
                                if ( not $po->{ $line } ) {
                                    my $msg = new Locale::PO(
                                                -msgid => $line, -msgstr => '',
                                                -reference => "$dir/$file:$table_name:$tablec:row:$rowc:mul:$mulc" );
                                    $po->{ $line } = $msg;
                                }
                            }
                        } else {
                            if ( length($row->{$field}) > 1                         # discard small strings
                                 and 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;
                            }
                        }
                    }
                }
            }
            my $desccount;
            for my $description ( @{ $yaml->{'description'} } ) {
                $desccount++;
                if ( length($description) > 1 and not $po->{ $description } ) {
                    my $msg = new Locale::PO(
                                -msgid => $description, -msgstr => '',
                                -reference => "$dir/$file:description:$desccount" );
                    $po->{ $description } = $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 ) {
        return unless ( -e $self->po_filename( $target->{suffix} ) );
        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, ":encoding(UTF-8)" );
            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 );

    # translate fields in table rows
    my @tables = @{ $dstyml->{'tables'} };
    for my $table ( @tables ) {                                                         # each table
        my $table_name = ( keys %$table )[0];
        my @translatable = @{ $table->{$table_name}->{translatable} };
        my @rows = @{ $table->{$table_name}->{rows} };
        my @multiline = @{ $table->{$table_name}->{'multiline'} };                      # to check multiline values
        for my $row ( @rows ) {                                                         # each row
            for my $field ( @translatable ) {                                           # each translatable field
                if ( @multiline and grep { $_ eq $field } @multiline ) {                # multiline fields, only notices ATM
                    foreach my $line ( @{$row->{$field}} ) {
                        next if ( $line =~ /^(\s*<.*?>\s*$|^\s*\[.*?\]\s*|\s*)$/ );     # discard pure html, TT, empty
                        my @ttvar;
                        while ( $line =~ s/(<<.*?>>|\[\%.*?\%\]|<.*?>)/\%s/ ) {         # put placeholders, save matches
                            my $var = $1;
                            push @ttvar, $var;
                        }

                        if ( $line =~ /^(\s|%s|-|[[:punct:]]|\(|\))*$/ ) {              # ignore non strings
                            while ( @ttvar ) {                                          # restore placeholders
                                my $var = shift @ttvar;
                                $line =~ s/\%s/$var/;
                            }
                            next;
                        } else {
                            my $po = $po_ref->{"\"$line\""};                            # quoted key
                            if ( $po  and not defined( $po->fuzzy() )                   # not fuzzy
                                      and length( $po->msgid() ) > 2                    # not empty msgid
                                      and length( $po->msgstr() ) > 2 ) {               # not empty msgstr
                                $line = $po->dequote( $po->msgstr() );
                            }
                            while ( @ttvar ) {                                          # restore placeholders
                                my $var = shift @ttvar;
                                $line =~ s/\%s/$var/;
                            }
                        }
                    }
                } else {
                    my $po = $po_ref->{"\"$row->{$field}\""};                           # quoted key
                    if ( $po  and not defined( $po->fuzzy() )                           # not fuzzy
                              and length( $po->msgid() ) > 2                            # not empty msgid
                              and length( $po->msgstr() ) > 2 ) {                       # not empty msgstr
                        $row->{$field} = $po->dequote( $po->msgstr() );
                    }
                }
            }
        }
    }

    # translate descriptions
    for my $description ( @{ $dstyml->{'description'} } ) {
        my $po = $po_ref->{"\"$description\""};
        if ( $po  and not defined( $po->fuzzy() )
                  and length( $po->msgid() ) > 2
                  and length( $po->msgstr() ) > 2 ) {
            $description = $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 "$self->{lang} installer 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} } ) {
        return unless ( -e $self->po_filename( $target->{suffix} ) );
        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-39 use Modern::Perl; Link Here

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