File indexing completed on 2024-12-29 04:44:02
0001 #!/usr/bin/perl 0002 # 0003 # Copyright 2019 Harald Sitter <sitter@kde.org> 0004 # 0005 # This program is free software; you can redistribute it and/or 0006 # modify it under the terms of the GNU General Public License as 0007 # published by the Free Software Foundation; either version 3 of 0008 # the License or any later version accepted by the membership of 0009 # KDE e.V. (or its successor approved by the membership of KDE 0010 # e.V.), which shall act as a proxy defined in Section 14 of 0011 # version 3 of the license. 0012 # 0013 # This program is distributed in the hope that it will be useful, 0014 # but WITHOUT ANY WARRANTY; without even the implied warranty of 0015 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 0016 # GNU General Public License for more details. 0017 # 0018 # You should have received a copy of the GNU General Public License 0019 # along with this program. If not, see <http://www.gnu.org/licenses/>. 0020 0021 use strict; 0022 0023 my $debug = 0; 0024 if (defined $ENV{'LOCALE_DEBUG'}) { 0025 $debug = 1; 0026 } 0027 0028 my $config_dir = ($ENV{'XDG_CONFIG_HOME'} or "$ENV{'HOME'}/.config"); 0029 my $conf="$config_dir/klanguageoverridesrc"; 0030 0031 my @languages = ('C.UTF-8'); 0032 0033 sub debug { 0034 print(@_) if $debug; 0035 } 0036 0037 # Grab langs from languageoverrides file (in-app language switch feature). 0038 if (-e $conf) { 0039 my $group; 0040 open my $ini, '<', $conf or die "Can't open $conf: $!\n"; 0041 while (<$ini>) { # loops in $_ 0042 chomp; 0043 my $keyword; 0044 my $value; 0045 if (/^\s*\[(.+)\].*/) { 0046 $group = $1; 0047 } elsif (/^([^=]+?)\s*=\s*(.*?)\s*$/) { # https://code-maven.com/slides/perl-programming/solution-parse-ini-file 0048 if ($group ne 'Language') { 0049 next; 0050 } 0051 $keyword = $1; 0052 $value = $2; 0053 my $pattern = '@ByteArray\((.+)\)'; 0054 (my $langs = $value) =~ s/$pattern/$1/g; 0055 push @languages, split(/:/, $langs); 0056 # print("-- keyword: $1 -- value: $2\n"); 0057 } 0058 } 0059 close($ini); 0060 } 0061 0062 # Grab values from ENV. 0063 push @languages, ($ENV{'LANG'} or 'C.UTF-8'); 0064 foreach my $key (sort keys %ENV) { 0065 my $needle = 'LC_'; 0066 if (substr($key, 0, length($needle)) eq $needle) { 0067 push @languages, $ENV{$key}; 0068 } 0069 } 0070 if (my $language = $ENV{'LANGUAGE'}) { 0071 push @languages, split(':', $language); 0072 } 0073 push @languages, ($ENV{'LANG'} or 'C.UTF-8'); 0074 0075 # Uniqify; can't really use any perl modules as the base requirements of KF5 are 0076 # mostly perl core only. 0077 @languages = do { my %seen; grep { !$seen{$_}++ } @languages }; 0078 0079 # Generate as necessary. 0080 # Note: this actually generates invalid stuff as well (e.g. fr.UTF-8) while we 0081 # apparently do not need these there isn't much of a downside to generate them 0082 # lest something in glibc falls over if the language is entirely unknown in 0083 # the locpath. I should point out that we can't actually get from 0084 # language-only settings (as seen in klanguageoverrides) to full locales, so 0085 # there is no other option here anyway. 0086 my $env_locpath = $ENV{'LOCPATH'} or die "LOCPATH not set"; 0087 my @locpaths = split(/:/, $env_locpath); 0088 my $master_locpath = $locpaths[0]; 0089 foreach my $lang (@languages) { 0090 my ($locale, $encoding) = split(/\./, $lang); 0091 $encoding //= 'UTF-8'; 0092 debug("lang: $lang loc: $locale, char: $encoding\n"); 0093 0094 my $found = 0; 0095 foreach my $locpath (@locpaths) { 0096 my $loc_target = "$locpath/$locale.$encoding"; 0097 debug("checking $loc_target\n"); 0098 if (-e $loc_target) { 0099 debug("exists! skipping\n"); 0100 $found = 1; 0101 last; 0102 } 0103 } 0104 next if $found; 0105 my $target = "$master_locpath/$locale.$encoding"; 0106 0107 debug("generating $target\n"); 0108 # localedef will exit !0 for unknown reasons, even when everything was 0109 # generated fine. 0110 # may be: /snap/krita/32/usr/share/i18n/locales/iso14651_t1_common:7120: LC_COLLATE: symbol `pure-ta-zh' not known 0111 system('localedef', '-i', $locale, '-f', $encoding, $target); 0112 } 0113 0114 # use Data::Dumper; 0115 # print Dumper(@languages);