"Fossies" - the Fresh Open Source Software Archive 
Member "install-tl-20231204/tlpkg/TeXLive/trans.pl" (20 May 2021, 6032 Bytes) of package /linux/misc/install-tl-unx.tar.gz:
As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style:
standard) with prefixed line numbers and
code folding option.
Alternatively you can here
view or
download the uninterpreted source code file.
1 #!/usr/bin/env perl
2 # $Id: trans.pl 59285 2021-05-20 21:12:36Z karl $
3 # Copyright 2009-2021 Norbert Preining
4 # This file is licensed under the GNU General Public License version 2
5 # or any later version.
6 #
7 # translation infrastructure for TeX Live programs
8 # if $::lang is set then that one is used
9 # if $::lang is unset try to auto-deduce it from LC_MESSAGES/Registry
10 # if $::opt_lang is set use that instead
11 #
12 # this module implements parsing of .po files, but no specialities of .po
13 # files are supported. Only reading of msgstr and msgid and concatenating
14 # multiple lines. Furthermore, string replacements are done:
15 # \n -> <newline>
16 # \" -> "
17 # \\ -> \
18 #
19
20 use strict;
21 $^W = 1;
22
23 use utf8;
24 no utf8;
25
26 if (defined($::opt_lang)) {
27 $::lang = $::opt_lang;
28 if ($::lang eq "zh") {
29 # set language to simplified chinese
30 $::lang = "zh_CN";
31 }
32 } else {
33 if ($^O =~ /^MSWin/i) {
34 # trying to deduce automatically the country code
35 my ($lang, $area) = TeXLive::TLWinGoo::reg_country();
36 if ($lang) {
37 $::lang = $lang;
38 $::area = uc($area);
39 } else {
40 debug("didn't get any useful code from reg_country\n");
41 }
42 } else {
43 # we load POSIX and locale stuff
44 require POSIX;
45 import POSIX qw/locale_h/;
46 # now we try to deduce $::lang
47 my $loc = setlocale(&POSIX::LC_MESSAGES);
48 my ($lang,$area,$codeset);
49 if ($loc =~ m/^([^_.]*)(_([^.]*))?(\.([^@]*))?(@.*)?$/) {
50 $lang = defined($1)?$1:"";
51 # lower case the area code
52 $area = defined($3)?uc($3):"";
53 if ($lang eq "zh") {
54 if ($area =~ m/^(TW|HK)$/i) {
55 $lang = "zh";
56 $area = "TW";
57 } else {
58 # fallback to zh-cn for anything else, that is
59 # zh-cn, zh-sg, zh, and maybe something else
60 $lang = "zh";
61 $area = "CN";
62 }
63 }
64 }
65 $::lang = $lang if ($lang);
66 $::area = $area if ($area);
67 }
68 }
69
70
71 our %TRANS;
72
73 #
74 # __ takes a string argument and checks that it
75 sub __ ($@) {
76 my $key = shift;
77 my $ret;
78 # if no $::lang is set just return without anything
79 if (!defined($::lang)) {
80 $ret = $key;
81 } else {
82 $ret = $key;
83 $key =~ s/\\/\\\\/g;
84 $key =~ s/\n/\\n/g;
85 $key =~ s/"/\\"/g;
86 # if the translation is defined return it
87 if (defined($TRANS{$::lang}->{$key})) {
88 $ret = $TRANS{$::lang}->{$key};
89 if ($::debug_translation && ($key eq $ret)) {
90 print STDERR "probably untranslated in $::lang: >>>$key<<<\n";
91 }
92 } else {
93 # if we cannot find it, return $s itself
94 if ($::debug_translation && $::lang ne "en") {
95 print STDERR "no translation in $::lang: >>>$key<<<\n";
96 }
97 # $ret is already set initially
98 }
99 $ret =~ s/\\n/\n/g;
100 $ret =~ s/\\"/"/g;
101 $ret =~ s/\\\\/\\/g;
102 }
103 # translate back $ret:
104 return sprintf($ret, @_);
105 }
106
107 sub load_translations() {
108 if (defined($::lang) && ($::lang ne "en") && ($::lang ne "C")) {
109 my $code = $::lang;
110 my @files_to_check;
111 if (defined($::area)) {
112 $code .= "_$::area";
113 push @files_to_check,
114 $::lang . "_" . $::area, "$::lang-$::area",
115 $::lang . "_" . lc($::area), "$::lang-" . lc($::area),
116 # try also without area code, even if it is given!
117 $::lang;
118 } else {
119 push @files_to_check, $::lang;
120 }
121 my $found = 0;
122 for my $f (@files_to_check) {
123 if (-r "$::installerdir/tlpkg/translations/$f.po") {
124 $found = 1;
125 $::lang = $f;
126 last;
127 }
128 }
129 if (!$found) {
130 debug ("no translations available for $code (nor $::lang); falling back to English\n");
131 # tlwarn ("\n Sorry, no translations available for $code (nor $::lang); falling back to English.
132 # Make sure that you have the package \"texlive-msg-translations\" installed.
133 # (If you'd like to help translate the installer's messages, please see
134 # https://tug.org/texlive/doc.html#install-tl-xlate for information.)\n\n");
135 } else {
136 # merge the translated strings into the text string
137 open(LANG, "<$::installerdir/tlpkg/translations/$::lang.po");
138 my $msgid;
139 my $msgstr;
140 my $inmsgid;
141 my $inmsgstr;
142 while (<LANG>) {
143 chomp;
144 next if m/^\s*#/;
145 if (m/^\s*$/) {
146 if ($inmsgid) {
147 debug("msgid $msgid without msgstr in $::lang.po\n");
148 $inmsgid = 0;
149 $inmsgstr = 0;
150 $msgid = "";
151 $msgstr = "";
152 next;
153 }
154 if ($inmsgstr) {
155 if ($msgstr) {
156 if (!utf8::decode($msgstr)) {
157 warn("decoding string to utf8 didn't work: $msgstr\n");
158 }
159 # we decode msgid too to get \\ and not \
160 if (!utf8::decode($msgid)) {
161 warn("decoding string to utf8 didn't work: $msgid\n");
162 }
163 $TRANS{$::lang}{$msgid} = $msgstr;
164 } else {
165 ddebug("untranslated $::lang: ...$msgid...\n");
166 }
167 $inmsgid = 0;
168 $inmsgstr = 0;
169 $msgid = "";
170 $msgstr = "";
171 next;
172 }
173 next;
174 }
175 if (m/^msgid\s+"(.*)"\s*$/) {
176 if ($msgid) {
177 warn("stray msgid line: $_");
178 next;
179 }
180 $inmsgid = 1;
181 $msgid = $1;
182 next;
183 }
184 if (m/^"(.*)"\s*$/) {
185 if ($inmsgid) {
186 $msgid .= $1;
187 } elsif ($inmsgstr) {
188 $msgstr .= $1;
189 } else {
190 tlwarn("cannot parse $::lang.po line: $_\n");
191 }
192 next;
193 }
194 if (m/^msgstr\s+"(.*)"\s*$/) {
195 if (!$inmsgid) {
196 tlwarn("msgstr $1 without msgid\n");
197 next;
198 }
199 $msgstr = $1;
200 $inmsgstr = 1;
201 $inmsgid = 0;
202 }
203 }
204 close(LANG);
205 }
206 }
207 }
208
209
210 1;
211
212 __END__
213
214 ### Local Variables:
215 ### perl-indent-level: 2
216 ### tab-width: 2
217 ### indent-tabs-mode: nil
218 ### End:
219 # vim:set tabstop=2 expandtab: #