File indexing completed on 2021-12-21 13:58:15

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);