Commit | Line | Data |
---|---|---|
73fc293b KW |
1 | # Common tools for test files files to find the locales which exist on the |
2 | # system. | |
3 | ||
4 | # Note that it's okay that some languages have their native names | |
5 | # capitalized here even though that's not "right". They are lowercased | |
6 | # anyway later during the scanning process (and besides, some clueless | |
7 | # vendor might have them capitalized erroneously anyway). | |
8 | ||
9 | ||
10 | sub _trylocale { # Adds the locale given by the first parameter to the list | |
11 | # given by the 2nd iff the platform supports the locale, | |
12 | # and it is not already on the list | |
13 | my $locale = shift; | |
14 | my $list = shift; | |
15 | return if grep { $locale eq $_ } @$list; | |
16 | return unless setlocale(&POSIX::LC_ALL, $locale); | |
17 | my $badutf8; | |
18 | { | |
19 | local $SIG{__WARN__} = sub { | |
20 | $badutf8 = $_[0] =~ /Malformed UTF-8/; | |
21 | }; | |
22 | } | |
23 | ||
24 | if ($badutf8) { | |
25 | ok(0, "Verify locale name doesn't contain malformed utf8"); | |
26 | return; | |
27 | } | |
28 | push @$list, $locale; | |
29 | } | |
30 | ||
31 | sub _decode_encodings { | |
32 | my @enc; | |
33 | ||
34 | foreach (split(/ /, shift)) { | |
35 | if (/^(\d+)$/) { | |
36 | push @enc, "ISO8859-$1"; | |
37 | push @enc, "iso8859$1"; # HP | |
38 | if ($1 eq '1') { | |
39 | push @enc, "roman8"; # HP | |
40 | } | |
41 | push @enc, $_; | |
42 | push @enc, "$_.UTF-8"; | |
43 | } | |
44 | } | |
45 | if ($^O eq 'os390') { | |
46 | push @enc, qw(IBM-037 IBM-819 IBM-1047); | |
47 | } | |
48 | push @enc, "UTF-8"; | |
49 | ||
50 | return @enc; | |
51 | } | |
52 | ||
53 | sub find_locales { # Returns an array of all the locales we found on the | |
54 | # system | |
55 | ||
56 | _trylocale("C", \@Locale); | |
57 | _trylocale("POSIX", \@Locale); | |
58 | foreach (0..15) { | |
59 | _trylocale("ISO8859-$_", \@Locale); | |
60 | _trylocale("iso8859$_", \@Locale); | |
61 | _trylocale("iso8859-$_", \@Locale); | |
62 | _trylocale("iso_8859_$_", \@Locale); | |
63 | _trylocale("isolatin$_", \@Locale); | |
64 | _trylocale("isolatin-$_", \@Locale); | |
65 | _trylocale("iso_latin_$_", \@Locale); | |
66 | } | |
67 | ||
68 | # Sanitize the environment so that we can run the external 'locale' | |
69 | # program without the taint mode getting grumpy. | |
70 | ||
71 | # $ENV{PATH} is special in VMS. | |
72 | delete $ENV{PATH} if $^O ne 'VMS' or $Config{d_setenv}; | |
73 | ||
74 | # Other subversive stuff. | |
75 | delete @ENV{qw(IFS CDPATH ENV BASH_ENV)}; | |
76 | ||
77 | if (-x "/usr/bin/locale" | |
78 | && open(LOCALES, "/usr/bin/locale -a 2>/dev/null|")) | |
79 | { | |
80 | while (<LOCALES>) { | |
81 | # It seems that /usr/bin/locale steadfastly outputs 8 bit data, which | |
82 | # ain't great when we're running this testPERL_UNICODE= so that utf8 | |
83 | # locales will cause all IO hadles to default to (assume) utf8 | |
84 | next unless utf8::valid($_); | |
85 | chomp; | |
86 | _trylocale($_, \@Locale); | |
87 | } | |
88 | close(LOCALES); | |
89 | } elsif ($^O eq 'VMS' | |
90 | && defined($ENV{'SYS$I18N_LOCALE'}) | |
91 | && -d 'SYS$I18N_LOCALE') | |
92 | { | |
93 | # The SYS$I18N_LOCALE logical name search list was not present on | |
94 | # VAX VMS V5.5-12, but was on AXP && VAX VMS V6.2 as well as later versions. | |
95 | opendir(LOCALES, "SYS\$I18N_LOCALE:"); | |
96 | while ($_ = readdir(LOCALES)) { | |
97 | chomp; | |
98 | _trylocale($_, \@Locale); | |
99 | } | |
100 | close(LOCALES); | |
101 | } elsif (($^O eq 'openbsd' || $^O eq 'bitrig' ) && -e '/usr/share/locale') { | |
102 | ||
103 | # OpenBSD doesn't have a locale executable, so reading /usr/share/locale | |
104 | # is much easier and faster than the last resort method. | |
105 | ||
106 | opendir(LOCALES, '/usr/share/locale'); | |
107 | while ($_ = readdir(LOCALES)) { | |
108 | chomp; | |
109 | _trylocale($_, \@Locale); | |
110 | } | |
111 | close(LOCALES); | |
112 | } else { # Final fallback. Try our list of locales hard-coded here | |
113 | ||
114 | # This is going to be slow. | |
115 | my @Data; | |
116 | ||
117 | ||
118 | # Locales whose name differs if the utf8 bit is on are stored in these two | |
119 | # files with appropriate encodings. | |
120 | if ($^H & 0x08 || (${^OPEN} || "") =~ /:utf8/) { | |
121 | @Data = do "lib/locale/utf8"; | |
122 | } else { | |
123 | @Data = do "lib/locale/latin1"; | |
124 | } | |
125 | ||
126 | # The rest of the locales are in this file. | |
127 | push @Data, <DATA>; | |
128 | ||
129 | foreach my $line (@Data) { | |
130 | my ($locale_name, $language_codes, $country_codes, $encodings) = | |
131 | split /:/, $line; | |
132 | my @enc = _decode_encodings($encodings); | |
133 | foreach my $loc (split(/ /, $locale_name)) { | |
134 | _trylocale($loc, \@Locale); | |
135 | foreach my $enc (@enc) { | |
136 | _trylocale("$loc.$enc", \@Locale); | |
137 | } | |
138 | $loc = lc $loc; | |
139 | foreach my $enc (@enc) { | |
140 | _trylocale("$loc.$enc", \@Locale); | |
141 | } | |
142 | } | |
143 | foreach my $lang (split(/ /, $language_codes)) { | |
144 | _trylocale($lang, \@Locale); | |
145 | foreach my $country (split(/ /, $country_codes)) { | |
146 | my $lc = "${lang}_${country}"; | |
147 | _trylocale($lc, \@Locale); | |
148 | foreach my $enc (@enc) { | |
149 | _trylocale("$lc.$enc", \@Locale); | |
150 | } | |
151 | my $lC = "${lang}_\U${country}"; | |
152 | _trylocale($lC, \@Locale); | |
153 | foreach my $enc (@enc) { | |
154 | _trylocale("$lC.$enc", \@Locale); | |
155 | } | |
156 | } | |
157 | } | |
158 | } | |
159 | } | |
160 | ||
161 | @Locale = sort @Locale; | |
162 | ||
163 | return @Locale; | |
164 | ||
165 | ||
166 | } | |
167 | ||
168 | 1 | |
169 | ||
170 | # Format of data is: locale_name, language_codes, country_codes, encodings | |
171 | __DATA__ | |
172 | Afrikaans:af:za:1 15 | |
173 | Arabic:ar:dz eg sa:6 arabic8 | |
174 | Brezhoneg Breton:br:fr:1 15 | |
175 | Bulgarski Bulgarian:bg:bg:5 | |
176 | Chinese:zh:cn tw:cn.EUC eucCN eucTW euc.CN euc.TW Big5 GB2312 tw.EUC | |
177 | Hrvatski Croatian:hr:hr:2 | |
178 | Cymraeg Welsh:cy:cy:1 14 15 | |
179 | Czech:cs:cz:2 | |
180 | Dansk Danish:da:dk:1 15 | |
181 | Nederlands Dutch:nl:be nl:1 15 | |
182 | English American British:en:au ca gb ie nz us uk zw:1 15 cp850 | |
183 | Esperanto:eo:eo:3 | |
184 | Eesti Estonian:et:ee:4 6 13 | |
185 | Suomi Finnish:fi:fi:1 15 | |
186 | Flamish::fl:1 15 | |
187 | Deutsch German:de:at be ch de lu:1 15 | |
188 | Euskaraz Basque:eu:es fr:1 15 | |
189 | Galego Galician:gl:es:1 15 | |
190 | Ellada Greek:el:gr:7 g8 | |
191 | Frysk:fy:nl:1 15 | |
192 | Greenlandic:kl:gl:4 6 | |
193 | Hebrew:iw:il:8 hebrew8 | |
194 | Hungarian:hu:hu:2 | |
195 | Indonesian:id:id:1 15 | |
196 | Gaeilge Irish:ga:IE:1 14 15 | |
197 | Italiano Italian:it:ch it:1 15 | |
198 | Nihongo Japanese:ja:jp:euc eucJP jp.EUC sjis | |
199 | Korean:ko:kr: | |
200 | Latine Latin:la:va:1 15 | |
201 | Latvian:lv:lv:4 6 13 | |
202 | Lithuanian:lt:lt:4 6 13 | |
203 | Macedonian:mk:mk:1 15 | |
204 | Maltese:mt:mt:3 | |
205 | Moldovan:mo:mo:2 | |
206 | Norsk Norwegian:no no\@nynorsk nb nn:no:1 15 | |
207 | Occitan:oc:es:1 15 | |
208 | Polski Polish:pl:pl:2 | |
209 | Rumanian:ro:ro:2 | |
210 | Russki Russian:ru:ru su ua:5 koi8 koi8r KOI8-R koi8u cp1251 cp866 | |
211 | Serbski Serbian:sr:yu:5 | |
212 | Slovak:sk:sk:2 | |
213 | Slovene Slovenian:sl:si:2 | |
214 | Sqhip Albanian:sq:sq:1 15 | |
215 | Svenska Swedish:sv:fi se:1 15 | |
216 | Thai:th:th:11 tis620 | |
217 | Turkish:tr:tr:9 turkish8 | |
218 | Yiddish:yi::1 15 |