From 25d4f705c4e034f06c5fb5a180b1c852df90221d Mon Sep 17 00:00:00 2001 From: Matt Blenkinsop Date: Thu, 25 Jul 2024 14:29:14 +0000 Subject: [PATCH] Bug 37472: Tidy LangInstaller file --- misc/translator/LangInstaller.pm | 312 ++++++++++++++++--------------- 1 file changed, 159 insertions(+), 153 deletions(-) diff --git a/misc/translator/LangInstaller.pm b/misc/translator/LangInstaller.pm index 22af173b083..9261e7e2cfe 100644 --- a/misc/translator/LangInstaller.pm +++ b/misc/translator/LangInstaller.pm @@ -20,50 +20,49 @@ package LangInstaller; use Modern::Perl; use C4::Context; + # WARNING: Any other tested YAML library fails to work properly in this # script content # FIXME Really? use YAML::XS; use Locale::PO; -use FindBin qw( $Bin ); +use FindBin qw( $Bin ); use File::Path qw( make_path ); use File::Copy; use File::Slurp qw( read_file ); -use JSON qw( decode_json encode_json ); +use JSON qw( decode_json encode_json ); use Koha::Plugins; sub set_lang { - my ($self, $lang) = @_; + my ( $self, $lang ) = @_; - $self->{lang} = $lang; - $self->{po_path_lang} = C4::Context->config('intrahtdocs') . - "/prog/$lang/modules/admin/preferences"; + $self->{lang} = $lang; + $self->{po_path_lang} = C4::Context->config('intrahtdocs') . "/prog/$lang/modules/admin/preferences"; } sub new { - my ($class, $args) = @_; + my ( $class, $args ) = @_; - my $lang = $args->{lang}; - my $pref_only = $args->{pref_only}; - my $verbose = $args->{verbose}; + my $lang = $args->{lang}; + my $pref_only = $args->{pref_only}; + my $verbose = $args->{verbose}; - my $self = { }; + my $self = {}; - $self->{path_pref_en} = C4::Context->config('intrahtdocs') . - '/prog/en/modules/admin/preferences'; + $self->{path_pref_en} = C4::Context->config('intrahtdocs') . '/prog/en/modules/admin/preferences'; set_lang( $self, $lang ) if $lang; - $self->{pref_only} = $pref_only; - $self->{verbose} = $verbose; - $self->{process} = "$Bin/tmpl_process3.pl " . ($verbose ? '' : '-q'); - $self->{path_po} = "$Bin/po"; - $self->{po} = {}; - $self->{domain} = 'Koha'; - $self->{msgfmt} = `which msgfmt`; - $self->{po2json} = "yarn run po2json"; - $self->{gzip} = `which gzip`; - $self->{gunzip} = `which gunzip`; - $self->{plugin_dirs} = _identify_translatable_plugins(); + $self->{pref_only} = $pref_only; + $self->{verbose} = $verbose; + $self->{process} = "$Bin/tmpl_process3.pl " . ( $verbose ? '' : '-q' ); + $self->{path_po} = "$Bin/po"; + $self->{po} = {}; + $self->{domain} = 'Koha'; + $self->{msgfmt} = `which msgfmt`; + $self->{po2json} = "yarn run po2json"; + $self->{gzip} = `which gzip`; + $self->{gunzip} = `which gunzip`; + $self->{plugin_dirs} = _identify_translatable_plugins(); chomp $self->{msgfmt}; chomp $self->{gzip}; chomp $self->{gunzip}; @@ -76,7 +75,7 @@ sub new { # Get all available language codes opendir $fh, $self->{path_po}; - my @langs = map { ($_) =~ /(.*)-pref/ } + my @langs = map { ($_) =~ /(.*)-pref/ } grep { $_ =~ /.*-pref/ } readdir($fh); closedir $fh; $self->{langs} = \@langs; @@ -94,7 +93,7 @@ sub new { # OPAC themes opendir my $dh, C4::Context->config('opachtdocs'); for my $theme ( grep { not /^\.|lib|xslt/ } readdir($dh) ) { - push @{$self->{interface}}, { + push @{ $self->{interface} }, { name => "OPAC $theme", dir => "$opachtdocs/$theme", suffix => "-opac-$theme.po", @@ -103,13 +102,14 @@ sub new { # MARC flavours (hardcoded list) for ( "MARC21", "UNIMARC" ) { + # search for strings on staff & opac marc files my $dirs = C4::Context->config('intrahtdocs') . '/prog'; opendir $fh, C4::Context->config('opachtdocs'); for ( grep { not /^\.|\.\.|lib$|xslt/ } readdir($fh) ) { $dirs .= ' ' . "$opachtdocs/$_"; } - push @{$self->{interface}}, { + push @{ $self->{interface} }, { name => "$_", dir => $dirs, suffix => "-marc-$_.po", @@ -117,30 +117,35 @@ sub new { } # EN YAML installer files - push @{$self->{installer}}, { - name => "YAML installer files", - dirs => [ 'installer/data/mysql/en/mandatory', - 'installer/data/mysql/en/optional'], + 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'], + 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', - 'installer/data/mysql/en/marcflavour/unimarc/optional'], + push @{ $self->{installer} }, { + name => "UNIMARC YAML installer files", + dirs => [ + 'installer/data/mysql/en/marcflavour/unimarc/mandatory', + 'installer/data/mysql/en/marcflavour/unimarc/optional' + ], suffix => "-installer-UNIMARC.po", }; - bless $self, $class; } @@ -154,12 +159,12 @@ sub po_filename { } sub get_trans_text { - my ($self, $msgid, $default) = @_; + my ( $self, $msgid, $default ) = @_; - my $po = $self->{po}->{Locale::PO->quote($msgid)}; + my $po = $self->{po}->{ Locale::PO->quote($msgid) }; if ( $po and not defined( $po->fuzzy() ) ) { - my $msgstr = Locale::PO->dequote($po->msgstr); - if ($msgstr and length($msgstr) > 0) { + my $msgstr = Locale::PO->dequote( $po->msgstr ); + if ( $msgstr and length($msgstr) > 0 ) { return $msgstr; } } @@ -168,30 +173,31 @@ sub get_trans_text { } sub get_translated_tab_content { - my ($self, $file, $tab_content) = @_; + my ( $self, $file, $tab_content ) = @_; if ( ref($tab_content) eq 'ARRAY' ) { - return $self->get_translated_prefs($file, $tab_content); + return $self->get_translated_prefs( $file, $tab_content ); } my $translated_tab_content = { map { - my $section = $_; + my $section = $_; my $sysprefs = $tab_content->{$section}; - my $msgid = sprintf('%s %s', $file, $section); + my $msgid = sprintf( '%s %s', $file, $section ); - $self->get_trans_text($msgid, $section) => $self->get_translated_prefs($file, $sysprefs); + $self->get_trans_text( $msgid, $section ) => $self->get_translated_prefs( $file, $sysprefs ); } keys %$tab_content }; if ( keys %$translated_tab_content != keys %$tab_content ) { my %duplicates; - for my $section (keys %$tab_content) { - push @{$duplicates{$self->get_trans_text("$file $section", $section)}}, $section; + for my $section ( keys %$tab_content ) { + push @{ $duplicates{ $self->get_trans_text( "$file $section", $section ) } }, $section; } - for my $translation (keys %duplicates) { - if (@{$duplicates{$translation}} > 1) { - warn qq(In file "$file", "$translation" is a translation for sections ") . join('", "', @{$duplicates{$translation}}) . '"'; + for my $translation ( keys %duplicates ) { + if ( @{ $duplicates{$translation} } > 1 ) { + warn qq(In file "$file", "$translation" is a translation for sections ") + . join( '", "', @{ $duplicates{$translation} } ) . '"'; } } } @@ -200,18 +206,14 @@ sub get_translated_tab_content { } sub get_translated_prefs { - my ($self, $file, $sysprefs) = @_; + my ( $self, $file, $sysprefs ) = @_; my $translated_prefs = [ map { my ($pref_elt) = grep { ref($_) eq 'HASH' && exists $_->{pref} } @$_; my $pref_name = $pref_elt ? $pref_elt->{pref} : ''; - my $translated_syspref = [ - map { - $self->get_translated_pref($file, $pref_name, $_); - } @$_ - ]; + my $translated_syspref = [ map { $self->get_translated_pref( $file, $pref_name, $_ ); } @$_ ]; $translated_syspref; } @$sysprefs @@ -221,27 +223,27 @@ sub get_translated_prefs { } sub get_translated_pref { - my ($self, $file, $pref_name, $syspref) = @_; + my ( $self, $file, $pref_name, $syspref ) = @_; - unless (ref($syspref)) { + unless ( ref($syspref) ) { $syspref //= ''; - my $msgid = sprintf('%s#%s# %s', $file, $pref_name, $syspref); - return $self->get_trans_text($msgid, $syspref); + my $msgid = sprintf( '%s#%s# %s', $file, $pref_name, $syspref ); + return $self->get_trans_text( $msgid, $syspref ); } my $translated_pref = { map { - my $key = $_; + my $key = $_; my $value = $syspref->{$key}; my $translated_value = $value; - if (($key eq 'choices' || $key eq 'multiple') && ref($value) eq 'HASH') { + if ( ( $key eq 'choices' || $key eq 'multiple' ) && ref($value) eq 'HASH' ) { $translated_value = { map { - my $msgid = sprintf('%s#%s# %s', $file, $pref_name, $value->{$_}); - $_ => $self->get_trans_text($msgid, $value->{$_}) + my $msgid = sprintf( '%s#%s# %s', $file, $pref_name, $value->{$_} ); + $_ => $self->get_trans_text( $msgid, $value->{$_} ) } keys %$value - } + }; } $key => $translated_value @@ -259,46 +261,46 @@ sub install_prefs { exit; } - $self->{po} = Locale::PO->load_file_ashash($self->po_filename("-pref.po"), 'utf8'); + $self->{po} = Locale::PO->load_file_ashash( $self->po_filename("-pref.po"), 'utf8' ); - for my $file ( @{$self->{pref_files}} ) { + for my $file ( @{ $self->{pref_files} } ) { my $pref = YAML::XS::LoadFile( $self->{path_pref_en} . "/$file" ); my $translated_pref = { map { - my $tab = $_; + my $tab = $_; my $tab_content = $pref->{$tab}; - $self->get_trans_text($file, $tab) => $self->get_translated_tab_content($file, $tab_content); + $self->get_trans_text( $file, $tab ) => $self->get_translated_tab_content( $file, $tab_content ); } keys %$pref }; if ( keys %$translated_pref != keys %$pref ) { my %duplicates; - for my $tab (keys %$pref) { - push @{$duplicates{$self->get_trans_text($file, $tab)}}, $tab; + for my $tab ( keys %$pref ) { + push @{ $duplicates{ $self->get_trans_text( $file, $tab ) } }, $tab; } - for my $translation (keys %duplicates) { - if (@{$duplicates{$translation}} > 1) { - warn qq(In file "$file", "$translation" is a translation for tabs ") . join('", "', @{$duplicates{$translation}}) . '"'; + for my $translation ( keys %duplicates ) { + if ( @{ $duplicates{$translation} } > 1 ) { + warn qq(In file "$file", "$translation" is a translation for tabs ") + . join( '", "', @{ $duplicates{$translation} } ) . '"'; } } } my $file_trans = $self->{po_path_lang} . "/$file"; print "Write $file\n" if $self->{verbose}; - YAML::XS::DumpFile($file_trans, $translated_pref); + YAML::XS::DumpFile( $file_trans, $translated_pref ); } } - sub install_tmpl { - my ($self, $files) = @_; + my ( $self, $files ) = @_; say "Install templates" if $self->{verbose}; - for my $trans ( @{$self->{interface}} ) { - my @t_dirs = split(" ", $trans->{dir}); - for my $t_dir ( @t_dirs ) { - my @files = @$files; + for my $trans ( @{ $self->{interface} } ) { + my @t_dirs = split( " ", $trans->{dir} ); + for my $t_dir (@t_dirs) { + my @files = @$files; my @nomarc = (); print " Install templates '$trans->{name}'\n", @@ -311,19 +313,19 @@ sub install_tmpl { my $lang_dir = "$t_dir/$self->{lang}"; $lang_dir =~ s|/en/|/$self->{lang}/|; mkdir $lang_dir unless -d $lang_dir; + # if installing MARC po file, only touch corresponding files - my $marc = ( $trans->{name} =~ /MARC/ )?"-m \"$trans->{name}\"":""; # for MARC translations - # if not installing MARC po file, ignore all MARC files - @nomarc = ( 'marc21', 'unimarc' ) if ( $trans->{name} !~ /MARC/ ); # hardcoded MARC variants - - system - "$self->{process} install " . - "-i $trans_dir " . - "-o $lang_dir ". - "-s $self->{path_po}/$self->{lang}$trans->{suffix} -r " . - "$marc " . - ( @files ? ' -f ' . join ' -f ', @files : '') . - ( @nomarc ? ' -n ' . join ' -n ', @nomarc : ''); + my $marc = ( $trans->{name} =~ /MARC/ ) ? "-m \"$trans->{name}\"" : ""; # for MARC translations + # if not installing MARC po file, ignore all MARC files + @nomarc = ( 'marc21', 'unimarc' ) if ( $trans->{name} !~ /MARC/ ); # hardcoded MARC variants + + system "$self->{process} install " + . "-i $trans_dir " + . "-o $lang_dir " + . "-s $self->{path_po}/$self->{lang}$trans->{suffix} -r " + . "$marc " + . ( @files ? ' -f ' . join ' -f ', @files : '' ) + . ( @nomarc ? ' -n ' . join ' -n ', @nomarc : '' ); } } @@ -353,52 +355,58 @@ sub translate_yaml { my $po_file = $self->po_filename( $target->{suffix} ); return $srcyml unless ( -e $po_file ); - my $po_ref = Locale::PO->load_file_ashash( $po_file, 'utf8' ); + my $po_ref = Locale::PO->load_file_ashash( $po_file, 'utf8' ); - my $dstyml = YAML::XS::LoadFile( $srcyml ); + my $dstyml = YAML::XS::LoadFile($srcyml); # translate fields in table rows my @tables = @{ $dstyml->{'tables'} }; - for my $table ( @tables ) { # each table - my $table_name = ( keys %$table )[0]; + 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}} ) { + 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} } ) { my @ttvar; - while ( $line =~ s/(<<.*?>>|\[\%.*?\%\]|<.*?>)/\%s/ ) { # put placeholders, save matches + 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 + 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 + 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 + while (@ttvar) { # restore placeholders my $var = shift @ttvar; $line =~ s/\%s/$var/; } } } } else { - next unless defined $row->{$field}; # next if null value - 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 + next unless defined $row->{$field}; # next if null value + 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() ); } } @@ -409,9 +417,11 @@ sub translate_yaml { # 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 ) { + if ( $po + and not defined( $po->fuzzy() ) + and length( $po->msgid() ) > 2 + and length( $po->msgstr() ) > 2 ) + { $description = $po->dequote( $po->msgstr() ); } } @@ -425,7 +435,7 @@ sub install_installer { my $intradir = C4::Context->config('intranetdir'); my $db_scheme = C4::Context->config('db_scheme'); - my $langdir = "$intradir/installer/data/$db_scheme/$self->{lang}"; + my $langdir = "$intradir/installer/data/$db_scheme/$self->{lang}"; say "Install installer files\n" if $self->{verbose}; @@ -435,11 +445,11 @@ sub install_installer { ( 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); + opendir( my $dh, "$intradir/$dir" ) or die("Can't open $intradir/$dir"); + my @files = grep { !/^\.+$/ } readdir($dh); close($dh); - for my $file ( @files ) { + for my $file (@files) { if ( $file =~ /yml$/ ) { my $translated_yaml = translate_yaml( $self, $target, "$intradir/$dir/$file" ); YAML::XS::DumpFile( "$intradir/$tdir/$file", $translated_yaml ); @@ -454,10 +464,10 @@ sub install_installer { sub locale_name { my $self = shift; - my ($language, $region, $country) = split /-/, $self->{lang}; + my ( $language, $region, $country ) = split /-/, $self->{lang}; $country //= $region; my $locale = $language; - if ($country && length($country) == 2) { + if ( $country && length($country) == 2 ) { $locale .= '_' . $country; } @@ -467,10 +477,10 @@ sub locale_name { sub install_messages { my ($self) = @_; - my $locale = $self->locale_name(); - my $modir = "$self->{path_po}/$locale/LC_MESSAGES"; - my $pofile = "$self->{path_po}/$self->{lang}-messages.po"; - my $mofile = "$modir/$self->{domain}.mo"; + my $locale = $self->locale_name(); + my $modir = "$self->{path_po}/$locale/LC_MESSAGES"; + my $pofile = "$self->{path_po}/$self->{lang}-messages.po"; + my $mofile = "$modir/$self->{domain}.mo"; my $js_pofile = "$self->{path_po}/$self->{lang}-messages-js.po"; unless ( -f $pofile && -f $js_pofile ) { @@ -481,7 +491,7 @@ sub install_messages { make_path($modir); system "$self->{msgfmt} -o $mofile $pofile"; - my $tmp_po = sprintf '/tmp/%s-messages.po', $self->{lang}; + my $tmp_po = sprintf '/tmp/%s-messages.po', $self->{lang}; my $po2json_cmd = sprintf '%s %s %s', $self->{po2json}, $js_pofile, $tmp_po; `$po2json_cmd`; my $json = read_file($tmp_po); @@ -508,14 +518,14 @@ sub install_messages { my $combined_json = encode_json($js_po_data); my $js_locale_data = sprintf 'var json_locale_data = {"Koha":%s};', $combined_json; - my $progdir = C4::Context->config('intrahtdocs') . '/prog'; + my $progdir = C4::Context->config('intrahtdocs') . '/prog'; mkdir "$progdir/$self->{lang}/js"; open my $fh, '>', "$progdir/$self->{lang}/js/locale_data.js"; print $fh $js_locale_data; close $fh; my $opachtdocs = C4::Context->config('opachtdocs'); - opendir(my $dh, $opachtdocs); + opendir( my $dh, $opachtdocs ); for my $theme ( grep { not /^\.|lib|xslt/ } readdir($dh) ) { mkdir "$opachtdocs/$theme/$self->{lang}/js"; open my $fh, '>', "$opachtdocs/$theme/$self->{lang}/js/locale_data.js"; @@ -525,13 +535,13 @@ sub install_messages { } sub compress { - my ($self, $files) = @_; - my @langs = $self->{lang} ? ($self->{lang}) : $self->get_all_langs(); - for my $lang ( @langs ) { - $self->set_lang( $lang ); + my ( $self, $files ) = @_; + my @langs = $self->{lang} ? ( $self->{lang} ) : $self->get_all_langs(); + for my $lang (@langs) { + $self->set_lang($lang); opendir( my $dh, $self->{path_po} ); my @files = grep { $_ =~ /^$self->{lang}.*po$/ } readdir $dh; - foreach my $file ( @files ) { + foreach my $file (@files) { say "Compress file $file" if $self->{verbose}; system "$self->{gzip} -9 $self->{path_po}/$file"; } @@ -539,13 +549,13 @@ sub compress { } sub uncompress { - my ($self, $files) = @_; - my @langs = $self->{lang} ? ($self->{lang}) : $self->get_all_langs(); - for my $lang ( @langs ) { + my ( $self, $files ) = @_; + my @langs = $self->{lang} ? ( $self->{lang} ) : $self->get_all_langs(); + for my $lang (@langs) { opendir( my $dh, $self->{path_po} ); - $self->set_lang( $lang ); + $self->set_lang($lang); my @files = grep { $_ =~ /^$self->{lang}.*po.gz$/ } readdir $dh; - foreach my $file ( @files ) { + foreach my $file (@files) { say "Uncompress file $file" if $self->{verbose}; system "$self->{gunzip} $self->{path_po}/$file"; } @@ -553,11 +563,11 @@ sub uncompress { } sub install { - my ($self, $files) = @_; + my ( $self, $files ) = @_; return unless $self->{lang}; $self->uncompress(); - if ($self->{pref_only}) { + if ( $self->{pref_only} ) { $self->install_prefs(); } else { $self->install_tmpl($files); @@ -567,12 +577,10 @@ sub install { } } - sub get_all_langs { my $self = shift; opendir( my $dh, $self->{path_po} ); - my @files = grep { $_ =~ /-pref.(po|po.gz)$/ } - readdir $dh; + my @files = grep { $_ =~ /-pref.(po|po.gz)$/ } readdir $dh; @files = map { $_ =~ s/-pref.(po|po.gz)$//r } @files; } @@ -602,10 +610,8 @@ sub _identify_translatable_plugins { return \@plugin_dirs; } - 1; - =head1 NAME LangInstaller.pm - Handle templates and preferences translation -- 2.39.3 (Apple Git-146)