Commit | Line | Data |
---|---|---|
55d7b906 | 1 | package Unicode::UCD; |
561c79ed JH |
2 | |
3 | use strict; | |
4 | use warnings; | |
36c2430c | 5 | no warnings 'surrogate'; # surrogates can be inputs to this |
98ef7649 | 6 | use charnames (); |
561c79ed | 7 | |
b0e24409 | 8 | our $VERSION = '0.66'; |
561c79ed JH |
9 | |
10 | require Exporter; | |
11 | ||
12 | our @ISA = qw(Exporter); | |
74f8133e | 13 | |
10a6ecd2 JH |
14 | our @EXPORT_OK = qw(charinfo |
15 | charblock charscript | |
16 | charblocks charscripts | |
b08cd201 | 17 | charinrange |
12fee290 | 18 | charprop |
40416981 | 19 | charprops_all |
ea508aee | 20 | general_categories bidi_types |
b08cd201 | 21 | compexcl |
66aa79e2 | 22 | casefold all_casefolds casespec |
7319f91d KW |
23 | namedseq |
24 | num | |
7ef25837 KW |
25 | prop_aliases |
26 | prop_value_aliases | |
9024667a | 27 | prop_values |
681d705c | 28 | prop_invlist |
62b3b855 | 29 | prop_invmap |
1fdd5e53 | 30 | search_invlist |
681d705c | 31 | MAX_CP |
7319f91d | 32 | ); |
561c79ed JH |
33 | |
34 | use Carp; | |
35 | ||
a1ae4420 KW |
36 | sub IS_ASCII_PLATFORM { ord("A") == 65 } |
37 | ||
561c79ed JH |
38 | =head1 NAME |
39 | ||
55d7b906 | 40 | Unicode::UCD - Unicode character database |
561c79ed JH |
41 | |
42 | =head1 SYNOPSIS | |
43 | ||
55d7b906 | 44 | use Unicode::UCD 'charinfo'; |
b08cd201 | 45 | my $charinfo = charinfo($codepoint); |
561c79ed | 46 | |
12fee290 KW |
47 | use Unicode::UCD 'charprop'; |
48 | my $value = charprop($codepoint, $property); | |
49 | ||
40416981 KW |
50 | use Unicode::UCD 'charprops_all'; |
51 | my $all_values_hash_ref = charprops_all($codepoint); | |
52 | ||
956cae9a | 53 | use Unicode::UCD 'casefold'; |
d25148c1 | 54 | my $casefold = casefold($codepoint); |
956cae9a | 55 | |
66aa79e2 KW |
56 | use Unicode::UCD 'all_casefolds'; |
57 | my $all_casefolds_ref = all_casefolds(); | |
58 | ||
5d8e6e41 | 59 | use Unicode::UCD 'casespec'; |
d25148c1 | 60 | my $casespec = casespec($codepoint); |
5d8e6e41 | 61 | |
55d7b906 | 62 | use Unicode::UCD 'charblock'; |
e882dd67 JH |
63 | my $charblock = charblock($codepoint); |
64 | ||
55d7b906 | 65 | use Unicode::UCD 'charscript'; |
65044554 | 66 | my $charscript = charscript($codepoint); |
561c79ed | 67 | |
55d7b906 | 68 | use Unicode::UCD 'charblocks'; |
e145285f JH |
69 | my $charblocks = charblocks(); |
70 | ||
55d7b906 | 71 | use Unicode::UCD 'charscripts'; |
ea508aee | 72 | my $charscripts = charscripts(); |
e145285f | 73 | |
55d7b906 | 74 | use Unicode::UCD qw(charscript charinrange); |
e145285f JH |
75 | my $range = charscript($script); |
76 | print "looks like $script\n" if charinrange($range, $codepoint); | |
77 | ||
ea508aee JH |
78 | use Unicode::UCD qw(general_categories bidi_types); |
79 | my $categories = general_categories(); | |
80 | my $types = bidi_types(); | |
81 | ||
7ef25837 KW |
82 | use Unicode::UCD 'prop_aliases'; |
83 | my @space_names = prop_aliases("space"); | |
84 | ||
85 | use Unicode::UCD 'prop_value_aliases'; | |
86 | my @gc_punct_names = prop_value_aliases("Gc", "Punct"); | |
87 | ||
9024667a KW |
88 | use Unicode::UCD 'prop_values'; |
89 | my @all_EA_short_names = prop_values("East_Asian_Width"); | |
90 | ||
681d705c KW |
91 | use Unicode::UCD 'prop_invlist'; |
92 | my @puncts = prop_invlist("gc=punctuation"); | |
93 | ||
62b3b855 KW |
94 | use Unicode::UCD 'prop_invmap'; |
95 | my ($list_ref, $map_ref, $format, $missing) | |
96 | = prop_invmap("General Category"); | |
97 | ||
1fdd5e53 KW |
98 | use Unicode::UCD 'search_invlist'; |
99 | my $index = search_invlist(\@invlist, $code_point); | |
100 | ||
b0e24409 KW |
101 | # The following function should be used only internally in |
102 | # implementations of the Unicode Normalization Algorithm, and there | |
103 | # are better choices than it. | |
55d7b906 | 104 | use Unicode::UCD 'compexcl'; |
e145285f JH |
105 | my $compexcl = compexcl($codepoint); |
106 | ||
a2bd7410 JH |
107 | use Unicode::UCD 'namedseq'; |
108 | my $namedseq = namedseq($named_sequence_name); | |
109 | ||
55d7b906 | 110 | my $unicode_version = Unicode::UCD::UnicodeVersion(); |
e145285f | 111 | |
7319f91d | 112 | my $convert_to_numeric = |
62a8c8c2 | 113 | Unicode::UCD::num("\N{RUMI DIGIT ONE}\N{RUMI DIGIT TWO}"); |
7319f91d | 114 | |
561c79ed JH |
115 | =head1 DESCRIPTION |
116 | ||
a452d459 KW |
117 | The Unicode::UCD module offers a series of functions that |
118 | provide a simple interface to the Unicode | |
8b731da2 | 119 | Character Database. |
561c79ed | 120 | |
a452d459 KW |
121 | =head2 code point argument |
122 | ||
123 | Some of the functions are called with a I<code point argument>, which is either | |
a1ae4420 | 124 | a decimal or a hexadecimal scalar designating a code point in the platform's |
91e78470 KW |
125 | native character set (extended to Unicode), or a string containing C<U+> |
126 | followed by hexadecimals | |
a1ae4420 KW |
127 | designating a Unicode code point. A leading 0 will force a hexadecimal |
128 | interpretation, as will a hexadecimal digit that isn't a decimal digit. | |
bc75372e KW |
129 | |
130 | Examples: | |
131 | ||
a1ae4420 KW |
132 | 223 # Decimal 223 in native character set |
133 | 0223 # Hexadecimal 223, native (= 547 decimal) | |
4911bc40 JH |
134 | 0xDF # Hexadecimal DF, native (= 223 decimal) |
135 | '0xDF' # String form of hexadecimal (= 223 decimal) | |
91e78470 | 136 | 'U+DF' # Hexadecimal DF, in Unicode's character set |
a1ae4420 | 137 | (= LATIN SMALL LETTER SHARP S) |
bc75372e KW |
138 | |
139 | Note that the largest code point in Unicode is U+10FFFF. | |
c3e5bc54 | 140 | |
561c79ed JH |
141 | =cut |
142 | ||
10a6ecd2 | 143 | my $BLOCKSFH; |
10a6ecd2 | 144 | my $VERSIONFH; |
b08cd201 JH |
145 | my $CASEFOLDFH; |
146 | my $CASESPECFH; | |
a2bd7410 | 147 | my $NAMEDSEQFH; |
e80c2d9d | 148 | my $v_unicode_version; # v-string. |
561c79ed JH |
149 | |
150 | sub openunicode { | |
151 | my ($rfh, @path) = @_; | |
152 | my $f; | |
153 | unless (defined $$rfh) { | |
154 | for my $d (@INC) { | |
155 | use File::Spec; | |
55d7b906 | 156 | $f = File::Spec->catfile($d, "unicore", @path); |
32c16050 | 157 | last if open($$rfh, $f); |
e882dd67 | 158 | undef $f; |
561c79ed | 159 | } |
e882dd67 JH |
160 | croak __PACKAGE__, ": failed to find ", |
161 | File::Spec->catfile(@path), " in @INC" | |
162 | unless defined $f; | |
561c79ed JH |
163 | } |
164 | return $f; | |
165 | } | |
166 | ||
cb3150f5 KW |
167 | sub _dclone ($) { # Use Storable::dclone if available; otherwise emulate it. |
168 | ||
169 | use if defined &DynaLoader::boot_DynaLoader, Storable => qw(dclone); | |
170 | ||
171 | return dclone(shift) if defined &dclone; | |
172 | ||
173 | my $arg = shift; | |
174 | my $type = ref $arg; | |
175 | return $arg unless $type; # No deep cloning needed for scalars | |
176 | ||
177 | if ($type eq 'ARRAY') { | |
178 | my @return; | |
179 | foreach my $element (@$arg) { | |
180 | push @return, &_dclone($element); | |
181 | } | |
182 | return \@return; | |
183 | } | |
184 | elsif ($type eq 'HASH') { | |
185 | my %return; | |
186 | foreach my $key (keys %$arg) { | |
187 | $return{$key} = &_dclone($arg->{$key}); | |
188 | } | |
189 | return \%return; | |
190 | } | |
191 | else { | |
192 | croak "_dclone can't handle " . $type; | |
193 | } | |
194 | } | |
195 | ||
a452d459 | 196 | =head2 B<charinfo()> |
561c79ed | 197 | |
55d7b906 | 198 | use Unicode::UCD 'charinfo'; |
561c79ed | 199 | |
b08cd201 | 200 | my $charinfo = charinfo(0x41); |
561c79ed | 201 | |
a452d459 KW |
202 | This returns information about the input L</code point argument> |
203 | as a reference to a hash of fields as defined by the Unicode | |
204 | standard. If the L</code point argument> is not assigned in the standard | |
205 | (i.e., has the general category C<Cn> meaning C<Unassigned>) | |
206 | or is a non-character (meaning it is guaranteed to never be assigned in | |
207 | the standard), | |
a18e976f | 208 | C<undef> is returned. |
a452d459 KW |
209 | |
210 | Fields that aren't applicable to the particular code point argument exist in the | |
211 | returned hash, and are empty. | |
212 | ||
12fee290 KW |
213 | For results that are less "raw" than this function returns, or to get the values for |
214 | any property, not just the few covered by this function, use the | |
215 | L</charprop()> function. | |
216 | ||
a452d459 KW |
217 | The keys in the hash with the meanings of their values are: |
218 | ||
219 | =over | |
220 | ||
221 | =item B<code> | |
222 | ||
a1ae4420 KW |
223 | the input native L</code point argument> expressed in hexadecimal, with |
224 | leading zeros | |
a452d459 KW |
225 | added if necessary to make it contain at least four hexdigits |
226 | ||
227 | =item B<name> | |
228 | ||
229 | name of I<code>, all IN UPPER CASE. | |
230 | Some control-type code points do not have names. | |
231 | This field will be empty for C<Surrogate> and C<Private Use> code points, | |
232 | and for the others without a name, | |
233 | it will contain a description enclosed in angle brackets, like | |
234 | C<E<lt>controlE<gt>>. | |
235 | ||
236 | ||
237 | =item B<category> | |
238 | ||
239 | The short name of the general category of I<code>. | |
240 | This will match one of the keys in the hash returned by L</general_categories()>. | |
241 | ||
7ef25837 KW |
242 | The L</prop_value_aliases()> function can be used to get all the synonyms |
243 | of the category name. | |
244 | ||
a452d459 KW |
245 | =item B<combining> |
246 | ||
247 | the combining class number for I<code> used in the Canonical Ordering Algorithm. | |
248 | For Unicode 5.1, this is described in Section 3.11 C<Canonical Ordering Behavior> | |
249 | available at | |
250 | L<http://www.unicode.org/versions/Unicode5.1.0/> | |
251 | ||
7ef25837 KW |
252 | The L</prop_value_aliases()> function can be used to get all the synonyms |
253 | of the combining class number. | |
254 | ||
a452d459 KW |
255 | =item B<bidi> |
256 | ||
257 | bidirectional type of I<code>. | |
258 | This will match one of the keys in the hash returned by L</bidi_types()>. | |
259 | ||
7ef25837 KW |
260 | The L</prop_value_aliases()> function can be used to get all the synonyms |
261 | of the bidi type name. | |
262 | ||
a452d459 KW |
263 | =item B<decomposition> |
264 | ||
265 | is empty if I<code> has no decomposition; or is one or more codes | |
a18e976f | 266 | (separated by spaces) that, taken in order, represent a decomposition for |
a452d459 | 267 | I<code>. Each has at least four hexdigits. |
53cb2385 | 268 | The codes may be preceded by a word enclosed in angle brackets, then a space, |
a452d459 KW |
269 | like C<E<lt>compatE<gt> >, giving the type of decomposition |
270 | ||
06bba7d5 | 271 | This decomposition may be an intermediate one whose components are also |
b08d569e KW |
272 | decomposable. Use L<Unicode::Normalize> to get the final decomposition in one |
273 | step. | |
06bba7d5 | 274 | |
a452d459 KW |
275 | =item B<decimal> |
276 | ||
53cb2385 | 277 | if I<code> represents a decimal digit this is its integer numeric value |
a452d459 KW |
278 | |
279 | =item B<digit> | |
280 | ||
89e4a205 KW |
281 | if I<code> represents some other digit-like number, this is its integer |
282 | numeric value | |
a452d459 KW |
283 | |
284 | =item B<numeric> | |
285 | ||
286 | if I<code> represents a whole or rational number, this is its numeric value. | |
287 | Rational values are expressed as a string like C<1/4>. | |
288 | ||
289 | =item B<mirrored> | |
290 | ||
291 | C<Y> or C<N> designating if I<code> is mirrored in bidirectional text | |
292 | ||
293 | =item B<unicode10> | |
294 | ||
295 | name of I<code> in the Unicode 1.0 standard if one | |
296 | existed for this code point and is different from the current name | |
297 | ||
298 | =item B<comment> | |
299 | ||
89e4a205 | 300 | As of Unicode 6.0, this is always empty. |
a452d459 KW |
301 | |
302 | =item B<upper> | |
303 | ||
91e78470 KW |
304 | is, if non-empty, the uppercase mapping for I<code> expressed as at least four |
305 | hexdigits. This indicates that the full uppercase mapping is a single | |
306 | character, and is identical to the simple (single-character only) mapping. | |
307 | When this field is empty, it means that the simple uppercase mapping is | |
12fee290 | 308 | I<code> itself; you'll need some other means, (like L</charprop()> or |
91e78470 | 309 | L</casespec()> to get the full mapping. |
a452d459 KW |
310 | |
311 | =item B<lower> | |
312 | ||
91e78470 KW |
313 | is, if non-empty, the lowercase mapping for I<code> expressed as at least four |
314 | hexdigits. This indicates that the full lowercase mapping is a single | |
315 | character, and is identical to the simple (single-character only) mapping. | |
316 | When this field is empty, it means that the simple lowercase mapping is | |
12fee290 | 317 | I<code> itself; you'll need some other means, (like L</charprop()> or |
91e78470 | 318 | L</casespec()> to get the full mapping. |
a452d459 KW |
319 | |
320 | =item B<title> | |
321 | ||
91e78470 KW |
322 | is, if non-empty, the titlecase mapping for I<code> expressed as at least four |
323 | hexdigits. This indicates that the full titlecase mapping is a single | |
324 | character, and is identical to the simple (single-character only) mapping. | |
325 | When this field is empty, it means that the simple titlecase mapping is | |
12fee290 | 326 | I<code> itself; you'll need some other means, (like L</charprop()> or |
91e78470 | 327 | L</casespec()> to get the full mapping. |
a452d459 KW |
328 | |
329 | =item B<block> | |
330 | ||
a18e976f | 331 | the block I<code> belongs to (used in C<\p{Blk=...}>). |
b08d569e KW |
332 | The L</prop_value_aliases()> function can be used to get all the synonyms |
333 | of the block name. | |
a452d459 | 334 | |
b08d569e | 335 | See L</Blocks versus Scripts>. |
a452d459 KW |
336 | |
337 | =item B<script> | |
338 | ||
a18e976f | 339 | the script I<code> belongs to. |
b08d569e | 340 | The L</prop_value_aliases()> function can be used to get all the synonyms |
48791bf1 KW |
341 | of the script name. Note that this is the older "Script" property value, and |
342 | not the improved "Script_Extensions" value. | |
b08d569e | 343 | |
a452d459 KW |
344 | See L</Blocks versus Scripts>. |
345 | ||
346 | =back | |
32c16050 JH |
347 | |
348 | Note that you cannot do (de)composition and casing based solely on the | |
b08d569e KW |
349 | I<decomposition>, I<combining>, I<lower>, I<upper>, and I<title> fields; you |
350 | will need also the L</casespec()> function and the C<Composition_Exclusion> | |
351 | property. (Or you could just use the L<lc()|perlfunc/lc>, | |
352 | L<uc()|perlfunc/uc>, and L<ucfirst()|perlfunc/ucfirst> functions, and the | |
353 | L<Unicode::Normalize> module.) | |
561c79ed JH |
354 | |
355 | =cut | |
356 | ||
e10d7780 | 357 | # NB: This function is nearly duplicated in charnames.pm |
10a6ecd2 JH |
358 | sub _getcode { |
359 | my $arg = shift; | |
360 | ||
dc0a4417 | 361 | if ($arg =~ /^[1-9]\d*$/) { |
10a6ecd2 | 362 | return $arg; |
a1ae4420 KW |
363 | } |
364 | elsif ($arg =~ /^(?:0[xX])?([[:xdigit:]]+)$/) { | |
365 | return CORE::hex($1); | |
366 | } | |
367 | elsif ($arg =~ /^[Uu]\+([[:xdigit:]]+)$/) { # Is of form U+0000, means | |
368 | # wants the Unicode code | |
369 | # point, not the native one | |
370 | my $decimal = CORE::hex($1); | |
371 | return $decimal if IS_ASCII_PLATFORM; | |
372 | return utf8::unicode_to_native($decimal); | |
10a6ecd2 JH |
373 | } |
374 | ||
375 | return; | |
376 | } | |
377 | ||
05dbc6f8 KW |
378 | # Populated by _num. Converts real number back to input rational |
379 | my %real_to_rational; | |
380 | ||
381 | # To store the contents of files found on disk. | |
382 | my @BIDIS; | |
383 | my @CATEGORIES; | |
384 | my @DECOMPOSITIONS; | |
385 | my @NUMERIC_TYPES; | |
5c3b35c9 KW |
386 | my %SIMPLE_LOWER; |
387 | my %SIMPLE_TITLE; | |
388 | my %SIMPLE_UPPER; | |
389 | my %UNICODE_1_NAMES; | |
72fcb9f0 | 390 | my %ISO_COMMENT; |
05dbc6f8 | 391 | |
f7598639 KW |
392 | # Eval'd so can run on versions earlier than the property is available in |
393 | my $Hangul_Syllables_re = eval 'qr/\p{Block=Hangul_Syllables}/'; | |
394 | ||
05dbc6f8 | 395 | sub charinfo { |
a6fa416b | 396 | |
05dbc6f8 KW |
397 | # This function has traditionally mimicked what is in UnicodeData.txt, |
398 | # warts and all. This is a re-write that avoids UnicodeData.txt so that | |
399 | # it can be removed to save disk space. Instead, this assembles | |
400 | # information gotten by other methods that get data from various other | |
401 | # files. It uses charnames to get the character name; and various | |
402 | # mktables tables. | |
324f9e44 | 403 | |
05dbc6f8 | 404 | use feature 'unicode_strings'; |
a6fa416b | 405 | |
cb3150f5 KW |
406 | # Will fail if called under minitest |
407 | use if defined &DynaLoader::boot_DynaLoader, "Unicode::Normalize" => qw(getCombinClass NFD); | |
408 | ||
10a6ecd2 JH |
409 | my $arg = shift; |
410 | my $code = _getcode($arg); | |
05dbc6f8 KW |
411 | croak __PACKAGE__, "::charinfo: unknown code '$arg'" unless defined $code; |
412 | ||
413 | # Non-unicode implies undef. | |
414 | return if $code > 0x10FFFF; | |
415 | ||
416 | my %prop; | |
417 | my $char = chr($code); | |
418 | ||
35a865d4 | 419 | @CATEGORIES =_read_table("To/Gc.pl") unless @CATEGORIES; |
05dbc6f8 KW |
420 | $prop{'category'} = _search(\@CATEGORIES, 0, $#CATEGORIES, $code) |
421 | // $utf8::SwashInfo{'ToGc'}{'missing'}; | |
09edd811 KW |
422 | # Return undef if category value is 'Unassigned' or one of its synonyms |
423 | return if grep { lc $_ eq 'unassigned' } | |
424 | prop_value_aliases('Gc', $prop{'category'}); | |
05dbc6f8 KW |
425 | |
426 | $prop{'code'} = sprintf "%04X", $code; | |
427 | $prop{'name'} = ($char =~ /\p{Cntrl}/) ? '<control>' | |
428 | : (charnames::viacode($code) // ""); | |
429 | ||
430 | $prop{'combining'} = getCombinClass($code); | |
431 | ||
35a865d4 | 432 | @BIDIS =_read_table("To/Bc.pl") unless @BIDIS; |
05dbc6f8 KW |
433 | $prop{'bidi'} = _search(\@BIDIS, 0, $#BIDIS, $code) |
434 | // $utf8::SwashInfo{'ToBc'}{'missing'}; | |
435 | ||
436 | # For most code points, we can just read in "unicore/Decomposition.pl", as | |
437 | # its contents are exactly what should be output. But that file doesn't | |
438 | # contain the data for the Hangul syllable decompositions, which can be | |
94c91ffc KW |
439 | # algorithmically computed, and NFD() does that, so we call NFD() for |
440 | # those. We can't use NFD() for everything, as it does a complete | |
05dbc6f8 | 441 | # recursive decomposition, and what this function has always done is to |
94c91ffc KW |
442 | # return what's in UnicodeData.txt which doesn't show that recursiveness. |
443 | # Fortunately, the NFD() of the Hanguls doesn't have any recursion | |
444 | # issues. | |
445 | # Having no decomposition implies an empty field; otherwise, all but | |
446 | # "Canonical" imply a compatible decomposition, and the type is prefixed | |
447 | # to that, as it is in UnicodeData.txt | |
9abdc62b | 448 | UnicodeVersion() unless defined $v_unicode_version; |
f7598639 | 449 | if ($v_unicode_version ge v2.0.0 && $char =~ $Hangul_Syllables_re) { |
05dbc6f8 KW |
450 | # The code points of the decomposition are output in standard Unicode |
451 | # hex format, separated by blanks. | |
452 | $prop{'decomposition'} = join " ", map { sprintf("%04X", $_)} | |
94c91ffc | 453 | unpack "U*", NFD($char); |
a6fa416b | 454 | } |
05dbc6f8 | 455 | else { |
35a865d4 | 456 | @DECOMPOSITIONS = _read_table("Decomposition.pl") |
05dbc6f8 KW |
457 | unless @DECOMPOSITIONS; |
458 | $prop{'decomposition'} = _search(\@DECOMPOSITIONS, 0, $#DECOMPOSITIONS, | |
459 | $code) // ""; | |
561c79ed | 460 | } |
05dbc6f8 KW |
461 | |
462 | # Can use num() to get the numeric values, if any. | |
463 | if (! defined (my $value = num($char))) { | |
464 | $prop{'decimal'} = $prop{'digit'} = $prop{'numeric'} = ""; | |
465 | } | |
466 | else { | |
467 | if ($char =~ /\d/) { | |
468 | $prop{'decimal'} = $prop{'digit'} = $prop{'numeric'} = $value; | |
469 | } | |
470 | else { | |
471 | ||
472 | # For non-decimal-digits, we have to read in the Numeric type | |
473 | # to distinguish them. It is not just a matter of integer vs. | |
474 | # rational, as some whole number values are not considered digits, | |
475 | # e.g., TAMIL NUMBER TEN. | |
476 | $prop{'decimal'} = ""; | |
477 | ||
35a865d4 | 478 | @NUMERIC_TYPES =_read_table("To/Nt.pl") unless @NUMERIC_TYPES; |
05dbc6f8 KW |
479 | if ((_search(\@NUMERIC_TYPES, 0, $#NUMERIC_TYPES, $code) // "") |
480 | eq 'Digit') | |
481 | { | |
482 | $prop{'digit'} = $prop{'numeric'} = $value; | |
483 | } | |
484 | else { | |
485 | $prop{'digit'} = ""; | |
486 | $prop{'numeric'} = $real_to_rational{$value} // $value; | |
487 | } | |
488 | } | |
489 | } | |
490 | ||
491 | $prop{'mirrored'} = ($char =~ /\p{Bidi_Mirrored}/) ? 'Y' : 'N'; | |
492 | ||
35a865d4 | 493 | %UNICODE_1_NAMES =_read_table("To/Na1.pl", "use_hash") unless %UNICODE_1_NAMES; |
5c3b35c9 | 494 | $prop{'unicode10'} = $UNICODE_1_NAMES{$code} // ""; |
05dbc6f8 | 495 | |
72fcb9f0 KW |
496 | UnicodeVersion() unless defined $v_unicode_version; |
497 | if ($v_unicode_version ge v6.0.0) { | |
498 | $prop{'comment'} = ""; | |
499 | } | |
500 | else { | |
501 | %ISO_COMMENT = _read_table("To/Isc.pl", "use_hash") unless %ISO_COMMENT; | |
502 | $prop{'comment'} = (defined $ISO_COMMENT{$code}) | |
503 | ? $ISO_COMMENT{$code} | |
504 | : ""; | |
505 | } | |
05dbc6f8 | 506 | |
35a865d4 | 507 | %SIMPLE_UPPER = _read_table("To/Uc.pl", "use_hash") unless %SIMPLE_UPPER; |
bf7fe2df | 508 | $prop{'upper'} = (defined $SIMPLE_UPPER{$code}) |
d11155ec | 509 | ? sprintf("%04X", $SIMPLE_UPPER{$code}) |
bf7fe2df | 510 | : ""; |
75e7c50b | 511 | |
35a865d4 | 512 | %SIMPLE_LOWER = _read_table("To/Lc.pl", "use_hash") unless %SIMPLE_LOWER; |
bf7fe2df | 513 | $prop{'lower'} = (defined $SIMPLE_LOWER{$code}) |
d11155ec | 514 | ? sprintf("%04X", $SIMPLE_LOWER{$code}) |
bf7fe2df | 515 | : ""; |
75e7c50b | 516 | |
35a865d4 | 517 | %SIMPLE_TITLE = _read_table("To/Tc.pl", "use_hash") unless %SIMPLE_TITLE; |
bf7fe2df | 518 | $prop{'title'} = (defined $SIMPLE_TITLE{$code}) |
d11155ec | 519 | ? sprintf("%04X", $SIMPLE_TITLE{$code}) |
bf7fe2df | 520 | : ""; |
05dbc6f8 KW |
521 | |
522 | $prop{block} = charblock($code); | |
523 | $prop{script} = charscript($code); | |
524 | return \%prop; | |
561c79ed JH |
525 | } |
526 | ||
e882dd67 JH |
527 | sub _search { # Binary search in a [[lo,hi,prop],[...],...] table. |
528 | my ($table, $lo, $hi, $code) = @_; | |
529 | ||
530 | return if $lo > $hi; | |
531 | ||
532 | my $mid = int(($lo+$hi) / 2); | |
533 | ||
534 | if ($table->[$mid]->[0] < $code) { | |
10a6ecd2 | 535 | if ($table->[$mid]->[1] >= $code) { |
e882dd67 JH |
536 | return $table->[$mid]->[2]; |
537 | } else { | |
538 | _search($table, $mid + 1, $hi, $code); | |
539 | } | |
540 | } elsif ($table->[$mid]->[0] > $code) { | |
541 | _search($table, $lo, $mid - 1, $code); | |
542 | } else { | |
543 | return $table->[$mid]->[2]; | |
544 | } | |
545 | } | |
546 | ||
cb366075 | 547 | sub _read_table ($;$) { |
3a12600d KW |
548 | |
549 | # Returns the contents of the mktables generated table file located at $1 | |
cb366075 KW |
550 | # in the form of either an array of arrays or a hash, depending on if the |
551 | # optional second parameter is true (for hash return) or not. In the case | |
552 | # of a hash return, each key is a code point, and its corresponding value | |
553 | # is what the table gives as the code point's corresponding value. In the | |
554 | # case of an array return, each outer array denotes a range with [0] the | |
555 | # start point of that range; [1] the end point; and [2] the value that | |
556 | # every code point in the range has. The hash return is useful for fast | |
557 | # lookup when the table contains only single code point ranges. The array | |
558 | # return takes much less memory when there are large ranges. | |
3a12600d | 559 | # |
cb366075 | 560 | # This function has the side effect of setting |
3a12600d KW |
561 | # $utf8::SwashInfo{$property}{'format'} to be the mktables format of the |
562 | # table; and | |
563 | # $utf8::SwashInfo{$property}{'missing'} to be the value for all entries | |
564 | # not listed in the table. | |
565 | # where $property is the Unicode property name, preceded by 'To' for map | |
566 | # properties., e.g., 'ToSc'. | |
567 | # | |
568 | # Table entries look like one of: | |
569 | # 0000 0040 Common # [65] | |
570 | # 00AA Latin | |
571 | ||
572 | my $table = shift; | |
cb366075 KW |
573 | my $return_hash = shift; |
574 | $return_hash = 0 unless defined $return_hash; | |
3a12600d | 575 | my @return; |
cb366075 | 576 | my %return; |
3a12600d | 577 | local $_; |
d11155ec | 578 | my $list = do "unicore/$table"; |
3a12600d | 579 | |
d11155ec KW |
580 | # Look up if this property requires adjustments, which we do below if it |
581 | # does. | |
582 | require "unicore/Heavy.pl"; | |
583 | my $property = $table =~ s/\.pl//r; | |
584 | $property = $utf8::file_to_swash_name{$property}; | |
585 | my $to_adjust = defined $property | |
24303724 | 586 | && $utf8::SwashInfo{$property}{'format'} =~ / ^ a /x; |
d11155ec KW |
587 | |
588 | for (split /^/m, $list) { | |
3a12600d KW |
589 | my ($start, $end, $value) = / ^ (.+?) \t (.*?) \t (.+?) |
590 | \s* ( \# .* )? # Optional comment | |
591 | $ /x; | |
83fd1222 KW |
592 | my $decimal_start = hex $start; |
593 | my $decimal_end = ($end eq "") ? $decimal_start : hex $end; | |
24303724 KW |
594 | $value = hex $value if $to_adjust |
595 | && $utf8::SwashInfo{$property}{'format'} eq 'ax'; | |
cb366075 | 596 | if ($return_hash) { |
83fd1222 | 597 | foreach my $i ($decimal_start .. $decimal_end) { |
d11155ec KW |
598 | $return{$i} = ($to_adjust) |
599 | ? $value + $i - $decimal_start | |
600 | : $value; | |
cb366075 KW |
601 | } |
602 | } | |
d11155ec KW |
603 | elsif (! $to_adjust |
604 | && @return | |
605 | && $return[-1][1] == $decimal_start - 1 | |
9a96c106 KW |
606 | && $return[-1][2] eq $value) |
607 | { | |
608 | # If this is merely extending the previous range, do just that. | |
609 | $return[-1]->[1] = $decimal_end; | |
610 | } | |
cb366075 | 611 | else { |
83fd1222 | 612 | push @return, [ $decimal_start, $decimal_end, $value ]; |
cb366075 | 613 | } |
3a12600d | 614 | } |
cb366075 | 615 | return ($return_hash) ? %return : @return; |
3a12600d KW |
616 | } |
617 | ||
10a6ecd2 JH |
618 | sub charinrange { |
619 | my ($range, $arg) = @_; | |
620 | my $code = _getcode($arg); | |
621 | croak __PACKAGE__, "::charinrange: unknown code '$arg'" | |
622 | unless defined $code; | |
623 | _search($range, 0, $#$range, $code); | |
624 | } | |
625 | ||
12fee290 KW |
626 | =head2 B<charprop()> |
627 | ||
628 | use Unicode::UCD 'charprop'; | |
629 | ||
630 | print charprop(0x41, "Gc"), "\n"; | |
631 | print charprop(0x61, "General_Category"), "\n"; | |
632 | ||
633 | prints | |
634 | Lu | |
635 | Ll | |
636 | ||
637 | This returns the value of the Unicode property given by the second parameter | |
638 | for the L</code point argument> given by the first. | |
639 | ||
640 | The passed-in property may be specified as any of the synonyms returned by | |
641 | L</prop_aliases()>. | |
642 | ||
643 | The return value is always a scalar, either a string or a number. For | |
644 | properties where there are synonyms for the values, the synonym returned by | |
645 | this function is the longest, most descriptive form, the one returned by | |
646 | L</prop_value_aliases()> when called in a scalar context. Of course, you can | |
647 | call L</prop_value_aliases()> on the result to get other synonyms. | |
648 | ||
649 | The return values are more "cooked" than the L</charinfo()> ones. For | |
650 | example, the C<"uc"> property value is the actual string containing the full | |
651 | uppercase mapping of the input code point. You have to go to extra trouble | |
652 | with C<charinfo> to get this value from its C<upper> hash element when the | |
653 | full mapping differs from the simple one. | |
654 | ||
655 | Special note should be made of the return values for a few properties: | |
656 | ||
657 | =over | |
658 | ||
659 | =item Block | |
660 | ||
661 | The value returned is the new-style (see L</Old-style versus new-style block | |
662 | names>). | |
663 | ||
664 | =item Decomposition_Mapping | |
665 | ||
666 | Like L</charinfo()>, the result may be an intermediate decomposition whose | |
667 | components are also decomposable. Use L<Unicode::Normalize> to get the final | |
668 | decomposition in one step. | |
669 | ||
670 | Unlike L</charinfo()>, this does not include the decomposition type. Use the | |
671 | C<Decomposition_Type> property to get that. | |
672 | ||
673 | =item Name_Alias | |
674 | ||
675 | If the input code point's name has more than one synonym, they are returned | |
676 | joined into a single comma-separated string. | |
677 | ||
678 | =item Numeric_Value | |
679 | ||
680 | If the result is a fraction, it is converted into a floating point number to | |
681 | the accuracy of your platform. | |
682 | ||
683 | =item Script_Extensions | |
684 | ||
685 | If the result is multiple script names, they are returned joined into a single | |
686 | comma-separated string. | |
687 | ||
688 | =back | |
689 | ||
690 | When called with a property that is a Perl extension that isn't expressible in | |
691 | a compound form, this function currently returns C<undef>, as the only two | |
692 | possible values are I<true> or I<false> (1 or 0 I suppose). This behavior may | |
693 | change in the future, so don't write code that relies on it. C<Present_In> is | |
694 | a Perl extension that is expressible in a bipartite or compound form (for | |
695 | example, C<\p{Present_In=4.0}>), so C<charprop> accepts it. But C<Any> is a | |
696 | Perl extension that isn't expressible that way, so C<charprop> returns | |
697 | C<undef> for it. Also C<charprop> returns C<undef> for all Perl extensions | |
698 | that are internal-only. | |
699 | ||
700 | =cut | |
701 | ||
702 | sub charprop ($$) { | |
703 | my ($input_cp, $prop) = @_; | |
704 | ||
705 | my $cp = _getcode($input_cp); | |
706 | croak __PACKAGE__, "::charprop: unknown code point '$input_cp'" unless defined $cp; | |
707 | ||
708 | my ($list_ref, $map_ref, $format, $default) | |
709 | = prop_invmap($prop); | |
710 | return undef unless defined $list_ref; | |
711 | ||
712 | my $i = search_invlist($list_ref, $cp); | |
713 | croak __PACKAGE__, "::charprop: prop_invmap return is invalid for charprop('$input_cp', '$prop)" unless defined $i; | |
714 | ||
715 | # $i is the index into both the inversion list and map of $cp. | |
716 | my $map = $map_ref->[$i]; | |
717 | ||
718 | # Convert enumeration values to their most complete form. | |
719 | if (! ref $map) { | |
720 | my $long_form = prop_value_aliases($prop, $map); | |
721 | $map = $long_form if defined $long_form; | |
722 | } | |
723 | ||
724 | if ($format =~ / ^ s /x) { # Scalars | |
725 | return join ",", @$map if ref $map; # Convert to scalar with comma | |
726 | # separated array elements | |
727 | ||
728 | # Resolve ambiguity as to whether an all digit value is a code point | |
729 | # that should be converted to a character, or whether it is really | |
730 | # just a number. To do this, look at the default. If it is a | |
731 | # non-empty number, we can safely assume the result is also a number. | |
732 | if ($map =~ / ^ \d+ $ /ax && $default !~ / ^ \d+ $ /ax) { | |
733 | $map = chr $map; | |
734 | } | |
735 | elsif ($map =~ / ^ (?: Y | N ) $ /x) { | |
736 | ||
737 | # prop_invmap() returns these values for properties that are Perl | |
738 | # extensions. But this is misleading. For now, return undef for | |
739 | # these, as currently documented. | |
740 | undef $map unless | |
741 | exists $Unicode::UCD::prop_aliases{utf8::_loose_name(lc $prop)}; | |
742 | } | |
743 | return $map; | |
744 | } | |
745 | elsif ($format eq 'ar') { # numbers, including rationals | |
746 | my $offset = $cp - $list_ref->[$i]; | |
747 | return $map if $map =~ /nan/i; | |
748 | return $map + $offset if $offset != 0; # If needs adjustment | |
749 | return eval $map; # Convert e.g., 1/2 to 0.5 | |
750 | } | |
751 | elsif ($format =~ /^a/) { # Some entries need adjusting | |
752 | ||
753 | # Linearize sequences into a string. | |
754 | return join "", map { chr $_ } @$map if ref $map; # XXX && $format =~ /^ a [dl] /x; | |
755 | ||
756 | return "" if $map eq "" && $format =~ /^a.*e/; | |
757 | ||
758 | # These are all character mappings. Return the chr if no adjustment | |
759 | # is needed | |
760 | return chr $cp if $map eq "0"; | |
761 | ||
762 | # Convert special entry. | |
763 | if ($map eq '<hangul syllable>' && $format eq 'ad') { | |
764 | use Unicode::Normalize qw(NFD); | |
765 | return NFD(chr $cp); | |
766 | } | |
767 | ||
768 | # The rest need adjustment from the first entry in the inversion list | |
769 | # corresponding to this map. | |
770 | my $offset = $cp - $list_ref->[$i]; | |
771 | return chr($map + $cp - $list_ref->[$i]); | |
772 | } | |
773 | elsif ($format eq 'n') { # The name property | |
774 | ||
775 | # There are two special cases, handled here. | |
776 | if ($map =~ / ( .+ ) <code\ point> $ /x) { | |
777 | $map = sprintf("$1%04X", $cp); | |
778 | } | |
779 | elsif ($map eq '<hangul syllable>') { | |
780 | $map = charnames::viacode($cp); | |
781 | } | |
782 | return $map; | |
783 | } | |
784 | else { | |
785 | croak __PACKAGE__, "::charprop: Internal error: unknown format '$format'. Please perlbug this"; | |
12fee290 KW |
786 | } |
787 | } | |
788 | ||
40416981 KW |
789 | =head2 B<charprops_all()> |
790 | ||
791 | use Unicode::UCD 'charprops_all'; | |
792 | ||
793 | my $%properties_of_A_hash_ref = charprops_all("U+41"); | |
794 | ||
795 | This returns a reference to a hash whose keys are all the distinct Unicode (no | |
796 | Perl extension) properties, and whose values are the respective values for | |
797 | those properties for the input L</code point argument>. | |
798 | ||
799 | Each key is the property name in its longest, most descriptive form. The | |
800 | values are what L</charprop()> would return. | |
801 | ||
802 | This function is expensive in time and memory. | |
803 | ||
804 | =cut | |
805 | ||
806 | sub charprops_all($) { | |
807 | my $input_cp = shift; | |
808 | ||
809 | my $cp = _getcode($input_cp); | |
810 | croak __PACKAGE__, "::charprops_all: unknown code point '$input_cp'" unless defined $cp; | |
811 | ||
812 | my %return; | |
813 | ||
814 | require "unicore/UCD.pl"; | |
815 | ||
816 | foreach my $prop (keys %Unicode::UCD::prop_aliases) { | |
817 | ||
818 | # Don't return a Perl extension. (This is the only one that | |
819 | # %prop_aliases has in it.) | |
820 | next if $prop eq 'perldecimaldigit'; | |
821 | ||
822 | # Use long name for $prop in the hash | |
823 | $return{scalar prop_aliases($prop)} = charprop($cp, $prop); | |
824 | } | |
825 | ||
826 | return \%return; | |
827 | } | |
828 | ||
a452d459 | 829 | =head2 B<charblock()> |
561c79ed | 830 | |
55d7b906 | 831 | use Unicode::UCD 'charblock'; |
561c79ed JH |
832 | |
833 | my $charblock = charblock(0x41); | |
10a6ecd2 | 834 | my $charblock = charblock(1234); |
a452d459 | 835 | my $charblock = charblock(0x263a); |
10a6ecd2 JH |
836 | my $charblock = charblock("U+263a"); |
837 | ||
78bf21c2 | 838 | my $range = charblock('Armenian'); |
10a6ecd2 | 839 | |
53cb2385 | 840 | With a L</code point argument> C<charblock()> returns the I<block> the code point |
430fe03d KW |
841 | belongs to, e.g. C<Basic Latin>. The old-style block name is returned (see |
842 | L</Old-style versus new-style block names>). | |
b08d569e KW |
843 | The L</prop_value_aliases()> function can be used to get all the synonyms |
844 | of the block name. | |
845 | ||
a452d459 | 846 | If the code point is unassigned, this returns the block it would belong to if |
fe252ba7 KW |
847 | it were assigned. (If the Unicode version being used is so early as to not |
848 | have blocks, all code points are considered to be in C<No_Block>.) | |
10a6ecd2 | 849 | |
78bf21c2 JH |
850 | See also L</Blocks versus Scripts>. |
851 | ||
53cb2385 | 852 | If supplied with an argument that can't be a code point, C<charblock()> tries to |
a1ae4420 KW |
853 | do the opposite and interpret the argument as an old-style block name. On an |
854 | ASCII platform, the return value is a I<range set> with one range: an | |
df2b00e8 | 855 | anonymous array with a single element that consists of another anonymous array |
a1ae4420 | 856 | whose first element is the first code point in the block, and whose second |
53cb2385 | 857 | element is the final code point in the block. On an EBCDIC |
a1ae4420 | 858 | platform, the first two Unicode blocks are not contiguous. Their range sets |
53cb2385 | 859 | are lists containing I<start-of-range>, I<end-of-range> code point pairs. You |
a1ae4420 | 860 | can test whether a code point is in a range set using the L</charinrange()> |
53cb2385 KW |
861 | function. (To be precise, each I<range set> contains a third array element, |
862 | after the range boundary ones: the old_style block name.) | |
863 | ||
864 | If the argument to C<charblock()> is not a known block, C<undef> is | |
865 | returned. | |
561c79ed | 866 | |
561c79ed JH |
867 | =cut |
868 | ||
869 | my @BLOCKS; | |
10a6ecd2 | 870 | my %BLOCKS; |
561c79ed | 871 | |
10a6ecd2 | 872 | sub _charblocks { |
06bba7d5 KW |
873 | |
874 | # Can't read from the mktables table because it loses the hyphens in the | |
875 | # original. | |
561c79ed | 876 | unless (@BLOCKS) { |
fe252ba7 KW |
877 | UnicodeVersion() unless defined $v_unicode_version; |
878 | if ($v_unicode_version lt v2.0.0) { | |
879 | my $subrange = [ 0, 0x10FFFF, 'No_Block' ]; | |
880 | push @BLOCKS, $subrange; | |
25503677 | 881 | push @{$BLOCKS{'No_Block'}}, $subrange; |
fe252ba7 KW |
882 | } |
883 | elsif (openunicode(\$BLOCKSFH, "Blocks.txt")) { | |
6c8d78fb | 884 | local $_; |
ce066323 | 885 | local $/ = "\n"; |
10a6ecd2 | 886 | while (<$BLOCKSFH>) { |
0d484900 KW |
887 | |
888 | # Old versions used a different syntax to mark the range. | |
889 | $_ =~ s/;\s+/../ if $v_unicode_version lt v3.1.0; | |
890 | ||
2796c109 | 891 | if (/^([0-9A-F]+)\.\.([0-9A-F]+);\s+(.+)/) { |
10a6ecd2 JH |
892 | my ($lo, $hi) = (hex($1), hex($2)); |
893 | my $subrange = [ $lo, $hi, $3 ]; | |
894 | push @BLOCKS, $subrange; | |
895 | push @{$BLOCKS{$3}}, $subrange; | |
561c79ed JH |
896 | } |
897 | } | |
10a6ecd2 | 898 | close($BLOCKSFH); |
a1ae4420 KW |
899 | if (! IS_ASCII_PLATFORM) { |
900 | # The first two blocks, through 0xFF, are wrong on EBCDIC | |
901 | # platforms. | |
902 | ||
903 | my @new_blocks = _read_table("To/Blk.pl"); | |
904 | ||
905 | # Get rid of the first two ranges in the Unicode version, and | |
906 | # replace them with the ones computed by mktables. | |
907 | shift @BLOCKS; | |
908 | shift @BLOCKS; | |
909 | delete $BLOCKS{'Basic Latin'}; | |
910 | delete $BLOCKS{'Latin-1 Supplement'}; | |
911 | ||
912 | # But there are multiple entries in the computed versions, and | |
913 | # we change their names to (which we know) to be the old-style | |
914 | # ones. | |
915 | for my $i (0.. @new_blocks - 1) { | |
916 | if ($new_blocks[$i][2] =~ s/Basic_Latin/Basic Latin/ | |
917 | or $new_blocks[$i][2] =~ | |
918 | s/Latin_1_Supplement/Latin-1 Supplement/) | |
919 | { | |
920 | push @{$BLOCKS{$new_blocks[$i][2]}}, $new_blocks[$i]; | |
921 | } | |
922 | else { | |
923 | splice @new_blocks, $i; | |
924 | last; | |
925 | } | |
926 | } | |
927 | unshift @BLOCKS, @new_blocks; | |
928 | } | |
561c79ed JH |
929 | } |
930 | } | |
10a6ecd2 JH |
931 | } |
932 | ||
933 | sub charblock { | |
934 | my $arg = shift; | |
935 | ||
936 | _charblocks() unless @BLOCKS; | |
937 | ||
938 | my $code = _getcode($arg); | |
561c79ed | 939 | |
10a6ecd2 | 940 | if (defined $code) { |
c707cf8e KW |
941 | my $result = _search(\@BLOCKS, 0, $#BLOCKS, $code); |
942 | return $result if defined $result; | |
943 | return 'No_Block'; | |
944 | } | |
945 | elsif (exists $BLOCKS{$arg}) { | |
cb3150f5 | 946 | return _dclone $BLOCKS{$arg}; |
10a6ecd2 | 947 | } |
bc37b130 KW |
948 | |
949 | carp __PACKAGE__, "::charblock: unknown code '$arg'"; | |
950 | return; | |
e882dd67 JH |
951 | } |
952 | ||
a452d459 | 953 | =head2 B<charscript()> |
e882dd67 | 954 | |
55d7b906 | 955 | use Unicode::UCD 'charscript'; |
e882dd67 JH |
956 | |
957 | my $charscript = charscript(0x41); | |
10a6ecd2 JH |
958 | my $charscript = charscript(1234); |
959 | my $charscript = charscript("U+263a"); | |
e882dd67 | 960 | |
78bf21c2 | 961 | my $range = charscript('Thai'); |
10a6ecd2 | 962 | |
53cb2385 KW |
963 | With a L</code point argument>, C<charscript()> returns the I<script> the |
964 | code point belongs to, e.g., C<Latin>, C<Greek>, C<Han>. | |
49ea58c8 KW |
965 | If the code point is unassigned or the Unicode version being used is so early |
966 | that it doesn't have scripts, this function returns C<"Unknown">. | |
b08d569e KW |
967 | The L</prop_value_aliases()> function can be used to get all the synonyms |
968 | of the script name. | |
78bf21c2 | 969 | |
48791bf1 KW |
970 | Note that the Script_Extensions property is an improved version of the Script |
971 | property, and you should probably be using that instead, with the | |
972 | L</charprop()> function. | |
973 | ||
eb0cc9e3 | 974 | If supplied with an argument that can't be a code point, charscript() tries |
a18e976f | 975 | to do the opposite and interpret the argument as a script name. The |
df2b00e8 | 976 | return value is a I<range set>: an anonymous array of arrays that contain |
eb0cc9e3 | 977 | I<start-of-range>, I<end-of-range> code point pairs. You can test whether a |
53cb2385 KW |
978 | code point is in a range set using the L</charinrange()> function. |
979 | (To be precise, each I<range set> contains a third array element, | |
980 | after the range boundary ones: the script name.) | |
981 | ||
982 | If the C<charscript()> argument is not a known script, C<undef> is returned. | |
a452d459 KW |
983 | |
984 | See also L</Blocks versus Scripts>. | |
e882dd67 | 985 | |
e882dd67 JH |
986 | =cut |
987 | ||
988 | my @SCRIPTS; | |
10a6ecd2 | 989 | my %SCRIPTS; |
e882dd67 | 990 | |
10a6ecd2 | 991 | sub _charscripts { |
49ea58c8 KW |
992 | unless (@SCRIPTS) { |
993 | UnicodeVersion() unless defined $v_unicode_version; | |
994 | if ($v_unicode_version lt v3.1.0) { | |
995 | push @SCRIPTS, [ 0, 0x10FFFF, 'Unknown' ]; | |
996 | } | |
997 | else { | |
998 | @SCRIPTS =_read_table("To/Sc.pl"); | |
999 | } | |
1000 | } | |
7bccef0b | 1001 | foreach my $entry (@SCRIPTS) { |
f3d50ac9 | 1002 | $entry->[2] =~ s/(_\w)/\L$1/g; # Preserve old-style casing |
7bccef0b | 1003 | push @{$SCRIPTS{$entry->[2]}}, $entry; |
e882dd67 | 1004 | } |
10a6ecd2 JH |
1005 | } |
1006 | ||
1007 | sub charscript { | |
1008 | my $arg = shift; | |
1009 | ||
1010 | _charscripts() unless @SCRIPTS; | |
e882dd67 | 1011 | |
10a6ecd2 JH |
1012 | my $code = _getcode($arg); |
1013 | ||
1014 | if (defined $code) { | |
7bccef0b KW |
1015 | my $result = _search(\@SCRIPTS, 0, $#SCRIPTS, $code); |
1016 | return $result if defined $result; | |
8079ad82 | 1017 | return $utf8::SwashInfo{'ToSc'}{'missing'}; |
7bccef0b | 1018 | } elsif (exists $SCRIPTS{$arg}) { |
cb3150f5 | 1019 | return _dclone $SCRIPTS{$arg}; |
10a6ecd2 | 1020 | } |
7bccef0b | 1021 | |
bc37b130 | 1022 | carp __PACKAGE__, "::charscript: unknown code '$arg'"; |
7bccef0b | 1023 | return; |
10a6ecd2 JH |
1024 | } |
1025 | ||
a452d459 | 1026 | =head2 B<charblocks()> |
10a6ecd2 | 1027 | |
55d7b906 | 1028 | use Unicode::UCD 'charblocks'; |
10a6ecd2 | 1029 | |
b08cd201 | 1030 | my $charblocks = charblocks(); |
10a6ecd2 | 1031 | |
53cb2385 | 1032 | C<charblocks()> returns a reference to a hash with the known block names |
a452d459 | 1033 | as the keys, and the code point ranges (see L</charblock()>) as the values. |
10a6ecd2 | 1034 | |
430fe03d KW |
1035 | The names are in the old-style (see L</Old-style versus new-style block |
1036 | names>). | |
1037 | ||
62b3b855 KW |
1038 | L<prop_invmap("block")|/prop_invmap()> can be used to get this same data in a |
1039 | different type of data structure. | |
1040 | ||
9024667a KW |
1041 | L<prop_values("Block")|/prop_values()> can be used to get all |
1042 | the known new-style block names as a list, without the code point ranges. | |
1043 | ||
78bf21c2 JH |
1044 | See also L</Blocks versus Scripts>. |
1045 | ||
10a6ecd2 JH |
1046 | =cut |
1047 | ||
1048 | sub charblocks { | |
b08cd201 | 1049 | _charblocks() unless %BLOCKS; |
cb3150f5 | 1050 | return _dclone \%BLOCKS; |
10a6ecd2 JH |
1051 | } |
1052 | ||
a452d459 | 1053 | =head2 B<charscripts()> |
10a6ecd2 | 1054 | |
55d7b906 | 1055 | use Unicode::UCD 'charscripts'; |
10a6ecd2 | 1056 | |
ea508aee | 1057 | my $charscripts = charscripts(); |
10a6ecd2 | 1058 | |
53cb2385 | 1059 | C<charscripts()> returns a reference to a hash with the known script |
a452d459 | 1060 | names as the keys, and the code point ranges (see L</charscript()>) as |
ea508aee | 1061 | the values. |
10a6ecd2 | 1062 | |
62b3b855 | 1063 | L<prop_invmap("script")|/prop_invmap()> can be used to get this same data in a |
48791bf1 KW |
1064 | different type of data structure. Since the Script_Extensions property is an |
1065 | improved version of the Script property, you should instead use | |
1066 | L<prop_invmap("scx")|/prop_invmap()>. | |
62b3b855 | 1067 | |
9024667a KW |
1068 | L<C<prop_values("Script")>|/prop_values()> can be used to get all |
1069 | the known script names as a list, without the code point ranges. | |
1070 | ||
78bf21c2 JH |
1071 | See also L</Blocks versus Scripts>. |
1072 | ||
10a6ecd2 JH |
1073 | =cut |
1074 | ||
1075 | sub charscripts { | |
b08cd201 | 1076 | _charscripts() unless %SCRIPTS; |
cb3150f5 | 1077 | return _dclone \%SCRIPTS; |
561c79ed JH |
1078 | } |
1079 | ||
a452d459 | 1080 | =head2 B<charinrange()> |
10a6ecd2 | 1081 | |
f200dd12 | 1082 | In addition to using the C<\p{Blk=...}> and C<\P{Blk=...}> constructs, you |
10a6ecd2 | 1083 | can also test whether a code point is in the I<range> as returned by |
a452d459 | 1084 | L</charblock()> and L</charscript()> or as the values of the hash returned |
53cb2385 | 1085 | by L</charblocks()> and L</charscripts()> by using C<charinrange()>: |
10a6ecd2 | 1086 | |
55d7b906 | 1087 | use Unicode::UCD qw(charscript charinrange); |
10a6ecd2 JH |
1088 | |
1089 | $range = charscript('Hiragana'); | |
e145285f | 1090 | print "looks like hiragana\n" if charinrange($range, $codepoint); |
10a6ecd2 JH |
1091 | |
1092 | =cut | |
1093 | ||
ea508aee JH |
1094 | my %GENERAL_CATEGORIES = |
1095 | ( | |
1096 | 'L' => 'Letter', | |
1097 | 'LC' => 'CasedLetter', | |
1098 | 'Lu' => 'UppercaseLetter', | |
1099 | 'Ll' => 'LowercaseLetter', | |
1100 | 'Lt' => 'TitlecaseLetter', | |
1101 | 'Lm' => 'ModifierLetter', | |
1102 | 'Lo' => 'OtherLetter', | |
1103 | 'M' => 'Mark', | |
1104 | 'Mn' => 'NonspacingMark', | |
1105 | 'Mc' => 'SpacingMark', | |
1106 | 'Me' => 'EnclosingMark', | |
1107 | 'N' => 'Number', | |
1108 | 'Nd' => 'DecimalNumber', | |
1109 | 'Nl' => 'LetterNumber', | |
1110 | 'No' => 'OtherNumber', | |
1111 | 'P' => 'Punctuation', | |
1112 | 'Pc' => 'ConnectorPunctuation', | |
1113 | 'Pd' => 'DashPunctuation', | |
1114 | 'Ps' => 'OpenPunctuation', | |
1115 | 'Pe' => 'ClosePunctuation', | |
1116 | 'Pi' => 'InitialPunctuation', | |
1117 | 'Pf' => 'FinalPunctuation', | |
1118 | 'Po' => 'OtherPunctuation', | |
1119 | 'S' => 'Symbol', | |
1120 | 'Sm' => 'MathSymbol', | |
1121 | 'Sc' => 'CurrencySymbol', | |
1122 | 'Sk' => 'ModifierSymbol', | |
1123 | 'So' => 'OtherSymbol', | |
1124 | 'Z' => 'Separator', | |
1125 | 'Zs' => 'SpaceSeparator', | |
1126 | 'Zl' => 'LineSeparator', | |
1127 | 'Zp' => 'ParagraphSeparator', | |
1128 | 'C' => 'Other', | |
1129 | 'Cc' => 'Control', | |
1130 | 'Cf' => 'Format', | |
1131 | 'Cs' => 'Surrogate', | |
1132 | 'Co' => 'PrivateUse', | |
1133 | 'Cn' => 'Unassigned', | |
1134 | ); | |
1135 | ||
1136 | sub general_categories { | |
cb3150f5 | 1137 | return _dclone \%GENERAL_CATEGORIES; |
ea508aee JH |
1138 | } |
1139 | ||
a452d459 | 1140 | =head2 B<general_categories()> |
ea508aee JH |
1141 | |
1142 | use Unicode::UCD 'general_categories'; | |
1143 | ||
1144 | my $categories = general_categories(); | |
1145 | ||
a452d459 | 1146 | This returns a reference to a hash which has short |
ea508aee JH |
1147 | general category names (such as C<Lu>, C<Nd>, C<Zs>, C<S>) as keys and long |
1148 | names (such as C<UppercaseLetter>, C<DecimalNumber>, C<SpaceSeparator>, | |
1149 | C<Symbol>) as values. The hash is reversible in case you need to go | |
1150 | from the long names to the short names. The general category is the | |
a452d459 KW |
1151 | one returned from |
1152 | L</charinfo()> under the C<category> key. | |
ea508aee | 1153 | |
9024667a KW |
1154 | The L</prop_values()> and L</prop_value_aliases()> functions can be used as an |
1155 | alternative to this function; the first returning a simple list of the short | |
1156 | category names; and the second gets all the synonyms of a given category name. | |
7ef25837 | 1157 | |
ea508aee JH |
1158 | =cut |
1159 | ||
1160 | my %BIDI_TYPES = | |
1161 | ( | |
1162 | 'L' => 'Left-to-Right', | |
1163 | 'LRE' => 'Left-to-Right Embedding', | |
1164 | 'LRO' => 'Left-to-Right Override', | |
1165 | 'R' => 'Right-to-Left', | |
1166 | 'AL' => 'Right-to-Left Arabic', | |
1167 | 'RLE' => 'Right-to-Left Embedding', | |
1168 | 'RLO' => 'Right-to-Left Override', | |
1169 | 'PDF' => 'Pop Directional Format', | |
1170 | 'EN' => 'European Number', | |
1171 | 'ES' => 'European Number Separator', | |
1172 | 'ET' => 'European Number Terminator', | |
1173 | 'AN' => 'Arabic Number', | |
1174 | 'CS' => 'Common Number Separator', | |
1175 | 'NSM' => 'Non-Spacing Mark', | |
1176 | 'BN' => 'Boundary Neutral', | |
1177 | 'B' => 'Paragraph Separator', | |
1178 | 'S' => 'Segment Separator', | |
1179 | 'WS' => 'Whitespace', | |
1180 | 'ON' => 'Other Neutrals', | |
1181 | ); | |
1182 | ||
a452d459 | 1183 | =head2 B<bidi_types()> |
ea508aee JH |
1184 | |
1185 | use Unicode::UCD 'bidi_types'; | |
1186 | ||
1187 | my $categories = bidi_types(); | |
1188 | ||
a452d459 | 1189 | This returns a reference to a hash which has the short |
ea508aee JH |
1190 | bidi (bidirectional) type names (such as C<L>, C<R>) as keys and long |
1191 | names (such as C<Left-to-Right>, C<Right-to-Left>) as values. The | |
1192 | hash is reversible in case you need to go from the long names to the | |
a452d459 KW |
1193 | short names. The bidi type is the one returned from |
1194 | L</charinfo()> | |
ea508aee JH |
1195 | under the C<bidi> key. For the exact meaning of the various bidi classes |
1196 | the Unicode TR9 is recommended reading: | |
a452d459 | 1197 | L<http://www.unicode.org/reports/tr9/> |
ea508aee JH |
1198 | (as of Unicode 5.0.0) |
1199 | ||
9024667a KW |
1200 | The L</prop_values()> and L</prop_value_aliases()> functions can be used as an |
1201 | alternative to this function; the first returning a simple list of the short | |
1202 | bidi type names; and the second gets all the synonyms of a given bidi type | |
1203 | name. | |
7ef25837 | 1204 | |
ea508aee JH |
1205 | =cut |
1206 | ||
a452d459 | 1207 | sub bidi_types { |
cb3150f5 | 1208 | return _dclone \%BIDI_TYPES; |
a452d459 KW |
1209 | } |
1210 | ||
1211 | =head2 B<compexcl()> | |
b08cd201 | 1212 | |
b0e24409 | 1213 | WARNING: Unicode discourages the use of this function or any of the |
816b0b09 | 1214 | alternative mechanisms listed in this section (the documentation of |
b0e24409 KW |
1215 | C<compexcl()>), except internally in implementations of the Unicode |
1216 | Normalization Algorithm. You should be using L<Unicode::Normalize> directly | |
1217 | instead of these. Using these will likely lead to half-baked results. | |
1218 | ||
55d7b906 | 1219 | use Unicode::UCD 'compexcl'; |
b08cd201 | 1220 | |
a452d459 | 1221 | my $compexcl = compexcl(0x09dc); |
b08cd201 | 1222 | |
2afba6a4 | 1223 | This routine returns C<undef> if the Unicode version being used is so early |
53cb2385 KW |
1224 | that it doesn't have this property. |
1225 | ||
1226 | C<compexcl()> is included for backwards | |
2afba6a4 | 1227 | compatibility, but as of Perl 5.12 and more modern Unicode versions, for |
71a442a8 KW |
1228 | most purposes it is probably more convenient to use one of the following |
1229 | instead: | |
1230 | ||
1231 | my $compexcl = chr(0x09dc) =~ /\p{Comp_Ex}; | |
1232 | my $compexcl = chr(0x09dc) =~ /\p{Full_Composition_Exclusion}; | |
1233 | ||
1234 | or even | |
1235 | ||
1236 | my $compexcl = chr(0x09dc) =~ /\p{CE}; | |
1237 | my $compexcl = chr(0x09dc) =~ /\p{Composition_Exclusion}; | |
1238 | ||
1239 | The first two forms return B<true> if the L</code point argument> should not | |
76b05678 KW |
1240 | be produced by composition normalization. For the final two forms to return |
1241 | B<true>, it is additionally required that this fact not otherwise be | |
1242 | determinable from the Unicode data base. | |
71a442a8 KW |
1243 | |
1244 | This routine behaves identically to the final two forms. That is, | |
1245 | it does not return B<true> if the code point has a decomposition | |
a452d459 KW |
1246 | consisting of another single code point, nor if its decomposition starts |
1247 | with a code point whose combining class is non-zero. Code points that meet | |
1248 | either of these conditions should also not be produced by composition | |
71a442a8 KW |
1249 | normalization, which is probably why you should use the |
1250 | C<Full_Composition_Exclusion> property instead, as shown above. | |
b08cd201 | 1251 | |
71a442a8 | 1252 | The routine returns B<false> otherwise. |
b08cd201 JH |
1253 | |
1254 | =cut | |
1255 | ||
f7598639 KW |
1256 | # Eval'd so can run on versions earlier than the property is available in |
1257 | my $Composition_Exclusion_re = eval 'qr/\p{Composition_Exclusion}/'; | |
1258 | ||
b08cd201 JH |
1259 | sub compexcl { |
1260 | my $arg = shift; | |
1261 | my $code = _getcode($arg); | |
74f8133e JH |
1262 | croak __PACKAGE__, "::compexcl: unknown code '$arg'" |
1263 | unless defined $code; | |
b08cd201 | 1264 | |
2afba6a4 KW |
1265 | UnicodeVersion() unless defined $v_unicode_version; |
1266 | return if $v_unicode_version lt v3.0.0; | |
1267 | ||
36c2430c | 1268 | no warnings "non_unicode"; # So works on non-Unicode code points |
f7598639 | 1269 | return chr($code) =~ $Composition_Exclusion_re |
b08cd201 JH |
1270 | } |
1271 | ||
a452d459 | 1272 | =head2 B<casefold()> |
b08cd201 | 1273 | |
55d7b906 | 1274 | use Unicode::UCD 'casefold'; |
b08cd201 | 1275 | |
a452d459 KW |
1276 | my $casefold = casefold(0xDF); |
1277 | if (defined $casefold) { | |
1278 | my @full_fold_hex = split / /, $casefold->{'full'}; | |
1279 | my $full_fold_string = | |
1280 | join "", map {chr(hex($_))} @full_fold_hex; | |
1281 | my @turkic_fold_hex = | |
1282 | split / /, ($casefold->{'turkic'} ne "") | |
1283 | ? $casefold->{'turkic'} | |
1284 | : $casefold->{'full'}; | |
1285 | my $turkic_fold_string = | |
1286 | join "", map {chr(hex($_))} @turkic_fold_hex; | |
1287 | } | |
1288 | if (defined $casefold && $casefold->{'simple'} ne "") { | |
1289 | my $simple_fold_hex = $casefold->{'simple'}; | |
1290 | my $simple_fold_string = chr(hex($simple_fold_hex)); | |
1291 | } | |
b08cd201 | 1292 | |
a452d459 | 1293 | This returns the (almost) locale-independent case folding of the |
6329003c KW |
1294 | character specified by the L</code point argument>. (Starting in Perl v5.16, |
1295 | the core function C<fc()> returns the C<full> mapping (described below) | |
1296 | faster than this does, and for entire strings.) | |
b08cd201 | 1297 | |
6329003c | 1298 | If there is no case folding for the input code point, C<undef> is returned. |
a452d459 KW |
1299 | |
1300 | If there is a case folding for that code point, a reference to a hash | |
b08cd201 JH |
1301 | with the following fields is returned: |
1302 | ||
a452d459 KW |
1303 | =over |
1304 | ||
1305 | =item B<code> | |
1306 | ||
a1ae4420 KW |
1307 | the input native L</code point argument> expressed in hexadecimal, with |
1308 | leading zeros | |
a452d459 KW |
1309 | added if necessary to make it contain at least four hexdigits |
1310 | ||
1311 | =item B<full> | |
1312 | ||
a18e976f | 1313 | one or more codes (separated by spaces) that, taken in order, give the |
a452d459 KW |
1314 | code points for the case folding for I<code>. |
1315 | Each has at least four hexdigits. | |
1316 | ||
1317 | =item B<simple> | |
1318 | ||
1319 | is empty, or is exactly one code with at least four hexdigits which can be used | |
1320 | as an alternative case folding when the calling program cannot cope with the | |
1321 | fold being a sequence of multiple code points. If I<full> is just one code | |
1322 | point, then I<simple> equals I<full>. If there is no single code point folding | |
1323 | defined for I<code>, then I<simple> is the empty string. Otherwise, it is an | |
1324 | inferior, but still better-than-nothing alternative folding to I<full>. | |
1325 | ||
1326 | =item B<mapping> | |
1327 | ||
1328 | is the same as I<simple> if I<simple> is not empty, and it is the same as I<full> | |
1329 | otherwise. It can be considered to be the simplest possible folding for | |
1330 | I<code>. It is defined primarily for backwards compatibility. | |
1331 | ||
1332 | =item B<status> | |
b08cd201 | 1333 | |
a452d459 KW |
1334 | is C<C> (for C<common>) if the best possible fold is a single code point |
1335 | (I<simple> equals I<full> equals I<mapping>). It is C<S> if there are distinct | |
1336 | folds, I<simple> and I<full> (I<mapping> equals I<simple>). And it is C<F> if | |
a18e976f KW |
1337 | there is only a I<full> fold (I<mapping> equals I<full>; I<simple> is empty). |
1338 | Note that this | |
a452d459 KW |
1339 | describes the contents of I<mapping>. It is defined primarily for backwards |
1340 | compatibility. | |
b08cd201 | 1341 | |
6329003c | 1342 | For Unicode versions between 3.1 and 3.1.1 inclusive, I<status> can also be |
a452d459 KW |
1343 | C<I> which is the same as C<C> but is a special case for dotted uppercase I and |
1344 | dotless lowercase i: | |
b08cd201 | 1345 | |
a452d459 | 1346 | =over |
b08cd201 | 1347 | |
f703fc96 | 1348 | =item Z<>B<*> If you use this C<I> mapping |
a452d459 | 1349 | |
a18e976f | 1350 | the result is case-insensitive, |
a452d459 KW |
1351 | but dotless and dotted I's are not distinguished |
1352 | ||
f703fc96 | 1353 | =item Z<>B<*> If you exclude this C<I> mapping |
a452d459 | 1354 | |
a18e976f | 1355 | the result is not fully case-insensitive, but |
a452d459 KW |
1356 | dotless and dotted I's are distinguished |
1357 | ||
1358 | =back | |
1359 | ||
1360 | =item B<turkic> | |
1361 | ||
1362 | contains any special folding for Turkic languages. For versions of Unicode | |
1363 | starting with 3.2, this field is empty unless I<code> has a different folding | |
1364 | in Turkic languages, in which case it is one or more codes (separated by | |
a18e976f | 1365 | spaces) that, taken in order, give the code points for the case folding for |
a452d459 KW |
1366 | I<code> in those languages. |
1367 | Each code has at least four hexdigits. | |
1368 | Note that this folding does not maintain canonical equivalence without | |
1369 | additional processing. | |
1370 | ||
6329003c KW |
1371 | For Unicode versions between 3.1 and 3.1.1 inclusive, this field is empty unless |
1372 | there is a | |
a452d459 KW |
1373 | special folding for Turkic languages, in which case I<status> is C<I>, and |
1374 | I<mapping>, I<full>, I<simple>, and I<turkic> are all equal. | |
1375 | ||
1376 | =back | |
1377 | ||
1378 | Programs that want complete generality and the best folding results should use | |
1379 | the folding contained in the I<full> field. But note that the fold for some | |
1380 | code points will be a sequence of multiple code points. | |
1381 | ||
1382 | Programs that can't cope with the fold mapping being multiple code points can | |
1383 | use the folding contained in the I<simple> field, with the loss of some | |
1384 | generality. In Unicode 5.1, about 7% of the defined foldings have no single | |
1385 | code point folding. | |
1386 | ||
1387 | The I<mapping> and I<status> fields are provided for backwards compatibility for | |
1388 | existing programs. They contain the same values as in previous versions of | |
1389 | this function. | |
1390 | ||
1391 | Locale is not completely independent. The I<turkic> field contains results to | |
1392 | use when the locale is a Turkic language. | |
b08cd201 JH |
1393 | |
1394 | For more information about case mappings see | |
a452d459 | 1395 | L<http://www.unicode.org/unicode/reports/tr21> |
b08cd201 JH |
1396 | |
1397 | =cut | |
1398 | ||
1399 | my %CASEFOLD; | |
1400 | ||
1401 | sub _casefold { | |
727c62ff KW |
1402 | unless (%CASEFOLD) { # Populate the hash |
1403 | my ($full_invlist_ref, $full_invmap_ref, undef, $default) | |
1404 | = prop_invmap('Case_Folding'); | |
1405 | ||
1406 | # Use the recipe given in the prop_invmap() pod to convert the | |
1407 | # inversion map into the hash. | |
1408 | for my $i (0 .. @$full_invlist_ref - 1 - 1) { | |
1409 | next if $full_invmap_ref->[$i] == $default; | |
1410 | my $adjust = -1; | |
1411 | for my $j ($full_invlist_ref->[$i] .. $full_invlist_ref->[$i+1] -1) { | |
1412 | $adjust++; | |
1413 | if (! ref $full_invmap_ref->[$i]) { | |
1414 | ||
1415 | # This is a single character mapping | |
1416 | $CASEFOLD{$j}{'status'} = 'C'; | |
1417 | $CASEFOLD{$j}{'simple'} | |
1418 | = $CASEFOLD{$j}{'full'} | |
1419 | = $CASEFOLD{$j}{'mapping'} | |
1420 | = sprintf("%04X", $full_invmap_ref->[$i] + $adjust); | |
1421 | $CASEFOLD{$j}{'code'} = sprintf("%04X", $j); | |
1422 | $CASEFOLD{$j}{'turkic'} = ""; | |
1423 | } | |
1424 | else { # prop_invmap ensures that $adjust is 0 for a ref | |
1425 | $CASEFOLD{$j}{'status'} = 'F'; | |
1426 | $CASEFOLD{$j}{'full'} | |
1427 | = $CASEFOLD{$j}{'mapping'} | |
1428 | = join " ", map { sprintf "%04X", $_ } | |
1429 | @{$full_invmap_ref->[$i]}; | |
1430 | $CASEFOLD{$j}{'simple'} = ""; | |
1431 | $CASEFOLD{$j}{'code'} = sprintf("%04X", $j); | |
1432 | $CASEFOLD{$j}{'turkic'} = ""; | |
1433 | } | |
1434 | } | |
1435 | } | |
1436 | ||
1437 | # We have filled in the full mappings above, assuming there were no | |
1438 | # simple ones for the ones with multi-character maps. Now, we find | |
1439 | # and fix the cases where that assumption was false. | |
1440 | (my ($simple_invlist_ref, $simple_invmap_ref, undef), $default) | |
1441 | = prop_invmap('Simple_Case_Folding'); | |
1442 | for my $i (0 .. @$simple_invlist_ref - 1 - 1) { | |
1443 | next if $simple_invmap_ref->[$i] == $default; | |
1444 | my $adjust = -1; | |
1445 | for my $j ($simple_invlist_ref->[$i] | |
1446 | .. $simple_invlist_ref->[$i+1] -1) | |
1447 | { | |
1448 | $adjust++; | |
1449 | next if $CASEFOLD{$j}{'status'} eq 'C'; | |
1450 | $CASEFOLD{$j}{'status'} = 'S'; | |
1451 | $CASEFOLD{$j}{'simple'} | |
1452 | = $CASEFOLD{$j}{'mapping'} | |
1453 | = sprintf("%04X", $simple_invmap_ref->[$i] + $adjust); | |
1454 | $CASEFOLD{$j}{'code'} = sprintf("%04X", $j); | |
1455 | $CASEFOLD{$j}{'turkic'} = ""; | |
1456 | } | |
1457 | } | |
1458 | ||
1459 | # We hard-code in the turkish rules | |
1460 | UnicodeVersion() unless defined $v_unicode_version; | |
1461 | if ($v_unicode_version ge v3.2.0) { | |
1462 | ||
1463 | # These two code points should already have regular entries, so | |
1464 | # just fill in the turkish fields | |
1465 | $CASEFOLD{ord('I')}{'turkic'} = '0131'; | |
1466 | $CASEFOLD{0x130}{'turkic'} = sprintf "%04X", ord('i'); | |
1467 | } | |
1468 | elsif ($v_unicode_version ge v3.1.0) { | |
1469 | ||
1470 | # These two code points don't have entries otherwise. | |
1471 | $CASEFOLD{0x130}{'code'} = '0130'; | |
1472 | $CASEFOLD{0x131}{'code'} = '0131'; | |
1473 | $CASEFOLD{0x130}{'status'} = $CASEFOLD{0x131}{'status'} = 'I'; | |
1474 | $CASEFOLD{0x130}{'turkic'} | |
1475 | = $CASEFOLD{0x130}{'mapping'} | |
1476 | = $CASEFOLD{0x130}{'full'} | |
1477 | = $CASEFOLD{0x130}{'simple'} | |
1478 | = $CASEFOLD{0x131}{'turkic'} | |
1479 | = $CASEFOLD{0x131}{'mapping'} | |
1480 | = $CASEFOLD{0x131}{'full'} | |
1481 | = $CASEFOLD{0x131}{'simple'} | |
1482 | = sprintf "%04X", ord('i'); | |
1483 | } | |
b08cd201 JH |
1484 | } |
1485 | } | |
1486 | ||
1487 | sub casefold { | |
1488 | my $arg = shift; | |
1489 | my $code = _getcode($arg); | |
74f8133e JH |
1490 | croak __PACKAGE__, "::casefold: unknown code '$arg'" |
1491 | unless defined $code; | |
b08cd201 JH |
1492 | |
1493 | _casefold() unless %CASEFOLD; | |
1494 | ||
1495 | return $CASEFOLD{$code}; | |
1496 | } | |
1497 | ||
66aa79e2 KW |
1498 | =head2 B<all_casefolds()> |
1499 | ||
1500 | ||
1501 | use Unicode::UCD 'all_casefolds'; | |
1502 | ||
1503 | my $all_folds_ref = all_casefolds(); | |
1504 | foreach my $char_with_casefold (sort { $a <=> $b } | |
1505 | keys %$all_folds_ref) | |
1506 | { | |
1507 | printf "%04X:", $char_with_casefold; | |
1508 | my $casefold = $all_folds_ref->{$char_with_casefold}; | |
1509 | ||
1510 | # Get folds for $char_with_casefold | |
1511 | ||
1512 | my @full_fold_hex = split / /, $casefold->{'full'}; | |
1513 | my $full_fold_string = | |
1514 | join "", map {chr(hex($_))} @full_fold_hex; | |
1515 | print " full=", join " ", @full_fold_hex; | |
1516 | my @turkic_fold_hex = | |
1517 | split / /, ($casefold->{'turkic'} ne "") | |
1518 | ? $casefold->{'turkic'} | |
1519 | : $casefold->{'full'}; | |
1520 | my $turkic_fold_string = | |
1521 | join "", map {chr(hex($_))} @turkic_fold_hex; | |
1522 | print "; turkic=", join " ", @turkic_fold_hex; | |
1523 | if (defined $casefold && $casefold->{'simple'} ne "") { | |
1524 | my $simple_fold_hex = $casefold->{'simple'}; | |
1525 | my $simple_fold_string = chr(hex($simple_fold_hex)); | |
1526 | print "; simple=$simple_fold_hex"; | |
1527 | } | |
1528 | print "\n"; | |
1529 | } | |
1530 | ||
1531 | This returns all the case foldings in the current version of Unicode in the | |
1532 | form of a reference to a hash. Each key to the hash is the decimal | |
1533 | representation of a Unicode character that has a casefold to other than | |
1534 | itself. The casefold of a semi-colon is itself, so it isn't in the hash; | |
1535 | likewise for a lowercase "a", but there is an entry for a capital "A". The | |
1536 | hash value for each key is another hash, identical to what is returned by | |
1537 | L</casefold()> if called with that code point as its argument. So the value | |
1538 | C<< all_casefolds()->{ord("A")}' >> is equivalent to C<casefold(ord("A"))>; | |
1539 | ||
1540 | =cut | |
1541 | ||
1542 | sub all_casefolds () { | |
1543 | _casefold() unless %CASEFOLD; | |
1544 | return _dclone \%CASEFOLD; | |
1545 | } | |
1546 | ||
a452d459 | 1547 | =head2 B<casespec()> |
b08cd201 | 1548 | |
55d7b906 | 1549 | use Unicode::UCD 'casespec'; |
b08cd201 | 1550 | |
a452d459 | 1551 | my $casespec = casespec(0xFB00); |
b08cd201 | 1552 | |
a452d459 KW |
1553 | This returns the potentially locale-dependent case mappings of the L</code point |
1554 | argument>. The mappings may be longer than a single code point (which the basic | |
1555 | Unicode case mappings as returned by L</charinfo()> never are). | |
b08cd201 | 1556 | |
a452d459 KW |
1557 | If there are no case mappings for the L</code point argument>, or if all three |
1558 | possible mappings (I<lower>, I<title> and I<upper>) result in single code | |
a18e976f | 1559 | points and are locale independent and unconditional, C<undef> is returned |
5d8e6e41 KW |
1560 | (which means that the case mappings, if any, for the code point are those |
1561 | returned by L</charinfo()>). | |
a452d459 KW |
1562 | |
1563 | Otherwise, a reference to a hash giving the mappings (or a reference to a hash | |
5d8e6e41 KW |
1564 | of such hashes, explained below) is returned with the following keys and their |
1565 | meanings: | |
a452d459 KW |
1566 | |
1567 | The keys in the bottom layer hash with the meanings of their values are: | |
1568 | ||
1569 | =over | |
1570 | ||
1571 | =item B<code> | |
1572 | ||
a1ae4420 KW |
1573 | the input native L</code point argument> expressed in hexadecimal, with |
1574 | leading zeros | |
a452d459 KW |
1575 | added if necessary to make it contain at least four hexdigits |
1576 | ||
1577 | =item B<lower> | |
1578 | ||
a18e976f | 1579 | one or more codes (separated by spaces) that, taken in order, give the |
a452d459 KW |
1580 | code points for the lower case of I<code>. |
1581 | Each has at least four hexdigits. | |
1582 | ||
1583 | =item B<title> | |
b08cd201 | 1584 | |
a18e976f | 1585 | one or more codes (separated by spaces) that, taken in order, give the |
a452d459 KW |
1586 | code points for the title case of I<code>. |
1587 | Each has at least four hexdigits. | |
b08cd201 | 1588 | |
d2da20e3 | 1589 | =item B<upper> |
b08cd201 | 1590 | |
a18e976f | 1591 | one or more codes (separated by spaces) that, taken in order, give the |
a452d459 KW |
1592 | code points for the upper case of I<code>. |
1593 | Each has at least four hexdigits. | |
1594 | ||
1595 | =item B<condition> | |
1596 | ||
1597 | the conditions for the mappings to be valid. | |
a18e976f | 1598 | If C<undef>, the mappings are always valid. |
a452d459 KW |
1599 | When defined, this field is a list of conditions, |
1600 | all of which must be true for the mappings to be valid. | |
1601 | The list consists of one or more | |
1602 | I<locales> (see below) | |
1603 | and/or I<contexts> (explained in the next paragraph), | |
1604 | separated by spaces. | |
1605 | (Other than as used to separate elements, spaces are to be ignored.) | |
1606 | Case distinctions in the condition list are not significant. | |
82c0b05b | 1607 | Conditions preceded by "NON_" represent the negation of the condition. |
b08cd201 | 1608 | |
a452d459 KW |
1609 | A I<context> is one of those defined in the Unicode standard. |
1610 | For Unicode 5.1, they are defined in Section 3.13 C<Default Case Operations> | |
1611 | available at | |
5d8e6e41 KW |
1612 | L<http://www.unicode.org/versions/Unicode5.1.0/>. |
1613 | These are for context-sensitive casing. | |
f499c386 | 1614 | |
a452d459 KW |
1615 | =back |
1616 | ||
5d8e6e41 | 1617 | The hash described above is returned for locale-independent casing, where |
a18e976f | 1618 | at least one of the mappings has length longer than one. If C<undef> is |
5d8e6e41 KW |
1619 | returned, the code point may have mappings, but if so, all are length one, |
1620 | and are returned by L</charinfo()>. | |
1621 | Note that when this function does return a value, it will be for the complete | |
1622 | set of mappings for a code point, even those whose length is one. | |
1623 | ||
1624 | If there are additional casing rules that apply only in certain locales, | |
1625 | an additional key for each will be defined in the returned hash. Each such key | |
1626 | will be its locale name, defined as a 2-letter ISO 3166 country code, possibly | |
1627 | followed by a "_" and a 2-letter ISO language code (possibly followed by a "_" | |
1628 | and a variant code). You can find the lists of all possible locales, see | |
1629 | L<Locale::Country> and L<Locale::Language>. | |
89e4a205 | 1630 | (In Unicode 6.0, the only locales returned by this function |
a452d459 | 1631 | are C<lt>, C<tr>, and C<az>.) |
b08cd201 | 1632 | |
5d8e6e41 KW |
1633 | Each locale key is a reference to a hash that has the form above, and gives |
1634 | the casing rules for that particular locale, which take precedence over the | |
1635 | locale-independent ones when in that locale. | |
1636 | ||
1637 | If the only casing for a code point is locale-dependent, then the returned | |
1638 | hash will not have any of the base keys, like C<code>, C<upper>, etc., but | |
1639 | will contain only locale keys. | |
1640 | ||
b08cd201 | 1641 | For more information about case mappings see |
a452d459 | 1642 | L<http://www.unicode.org/unicode/reports/tr21/> |
b08cd201 JH |
1643 | |
1644 | =cut | |
1645 | ||
1646 | my %CASESPEC; | |
1647 | ||
1648 | sub _casespec { | |
1649 | unless (%CASESPEC) { | |
f033d3cd KW |
1650 | UnicodeVersion() unless defined $v_unicode_version; |
1651 | if ($v_unicode_version lt v2.1.8) { | |
1652 | %CASESPEC = {}; | |
1653 | } | |
1654 | elsif (openunicode(\$CASESPECFH, "SpecialCasing.txt")) { | |
6c8d78fb | 1655 | local $_; |
ce066323 | 1656 | local $/ = "\n"; |
b08cd201 JH |
1657 | while (<$CASESPECFH>) { |
1658 | if (/^([0-9A-F]+); ([0-9A-F]+(?: [0-9A-F]+)*)?; ([0-9A-F]+(?: [0-9A-F]+)*)?; ([0-9A-F]+(?: [0-9A-F]+)*)?; (\w+(?: \w+)*)?/) { | |
f033d3cd | 1659 | |
f499c386 JH |
1660 | my ($hexcode, $lower, $title, $upper, $condition) = |
1661 | ($1, $2, $3, $4, $5); | |
a1ae4420 KW |
1662 | if (! IS_ASCII_PLATFORM) { # Remap entry to native |
1663 | foreach my $var_ref (\$hexcode, | |
1664 | \$lower, | |
1665 | \$title, | |
1666 | \$upper) | |
1667 | { | |
1668 | next unless defined $$var_ref; | |
1669 | $$var_ref = join " ", | |
1670 | map { sprintf("%04X", | |
1671 | utf8::unicode_to_native(hex $_)) } | |
1672 | split " ", $$var_ref; | |
1673 | } | |
1674 | } | |
1675 | ||
f499c386 | 1676 | my $code = hex($hexcode); |
f033d3cd KW |
1677 | |
1678 | # In 2.1.8, there were duplicate entries; ignore all but | |
1679 | # the first one -- there were no conditions in the file | |
1680 | # anyway. | |
1681 | if (exists $CASESPEC{$code} && $v_unicode_version ne v2.1.8) | |
1682 | { | |
f499c386 JH |
1683 | if (exists $CASESPEC{$code}->{code}) { |
1684 | my ($oldlower, | |
1685 | $oldtitle, | |
1686 | $oldupper, | |
1687 | $oldcondition) = | |
1688 | @{$CASESPEC{$code}}{qw(lower | |
1689 | title | |
1690 | upper | |
1691 | condition)}; | |
822ebcc8 JH |
1692 | if (defined $oldcondition) { |
1693 | my ($oldlocale) = | |
f499c386 | 1694 | ($oldcondition =~ /^([a-z][a-z](?:_\S+)?)/); |
f499c386 JH |
1695 | delete $CASESPEC{$code}; |
1696 | $CASESPEC{$code}->{$oldlocale} = | |
1697 | { code => $hexcode, | |
1698 | lower => $oldlower, | |
1699 | title => $oldtitle, | |
1700 | upper => $oldupper, | |
1701 | condition => $oldcondition }; | |
f499c386 JH |
1702 | } |
1703 | } | |
1704 | my ($locale) = | |
1705 | ($condition =~ /^([a-z][a-z](?:_\S+)?)/); | |
1706 | $CASESPEC{$code}->{$locale} = | |
1707 | { code => $hexcode, | |
1708 | lower => $lower, | |
1709 | title => $title, | |
1710 | upper => $upper, | |
1711 | condition => $condition }; | |
1712 | } else { | |
1713 | $CASESPEC{$code} = | |
1714 | { code => $hexcode, | |
1715 | lower => $lower, | |
1716 | title => $title, | |
1717 | upper => $upper, | |
1718 | condition => $condition }; | |
1719 | } | |
b08cd201 JH |
1720 | } |
1721 | } | |
1722 | close($CASESPECFH); | |
1723 | } | |
1724 | } | |
1725 | } | |
1726 | ||
1727 | sub casespec { | |
1728 | my $arg = shift; | |
1729 | my $code = _getcode($arg); | |
74f8133e JH |
1730 | croak __PACKAGE__, "::casespec: unknown code '$arg'" |
1731 | unless defined $code; | |
b08cd201 JH |
1732 | |
1733 | _casespec() unless %CASESPEC; | |
1734 | ||
cb3150f5 | 1735 | return ref $CASESPEC{$code} ? _dclone $CASESPEC{$code} : $CASESPEC{$code}; |
b08cd201 JH |
1736 | } |
1737 | ||
a452d459 | 1738 | =head2 B<namedseq()> |
a2bd7410 JH |
1739 | |
1740 | use Unicode::UCD 'namedseq'; | |
1741 | ||
1742 | my $namedseq = namedseq("KATAKANA LETTER AINU P"); | |
1743 | my @namedseq = namedseq("KATAKANA LETTER AINU P"); | |
1744 | my %namedseq = namedseq(); | |
1745 | ||
1746 | If used with a single argument in a scalar context, returns the string | |
a18e976f | 1747 | consisting of the code points of the named sequence, or C<undef> if no |
a2bd7410 | 1748 | named sequence by that name exists. If used with a single argument in |
53cb2385 KW |
1749 | a list context, it returns the list of the ordinals of the code points. |
1750 | ||
1751 | If used with no | |
1752 | arguments in a list context, it returns a hash with the names of all the | |
1753 | named sequences as the keys and their sequences as strings as | |
a18e976f | 1754 | the values. Otherwise, it returns C<undef> or an empty list depending |
a2bd7410 JH |
1755 | on the context. |
1756 | ||
a452d459 KW |
1757 | This function only operates on officially approved (not provisional) named |
1758 | sequences. | |
a2bd7410 | 1759 | |
27f853a0 KW |
1760 | Note that as of Perl 5.14, C<\N{KATAKANA LETTER AINU P}> will insert the named |
1761 | sequence into double-quoted strings, and C<charnames::string_vianame("KATAKANA | |
1762 | LETTER AINU P")> will return the same string this function does, but will also | |
1763 | operate on character names that aren't named sequences, without you having to | |
1764 | know which are which. See L<charnames>. | |
1765 | ||
a2bd7410 JH |
1766 | =cut |
1767 | ||
1768 | my %NAMEDSEQ; | |
1769 | ||
1770 | sub _namedseq { | |
1771 | unless (%NAMEDSEQ) { | |
98ef7649 | 1772 | if (openunicode(\$NAMEDSEQFH, "Name.pl")) { |
a2bd7410 | 1773 | local $_; |
ce066323 | 1774 | local $/ = "\n"; |
a2bd7410 | 1775 | while (<$NAMEDSEQFH>) { |
98ef7649 KW |
1776 | if (/^ [0-9A-F]+ \ /x) { |
1777 | chomp; | |
1778 | my ($sequence, $name) = split /\t/; | |
1779 | my @s = map { chr(hex($_)) } split(' ', $sequence); | |
1780 | $NAMEDSEQ{$name} = join("", @s); | |
a2bd7410 JH |
1781 | } |
1782 | } | |
1783 | close($NAMEDSEQFH); | |
1784 | } | |
1785 | } | |
1786 | } | |
1787 | ||
1788 | sub namedseq { | |
98ef7649 KW |
1789 | |
1790 | # Use charnames::string_vianame() which now returns this information, | |
1791 | # unless the caller wants the hash returned, in which case we read it in, | |
1792 | # and thereafter use it instead of calling charnames, as it is faster. | |
1793 | ||
a2bd7410 JH |
1794 | my $wantarray = wantarray(); |
1795 | if (defined $wantarray) { | |
1796 | if ($wantarray) { | |
1797 | if (@_ == 0) { | |
98ef7649 | 1798 | _namedseq() unless %NAMEDSEQ; |
a2bd7410 JH |
1799 | return %NAMEDSEQ; |
1800 | } elsif (@_ == 1) { | |
98ef7649 KW |
1801 | my $s; |
1802 | if (%NAMEDSEQ) { | |
1803 | $s = $NAMEDSEQ{ $_[0] }; | |
1804 | } | |
1805 | else { | |
1806 | $s = charnames::string_vianame($_[0]); | |
1807 | } | |
a2bd7410 JH |
1808 | return defined $s ? map { ord($_) } split('', $s) : (); |
1809 | } | |
1810 | } elsif (@_ == 1) { | |
98ef7649 KW |
1811 | return $NAMEDSEQ{ $_[0] } if %NAMEDSEQ; |
1812 | return charnames::string_vianame($_[0]); | |
a2bd7410 JH |
1813 | } |
1814 | } | |
1815 | return; | |
1816 | } | |
1817 | ||
7319f91d KW |
1818 | my %NUMERIC; |
1819 | ||
1820 | sub _numeric { | |
35a865d4 | 1821 | my @numbers = _read_table("To/Nv.pl"); |
98025745 KW |
1822 | foreach my $entry (@numbers) { |
1823 | my ($start, $end, $value) = @$entry; | |
1824 | ||
05dbc6f8 KW |
1825 | # If value contains a slash, convert to decimal, add a reverse hash |
1826 | # used by charinfo. | |
98025745 KW |
1827 | if ((my @rational = split /\//, $value) == 2) { |
1828 | my $real = $rational[0] / $rational[1]; | |
05dbc6f8 | 1829 | $real_to_rational{$real} = $value; |
98025745 | 1830 | $value = $real; |
98025745 | 1831 | |
4f143a72 KW |
1832 | # Should only be single element, but just in case... |
1833 | for my $i ($start .. $end) { | |
1834 | $NUMERIC{$i} = $value; | |
1835 | } | |
1836 | } | |
1837 | else { | |
1838 | # The values require adjusting, as is in 'a' format | |
1839 | for my $i ($start .. $end) { | |
1840 | $NUMERIC{$i} = $value + $i - $start; | |
1841 | } | |
7319f91d | 1842 | } |
7319f91d | 1843 | } |
2dc5eb26 KW |
1844 | |
1845 | # Decided unsafe to use these that aren't officially part of the Unicode | |
1846 | # standard. | |
1847 | #use Math::Trig; | |
1848 | #my $pi = acos(-1.0); | |
98025745 | 1849 | #$NUMERIC{0x03C0} = $pi; |
7319f91d KW |
1850 | |
1851 | # Euler's constant, not to be confused with Euler's number | |
98025745 | 1852 | #$NUMERIC{0x2107} = 0.57721566490153286060651209008240243104215933593992; |
7319f91d KW |
1853 | |
1854 | # Euler's number | |
98025745 | 1855 | #$NUMERIC{0x212F} = 2.7182818284590452353602874713526624977572; |
2dc5eb26 | 1856 | |
7319f91d KW |
1857 | return; |
1858 | } | |
1859 | ||
1860 | =pod | |
1861 | ||
67592e11 | 1862 | =head2 B<num()> |
7319f91d | 1863 | |
eefd7bc2 KW |
1864 | use Unicode::UCD 'num'; |
1865 | ||
1866 | my $val = num("123"); | |
1867 | my $one_quarter = num("\N{VULGAR FRACTION 1/4}"); | |
1868 | ||
53cb2385 | 1869 | C<num()> returns the numeric value of the input Unicode string; or C<undef> if it |
7319f91d KW |
1870 | doesn't think the entire string has a completely valid, safe numeric value. |
1871 | ||
1872 | If the string is just one character in length, the Unicode numeric value | |
1873 | is returned if it has one, or C<undef> otherwise. Note that this need | |
1874 | not be a whole number. C<num("\N{TIBETAN DIGIT HALF ZERO}")>, for | |
2dc5eb26 KW |
1875 | example returns -0.5. |
1876 | ||
1877 | =cut | |
7319f91d | 1878 | |
2dc5eb26 KW |
1879 | #A few characters to which Unicode doesn't officially |
1880 | #assign a numeric value are considered numeric by C<num>. | |
1881 | #These are: | |
1882 | ||
1883 | # EULER CONSTANT 0.5772... (this is NOT Euler's number) | |
1884 | # SCRIPT SMALL E 2.71828... (this IS Euler's number) | |
1885 | # GREEK SMALL LETTER PI 3.14159... | |
1886 | ||
1887 | =pod | |
7319f91d KW |
1888 | |
1889 | If the string is more than one character, C<undef> is returned unless | |
8bb4c8e2 | 1890 | all its characters are decimal digits (that is, they would match C<\d+>), |
7319f91d KW |
1891 | from the same script. For example if you have an ASCII '0' and a Bengali |
1892 | '3', mixed together, they aren't considered a valid number, and C<undef> | |
1893 | is returned. A further restriction is that the digits all have to be of | |
1894 | the same form. A half-width digit mixed with a full-width one will | |
1895 | return C<undef>. The Arabic script has two sets of digits; C<num> will | |
1896 | return C<undef> unless all the digits in the string come from the same | |
1897 | set. | |
1898 | ||
1899 | C<num> errs on the side of safety, and there may be valid strings of | |
1900 | decimal digits that it doesn't recognize. Note that Unicode defines | |
1901 | a number of "digit" characters that aren't "decimal digit" characters. | |
a278d14b | 1902 | "Decimal digits" have the property that they have a positional value, i.e., |
7319f91d KW |
1903 | there is a units position, a 10's position, a 100's, etc, AND they are |
1904 | arranged in Unicode in blocks of 10 contiguous code points. The Chinese | |
1905 | digits, for example, are not in such a contiguous block, and so Unicode | |
1906 | doesn't view them as decimal digits, but merely digits, and so C<\d> will not | |
1907 | match them. A single-character string containing one of these digits will | |
1908 | have its decimal value returned by C<num>, but any longer string containing | |
1909 | only these digits will return C<undef>. | |
1910 | ||
a278d14b KW |
1911 | Strings of multiple sub- and superscripts are not recognized as numbers. You |
1912 | can use either of the compatibility decompositions in Unicode::Normalize to | |
7319f91d KW |
1913 | change these into digits, and then call C<num> on the result. |
1914 | ||
1915 | =cut | |
1916 | ||
1917 | # To handle sub, superscripts, this could if called in list context, | |
1918 | # consider those, and return the <decomposition> type in the second | |
1919 | # array element. | |
1920 | ||
1921 | sub num { | |
1922 | my $string = $_[0]; | |
1923 | ||
1924 | _numeric unless %NUMERIC; | |
1925 | ||
1926 | my $length = length($string); | |
98025745 | 1927 | return $NUMERIC{ord($string)} if $length == 1; |
7319f91d KW |
1928 | return if $string =~ /\D/; |
1929 | my $first_ord = ord(substr($string, 0, 1)); | |
98025745 | 1930 | my $value = $NUMERIC{$first_ord}; |
5522af1c KW |
1931 | |
1932 | # To be a valid decimal number, it should be in a block of 10 consecutive | |
1933 | # characters, whose values are 0, 1, 2, ... 9. Therefore this digit's | |
1934 | # value is its offset in that block from the character that means zero. | |
7319f91d KW |
1935 | my $zero_ord = $first_ord - $value; |
1936 | ||
5522af1c KW |
1937 | # Unicode 6.0 instituted the rule that only digits in a consecutive |
1938 | # block of 10 would be considered decimal digits. If this is an earlier | |
1939 | # release, we verify that this first character is a member of such a | |
1940 | # block. That is, that the block of characters surrounding this one | |
1941 | # consists of all \d characters whose numeric values are the expected | |
1942 | # ones. | |
1943 | UnicodeVersion() unless defined $v_unicode_version; | |
1944 | if ($v_unicode_version lt v6.0.0) { | |
1945 | for my $i (0 .. 9) { | |
1946 | my $ord = $zero_ord + $i; | |
1947 | return unless chr($ord) =~ /\d/; | |
1948 | my $numeric = $NUMERIC{$ord}; | |
1949 | return unless defined $numeric; | |
1950 | return unless $numeric == $i; | |
1951 | } | |
1952 | } | |
1953 | ||
7319f91d | 1954 | for my $i (1 .. $length -1) { |
5522af1c KW |
1955 | |
1956 | # Here we know either by verifying, or by fact of the first character | |
1957 | # being a \d in Unicode 6.0 or later, that any character between the | |
1958 | # character that means 0, and 9 positions above it must be \d, and | |
1959 | # must have its value correspond to its offset from the zero. Any | |
1960 | # characters outside these 10 do not form a legal number for this | |
1961 | # function. | |
7319f91d KW |
1962 | my $ord = ord(substr($string, $i, 1)); |
1963 | my $digit = $ord - $zero_ord; | |
1964 | return unless $digit >= 0 && $digit <= 9; | |
1965 | $value = $value * 10 + $digit; | |
1966 | } | |
5522af1c | 1967 | |
7319f91d KW |
1968 | return $value; |
1969 | } | |
1970 | ||
7ef25837 KW |
1971 | =pod |
1972 | ||
1973 | =head2 B<prop_aliases()> | |
1974 | ||
1975 | use Unicode::UCD 'prop_aliases'; | |
1976 | ||
1977 | my ($short_name, $full_name, @other_names) = prop_aliases("space"); | |
1978 | my $same_full_name = prop_aliases("Space"); # Scalar context | |
1979 | my ($same_short_name) = prop_aliases("Space"); # gets 0th element | |
1980 | print "The full name is $full_name\n"; | |
1981 | print "The short name is $short_name\n"; | |
1982 | print "The other aliases are: ", join(", ", @other_names), "\n"; | |
1983 | ||
1984 | prints: | |
1985 | The full name is White_Space | |
1986 | The short name is WSpace | |
1987 | The other aliases are: Space | |
1988 | ||
1989 | Most Unicode properties have several synonymous names. Typically, there is at | |
1990 | least a short name, convenient to type, and a long name that more fully | |
1991 | describes the property, and hence is more easily understood. | |
1992 | ||
1993 | If you know one name for a Unicode property, you can use C<prop_aliases> to find | |
1994 | either the long name (when called in scalar context), or a list of all of the | |
1995 | names, somewhat ordered so that the short name is in the 0th element, the long | |
1996 | name in the next element, and any other synonyms are in the remaining | |
1997 | elements, in no particular order. | |
1998 | ||
1999 | The long name is returned in a form nicely capitalized, suitable for printing. | |
2000 | ||
2001 | The input parameter name is loosely matched, which means that white space, | |
2002 | hyphens, and underscores are ignored (except for the trailing underscore in | |
2003 | the old_form grandfathered-in C<"L_">, which is better written as C<"LC">, and | |
2004 | both of which mean C<General_Category=Cased Letter>). | |
2005 | ||
2006 | If the name is unknown, C<undef> is returned (or an empty list in list | |
2007 | context). Note that Perl typically recognizes property names in regular | |
2008 | expressions with an optional C<"Is_>" (with or without the underscore) | |
2009 | prefixed to them, such as C<\p{isgc=punct}>. This function does not recognize | |
2010 | those in the input, returning C<undef>. Nor are they included in the output | |
2011 | as possible synonyms. | |
2012 | ||
2013 | C<prop_aliases> does know about the Perl extensions to Unicode properties, | |
2014 | such as C<Any> and C<XPosixAlpha>, and the single form equivalents to Unicode | |
2015 | properties such as C<XDigit>, C<Greek>, C<In_Greek>, and C<Is_Greek>. The | |
2016 | final example demonstrates that the C<"Is_"> prefix is recognized for these | |
2017 | extensions; it is needed to resolve ambiguities. For example, | |
2018 | C<prop_aliases('lc')> returns the list C<(lc, Lowercase_Mapping)>, but | |
2019 | C<prop_aliases('islc')> returns C<(Is_LC, Cased_Letter)>. This is | |
2020 | because C<islc> is a Perl extension which is short for | |
2021 | C<General_Category=Cased Letter>. The lists returned for the Perl extensions | |
2022 | will not include the C<"Is_"> prefix (whether or not the input had it) unless | |
2023 | needed to resolve ambiguities, as shown in the C<"islc"> example, where the | |
2024 | returned list had one element containing C<"Is_">, and the other without. | |
2025 | ||
2026 | It is also possible for the reverse to happen: C<prop_aliases('isc')> returns | |
2027 | the list C<(isc, ISO_Comment)>; whereas C<prop_aliases('c')> returns | |
2028 | C<(C, Other)> (the latter being a Perl extension meaning | |
ee94c7d1 KW |
2029 | C<General_Category=Other>. |
2030 | L<perluniprops/Properties accessible through Unicode::UCD> lists the available | |
2031 | forms, including which ones are discouraged from use. | |
7ef25837 KW |
2032 | |
2033 | Those discouraged forms are accepted as input to C<prop_aliases>, but are not | |
2034 | returned in the lists. C<prop_aliases('isL&')> and C<prop_aliases('isL_')>, | |
2035 | which are old synonyms for C<"Is_LC"> and should not be used in new code, are | |
2036 | examples of this. These both return C<(Is_LC, Cased_Letter)>. Thus this | |
13d1b68a | 2037 | function allows you to take a discouraged form, and find its acceptable |
7ef25837 KW |
2038 | alternatives. The same goes with single-form Block property equivalences. |
2039 | Only the forms that begin with C<"In_"> are not discouraged; if you pass | |
2040 | C<prop_aliases> a discouraged form, you will get back the equivalent ones that | |
2041 | begin with C<"In_">. It will otherwise look like a new-style block name (see. | |
2042 | L</Old-style versus new-style block names>). | |
2043 | ||
2044 | C<prop_aliases> does not know about any user-defined properties, and will | |
2045 | return C<undef> if called with one of those. Likewise for Perl internal | |
2046 | properties, with the exception of "Perl_Decimal_Digit" which it does know | |
2047 | about (and which is documented below in L</prop_invmap()>). | |
2048 | ||
2049 | =cut | |
2050 | ||
2051 | # It may be that there are use cases where the discouraged forms should be | |
2052 | # returned. If that comes up, an optional boolean second parameter to the | |
2053 | # function could be created, for example. | |
2054 | ||
2055 | # These are created by mktables for this routine and stored in unicore/UCD.pl | |
2056 | # where their structures are described. | |
2057 | our %string_property_loose_to_name; | |
2058 | our %ambiguous_names; | |
2059 | our %loose_perlprop_to_name; | |
2060 | our %prop_aliases; | |
2061 | ||
2062 | sub prop_aliases ($) { | |
2063 | my $prop = $_[0]; | |
2064 | return unless defined $prop; | |
2065 | ||
2066 | require "unicore/UCD.pl"; | |
2067 | require "unicore/Heavy.pl"; | |
2068 | require "utf8_heavy.pl"; | |
2069 | ||
2070 | # The property name may be loosely or strictly matched; we don't know yet. | |
2071 | # But both types use lower-case. | |
2072 | $prop = lc $prop; | |
2073 | ||
2074 | # It is loosely matched if its lower case isn't known to be strict. | |
2075 | my $list_ref; | |
2076 | if (! exists $utf8::stricter_to_file_of{$prop}) { | |
2077 | my $loose = utf8::_loose_name($prop); | |
2078 | ||
2079 | # There is a hash that converts from any loose name to its standard | |
2080 | # form, mapping all synonyms for a name to one name that can be used | |
2081 | # as a key into another hash. The whole concept is for memory | |
2082 | # savings, as the second hash doesn't have to have all the | |
2083 | # combinations. Actually, there are two hashes that do the | |
2084 | # converstion. One is used in utf8_heavy.pl (stored in Heavy.pl) for | |
2085 | # looking up properties matchable in regexes. This function needs to | |
2086 | # access string properties, which aren't available in regexes, so a | |
2087 | # second conversion hash is made for them (stored in UCD.pl). Look in | |
2088 | # the string one now, as the rest can have an optional 'is' prefix, | |
2089 | # which these don't. | |
2090 | if (exists $string_property_loose_to_name{$loose}) { | |
2091 | ||
2092 | # Convert to its standard loose name. | |
2093 | $prop = $string_property_loose_to_name{$loose}; | |
2094 | } | |
2095 | else { | |
2096 | my $retrying = 0; # bool. ? Has an initial 'is' been stripped | |
2097 | RETRY: | |
2098 | if (exists $utf8::loose_property_name_of{$loose} | |
2099 | && (! $retrying | |
2100 | || ! exists $ambiguous_names{$loose})) | |
2101 | { | |
2102 | # Found an entry giving the standard form. We don't get here | |
2103 | # (in the test above) when we've stripped off an | |
2104 | # 'is' and the result is an ambiguous name. That is because | |
2105 | # these are official Unicode properties (though Perl can have | |
2106 | # an optional 'is' prefix meaning the official property), and | |
2107 | # all ambiguous cases involve a Perl single-form extension | |
2108 | # for the gc, script, or block properties, and the stripped | |
2109 | # 'is' means that they mean one of those, and not one of | |
2110 | # these | |
2111 | $prop = $utf8::loose_property_name_of{$loose}; | |
2112 | } | |
2113 | elsif (exists $loose_perlprop_to_name{$loose}) { | |
2114 | ||
2115 | # This hash is specifically for this function to list Perl | |
2116 | # extensions that aren't in the earlier hashes. If there is | |
2117 | # only one element, the short and long names are identical. | |
2118 | # Otherwise the form is already in the same form as | |
2119 | # %prop_aliases, which is handled at the end of the function. | |
2120 | $list_ref = $loose_perlprop_to_name{$loose}; | |
2121 | if (@$list_ref == 1) { | |
2122 | my @list = ($list_ref->[0], $list_ref->[0]); | |
2123 | $list_ref = \@list; | |
2124 | } | |
2125 | } | |
2126 | elsif (! exists $utf8::loose_to_file_of{$loose}) { | |
2127 | ||
2128 | # loose_to_file_of is a complete list of loose names. If not | |
2129 | # there, the input is unknown. | |
2130 | return; | |
2131 | } | |
27f39eb8 | 2132 | elsif ($loose =~ / [:=] /x) { |
7ef25837 KW |
2133 | |
2134 | # Here we found the name but not its aliases, so it has to | |
27f39eb8 KW |
2135 | # exist. Exclude property-value combinations. (This shows up |
2136 | # for something like ccc=vr which matches loosely, but is a | |
2137 | # synonym for ccc=9 which matches only strictly. | |
2138 | return; | |
2139 | } | |
2140 | else { | |
2141 | ||
2142 | # Here it has to exist, and isn't a property-value | |
2143 | # combination. This means it must be one of the Perl | |
2144 | # single-form extensions. First see if it is for a | |
2145 | # property-value combination in one of the following | |
2146 | # properties. | |
7ef25837 KW |
2147 | my @list; |
2148 | foreach my $property ("gc", "script") { | |
2149 | @list = prop_value_aliases($property, $loose); | |
2150 | last if @list; | |
2151 | } | |
2152 | if (@list) { | |
2153 | ||
2154 | # Here, it is one of those property-value combination | |
2155 | # single-form synonyms. There are ambiguities with some | |
2156 | # of these. Check against the list for these, and adjust | |
2157 | # if necessary. | |
2158 | for my $i (0 .. @list -1) { | |
2159 | if (exists $ambiguous_names | |
2160 | {utf8::_loose_name(lc $list[$i])}) | |
2161 | { | |
2162 | # The ambiguity is resolved by toggling whether or | |
2163 | # not it has an 'is' prefix | |
2164 | $list[$i] =~ s/^Is_// or $list[$i] =~ s/^/Is_/; | |
2165 | } | |
2166 | } | |
2167 | return @list; | |
2168 | } | |
2169 | ||
2170 | # Here, it wasn't one of the gc or script single-form | |
2171 | # extensions. It could be a block property single-form | |
2172 | # extension. An 'in' prefix definitely means that, and should | |
2a4f2769 KW |
2173 | # be looked up without the prefix. However, starting in |
2174 | # Unicode 6.1, we have to special case 'indic...', as there | |
2175 | # is a property that begins with that name. We shouldn't | |
2176 | # strip the 'in' from that. I'm (khw) generalizing this to | |
2177 | # 'indic' instead of the single property, because I suspect | |
2178 | # that others of this class may come along in the future. | |
2179 | # However, this could backfire and a block created whose name | |
2180 | # begins with 'dic...', and we would want to strip the 'in'. | |
2181 | # At which point this would have to be tweaked. | |
2182 | my $began_with_in = $loose =~ s/^in(?!dic)//; | |
7ef25837 KW |
2183 | @list = prop_value_aliases("block", $loose); |
2184 | if (@list) { | |
2185 | map { $_ =~ s/^/In_/ } @list; | |
2186 | return @list; | |
2187 | } | |
2188 | ||
2189 | # Here still haven't found it. The last opportunity for it | |
2190 | # being valid is only if it began with 'is'. We retry without | |
2191 | # the 'is', setting a flag to that effect so that we don't | |
2192 | # accept things that begin with 'isis...' | |
2193 | if (! $retrying && ! $began_with_in && $loose =~ s/^is//) { | |
2194 | $retrying = 1; | |
2195 | goto RETRY; | |
2196 | } | |
2197 | ||
2198 | # Here, didn't find it. Since it was in %loose_to_file_of, we | |
2199 | # should have been able to find it. | |
2200 | carp __PACKAGE__, "::prop_aliases: Unexpectedly could not find '$prop'. Send bug report to perlbug\@perl.org"; | |
2201 | return; | |
2202 | } | |
2203 | } | |
2204 | } | |
2205 | ||
2206 | if (! $list_ref) { | |
2207 | # Here, we have set $prop to a standard form name of the input. Look | |
2208 | # it up in the structure created by mktables for this purpose, which | |
2209 | # contains both strict and loosely matched properties. Avoid | |
2210 | # autovivifying. | |
2211 | $list_ref = $prop_aliases{$prop} if exists $prop_aliases{$prop}; | |
2212 | return unless $list_ref; | |
2213 | } | |
2214 | ||
2215 | # The full name is in element 1. | |
2216 | return $list_ref->[1] unless wantarray; | |
2217 | ||
cb3150f5 | 2218 | return @{_dclone $list_ref}; |
7ef25837 KW |
2219 | } |
2220 | ||
2221 | =pod | |
2222 | ||
9024667a KW |
2223 | =head2 B<prop_values()> |
2224 | ||
2225 | use Unicode::UCD 'prop_values'; | |
2226 | ||
2227 | print "AHex values are: ", join(", ", prop_values("AHex")), | |
2228 | "\n"; | |
2229 | prints: | |
2230 | AHex values are: N, Y | |
2231 | ||
2232 | Some Unicode properties have a restricted set of legal values. For example, | |
2233 | all binary properties are restricted to just C<true> or C<false>; and there | |
2234 | are only a few dozen possible General Categories. Use C<prop_values> | |
2235 | to find out if a given property is one such, and if so, to get a list of the | |
2236 | values: | |
2237 | ||
2238 | print join ", ", prop_values("NFC_Quick_Check"); | |
2239 | prints: | |
2240 | M, N, Y | |
2241 | ||
2242 | If the property doesn't have such a restricted set, C<undef> is returned. | |
2243 | ||
2244 | There are usually several synonyms for each possible value. Use | |
2245 | L</prop_value_aliases()> to access those. | |
2246 | ||
2247 | Case, white space, hyphens, and underscores are ignored in the input property | |
2248 | name (except for the trailing underscore in the old-form grandfathered-in | |
2249 | general category property value C<"L_">, which is better written as C<"LC">). | |
2250 | ||
2251 | If the property name is unknown, C<undef> is returned. Note that Perl typically | |
2252 | recognizes property names in regular expressions with an optional C<"Is_>" | |
2253 | (with or without the underscore) prefixed to them, such as C<\p{isgc=punct}>. | |
2254 | This function does not recognize those in the property parameter, returning | |
2255 | C<undef>. | |
2256 | ||
2257 | For the block property, new-style block names are returned (see | |
2258 | L</Old-style versus new-style block names>). | |
2259 | ||
2260 | C<prop_values> does not know about any user-defined properties, and | |
2261 | will return C<undef> if called with one of those. | |
2262 | ||
2263 | =cut | |
2264 | ||
2265 | # These are created by mktables for this module and stored in unicore/UCD.pl | |
2266 | # where their structures are described. | |
2267 | our %loose_to_standard_value; | |
2268 | our %prop_value_aliases; | |
2269 | ||
2270 | sub prop_values ($) { | |
2271 | my $prop = shift; | |
2272 | return undef unless defined $prop; | |
2273 | ||
2274 | require "unicore/UCD.pl"; | |
2275 | require "utf8_heavy.pl"; | |
2276 | ||
2277 | # Find the property name synonym that's used as the key in other hashes, | |
2278 | # which is element 0 in the returned list. | |
2279 | ($prop) = prop_aliases($prop); | |
2280 | return undef if ! $prop; | |
2281 | $prop = utf8::_loose_name(lc $prop); | |
2282 | ||
2283 | # Here is a legal property. | |
2284 | return undef unless exists $prop_value_aliases{$prop}; | |
2285 | my @return; | |
2286 | foreach my $value_key (sort { lc $a cmp lc $b } | |
2287 | keys %{$prop_value_aliases{$prop}}) | |
2288 | { | |
2289 | push @return, $prop_value_aliases{$prop}{$value_key}[0]; | |
2290 | } | |
2291 | return @return; | |
2292 | } | |
2293 | ||
2294 | =pod | |
2295 | ||
7ef25837 KW |
2296 | =head2 B<prop_value_aliases()> |
2297 | ||
2298 | use Unicode::UCD 'prop_value_aliases'; | |
2299 | ||
2300 | my ($short_name, $full_name, @other_names) | |
2301 | = prop_value_aliases("Gc", "Punct"); | |
2302 | my $same_full_name = prop_value_aliases("Gc", "P"); # Scalar cntxt | |
2303 | my ($same_short_name) = prop_value_aliases("Gc", "P"); # gets 0th | |
2304 | # element | |
2305 | print "The full name is $full_name\n"; | |
2306 | print "The short name is $short_name\n"; | |
2307 | print "The other aliases are: ", join(", ", @other_names), "\n"; | |
2308 | ||
9024667a | 2309 | prints: |
7ef25837 KW |
2310 | The full name is Punctuation |
2311 | The short name is P | |
2312 | The other aliases are: Punct | |
2313 | ||
2314 | Some Unicode properties have a restricted set of legal values. For example, | |
2315 | all binary properties are restricted to just C<true> or C<false>; and there | |
2316 | are only a few dozen possible General Categories. | |
2317 | ||
9024667a KW |
2318 | You can use L</prop_values()> to find out if a given property is one which has |
2319 | a restricted set of values, and if so, what those values are. But usually | |
91e78470 KW |
2320 | each value actually has several synonyms. For example, in Unicode binary |
2321 | properties, I<truth> can be represented by any of the strings "Y", "Yes", "T", | |
2322 | or "True"; and the General Category "Punctuation" by that string, or "Punct", | |
2323 | or simply "P". | |
7ef25837 KW |
2324 | |
2325 | Like property names, there is typically at least a short name for each such | |
9024667a KW |
2326 | property-value, and a long name. If you know any name of the property-value |
2327 | (which you can get by L</prop_values()>, you can use C<prop_value_aliases>() | |
2328 | to get the long name (when called in scalar context), or a list of all the | |
2329 | names, with the short name in the 0th element, the long name in the next | |
2330 | element, and any other synonyms in the remaining elements, in no particular | |
2331 | order, except that any all-numeric synonyms will be last. | |
7ef25837 KW |
2332 | |
2333 | The long name is returned in a form nicely capitalized, suitable for printing. | |
2334 | ||
2335 | Case, white space, hyphens, and underscores are ignored in the input parameters | |
2336 | (except for the trailing underscore in the old-form grandfathered-in general | |
2337 | category property value C<"L_">, which is better written as C<"LC">). | |
2338 | ||
2339 | If either name is unknown, C<undef> is returned. Note that Perl typically | |
2340 | recognizes property names in regular expressions with an optional C<"Is_>" | |
2341 | (with or without the underscore) prefixed to them, such as C<\p{isgc=punct}>. | |
2342 | This function does not recognize those in the property parameter, returning | |
2343 | C<undef>. | |
2344 | ||
2345 | If called with a property that doesn't have synonyms for its values, it | |
2346 | returns the input value, possibly normalized with capitalization and | |
91e78470 | 2347 | underscores, but not necessarily checking that the input value is valid. |
7ef25837 KW |
2348 | |
2349 | For the block property, new-style block names are returned (see | |
2350 | L</Old-style versus new-style block names>). | |
2351 | ||
2352 | To find the synonyms for single-forms, such as C<\p{Any}>, use | |
2353 | L</prop_aliases()> instead. | |
2354 | ||
2355 | C<prop_value_aliases> does not know about any user-defined properties, and | |
2356 | will return C<undef> if called with one of those. | |
2357 | ||
2358 | =cut | |
2359 | ||
7ef25837 KW |
2360 | sub prop_value_aliases ($$) { |
2361 | my ($prop, $value) = @_; | |
2362 | return unless defined $prop && defined $value; | |
2363 | ||
2364 | require "unicore/UCD.pl"; | |
2365 | require "utf8_heavy.pl"; | |
2366 | ||
2367 | # Find the property name synonym that's used as the key in other hashes, | |
2368 | # which is element 0 in the returned list. | |
2369 | ($prop) = prop_aliases($prop); | |
2370 | return if ! $prop; | |
2371 | $prop = utf8::_loose_name(lc $prop); | |
2372 | ||
2373 | # Here is a legal property, but the hash below (created by mktables for | |
2374 | # this purpose) only knows about the properties that have a very finite | |
2375 | # number of potential values, that is not ones whose value could be | |
2376 | # anything, like most (if not all) string properties. These don't have | |
2377 | # synonyms anyway. Simply return the input. For example, there is no | |
2378 | # synonym for ('Uppercase_Mapping', A'). | |
5c1d8161 KW |
2379 | if (! exists $prop_value_aliases{$prop}) { |
2380 | ||
2381 | # Here, we have a legal property, but an unknown value. Since the | |
2382 | # property is legal, if it isn't in the prop_aliases hash, it must be | |
2383 | # a Perl-extension All perl extensions are binary, hence are | |
2384 | # enumerateds, which means that we know that the input unknown value | |
2385 | # is illegal. | |
2386 | return if ! exists $Unicode::UCD::prop_aliases{$prop}; | |
2387 | ||
2388 | # Otherwise, we assume it's valid, as documented. | |
2389 | return $value; | |
2390 | } | |
7ef25837 KW |
2391 | |
2392 | # The value name may be loosely or strictly matched; we don't know yet. | |
2393 | # But both types use lower-case. | |
2394 | $value = lc $value; | |
2395 | ||
2396 | # If the name isn't found under loose matching, it certainly won't be | |
2397 | # found under strict | |
2398 | my $loose_value = utf8::_loose_name($value); | |
2399 | return unless exists $loose_to_standard_value{"$prop=$loose_value"}; | |
2400 | ||
2401 | # Similarly if the combination under loose matching doesn't exist, it | |
2402 | # won't exist under strict. | |
2403 | my $standard_value = $loose_to_standard_value{"$prop=$loose_value"}; | |
2404 | return unless exists $prop_value_aliases{$prop}{$standard_value}; | |
2405 | ||
2406 | # Here we did find a combination under loose matching rules. But it could | |
2407 | # be that is a strict property match that shouldn't have matched. | |
2408 | # %prop_value_aliases is set up so that the strict matches will appear as | |
2409 | # if they were in loose form. Thus, if the non-loose version is legal, | |
2410 | # we're ok, can skip the further check. | |
2411 | if (! exists $utf8::stricter_to_file_of{"$prop=$value"} | |
2412 | ||
2413 | # We're also ok and skip the further check if value loosely matches. | |
2414 | # mktables has verified that no strict name under loose rules maps to | |
2415 | # an existing loose name. This code relies on the very limited | |
2416 | # circumstances that strict names can be here. Strict name matching | |
2417 | # happens under two conditions: | |
2418 | # 1) when the name begins with an underscore. But this function | |
2419 | # doesn't accept those, and %prop_value_aliases doesn't have | |
2420 | # them. | |
2421 | # 2) When the values are numeric, in which case we need to look | |
2422 | # further, but their squeezed-out loose values will be in | |
2423 | # %stricter_to_file_of | |
2424 | && exists $utf8::stricter_to_file_of{"$prop=$loose_value"}) | |
2425 | { | |
2426 | # The only thing that's legal loosely under strict is that can have an | |
2427 | # underscore between digit pairs XXX | |
2428 | while ($value =~ s/(\d)_(\d)/$1$2/g) {} | |
2429 | return unless exists $utf8::stricter_to_file_of{"$prop=$value"}; | |
2430 | } | |
2431 | ||
2432 | # Here, we know that the combination exists. Return it. | |
2433 | my $list_ref = $prop_value_aliases{$prop}{$standard_value}; | |
2434 | if (@$list_ref > 1) { | |
2435 | # The full name is in element 1. | |
2436 | return $list_ref->[1] unless wantarray; | |
2437 | ||
cb3150f5 | 2438 | return @{_dclone $list_ref}; |
7ef25837 KW |
2439 | } |
2440 | ||
2441 | return $list_ref->[0] unless wantarray; | |
2442 | ||
2443 | # Only 1 element means that it repeats | |
2444 | return ( $list_ref->[0], $list_ref->[0] ); | |
2445 | } | |
7319f91d | 2446 | |
681d705c KW |
2447 | # All 1 bits is the largest possible UV. |
2448 | $Unicode::UCD::MAX_CP = ~0; | |
2449 | ||
2450 | =pod | |
2451 | ||
2452 | =head2 B<prop_invlist()> | |
2453 | ||
2454 | C<prop_invlist> returns an inversion list (described below) that defines all the | |
2455 | code points for the binary Unicode property (or "property=value" pair) given | |
2456 | by the input parameter string: | |
2457 | ||
2458 | use feature 'say'; | |
2459 | use Unicode::UCD 'prop_invlist'; | |
2460 | say join ", ", prop_invlist("Any"); | |
2461 | ||
2462 | prints: | |
2463 | 0, 1114112 | |
2464 | ||
c8652296 KW |
2465 | If the input is unknown C<undef> is returned in scalar context; an empty-list |
2466 | in list context. If the input is known, the number of elements in | |
681d705c KW |
2467 | the list is returned if called in scalar context. |
2468 | ||
2469 | L<perluniprops|perluniprops/Properties accessible through \p{} and \P{}> gives | |
2470 | the list of properties that this function accepts, as well as all the possible | |
2471 | forms for them (including with the optional "Is_" prefixes). (Except this | |
2472 | function doesn't accept any Perl-internal properties, some of which are listed | |
2473 | there.) This function uses the same loose or tighter matching rules for | |
2474 | resolving the input property's name as is done for regular expressions. These | |
2475 | are also specified in L<perluniprops|perluniprops/Properties accessible | |
2476 | through \p{} and \P{}>. Examples of using the "property=value" form are: | |
2477 | ||
48791bf1 | 2478 | say join ", ", prop_invlist("Script_Extensions=Shavian"); |
681d705c KW |
2479 | |
2480 | prints: | |
2481 | 66640, 66688 | |
2482 | ||
2483 | say join ", ", prop_invlist("ASCII_Hex_Digit=No"); | |
2484 | ||
2485 | prints: | |
2486 | 0, 48, 58, 65, 71, 97, 103 | |
2487 | ||
2488 | say join ", ", prop_invlist("ASCII_Hex_Digit=Yes"); | |
2489 | ||
2490 | prints: | |
2491 | 48, 58, 65, 71, 97, 103 | |
2492 | ||
2493 | Inversion lists are a compact way of specifying Unicode property-value | |
2494 | definitions. The 0th item in the list is the lowest code point that has the | |
2495 | property-value. The next item (item [1]) is the lowest code point beyond that | |
2496 | one that does NOT have the property-value. And the next item beyond that | |
2497 | ([2]) is the lowest code point beyond that one that does have the | |
2498 | property-value, and so on. Put another way, each element in the list gives | |
2499 | the beginning of a range that has the property-value (for even numbered | |
2500 | elements), or doesn't have the property-value (for odd numbered elements). | |
2501 | The name for this data structure stems from the fact that each element in the | |
2502 | list toggles (or inverts) whether the corresponding range is or isn't on the | |
2503 | list. | |
2504 | ||
2505 | In the final example above, the first ASCII Hex digit is code point 48, the | |
2506 | character "0", and all code points from it through 57 (a "9") are ASCII hex | |
2507 | digits. Code points 58 through 64 aren't, but 65 (an "A") through 70 (an "F") | |
2508 | are, as are 97 ("a") through 102 ("f"). 103 starts a range of code points | |
2509 | that aren't ASCII hex digits. That range extends to infinity, which on your | |
2510 | computer can be found in the variable C<$Unicode::UCD::MAX_CP>. (This | |
2511 | variable is as close to infinity as Perl can get on your platform, and may be | |
2512 | too high for some operations to work; you may wish to use a smaller number for | |
2513 | your purposes.) | |
2514 | ||
2515 | Note that the inversion lists returned by this function can possibly include | |
2d88a86a KW |
2516 | non-Unicode code points, that is anything above 0x10FFFF. Unicode properties |
2517 | are not defined on such code points. You might wish to change the output to | |
2518 | not include these. Simply add 0x110000 at the end of the non-empty returned | |
2519 | list if it isn't already that value; and pop that value if it is; like: | |
681d705c KW |
2520 | |
2521 | my @list = prop_invlist("foo"); | |
2522 | if (@list) { | |
2523 | if ($list[-1] == 0x110000) { | |
2524 | pop @list; # Defeat the turning on for above Unicode | |
2525 | } | |
2526 | else { | |
2527 | push @list, 0x110000; # Turn off for above Unicode | |
2528 | } | |
2529 | } | |
2530 | ||
2531 | It is a simple matter to expand out an inversion list to a full list of all | |
2532 | code points that have the property-value: | |
2533 | ||
2534 | my @invlist = prop_invlist($property_name); | |
2535 | die "empty" unless @invlist; | |
2536 | my @full_list; | |
2537 | for (my $i = 0; $i < @invlist; $i += 2) { | |
2538 | my $upper = ($i + 1) < @invlist | |
2539 | ? $invlist[$i+1] - 1 # In range | |
2540 | : $Unicode::UCD::MAX_CP; # To infinity. You may want | |
2541 | # to stop much much earlier; | |
2542 | # going this high may expose | |
2543 | # perl deficiencies with very | |
2544 | # large numbers. | |
2545 | for my $j ($invlist[$i] .. $upper) { | |
2546 | push @full_list, $j; | |
2547 | } | |
2548 | } | |
2549 | ||
2550 | C<prop_invlist> does not know about any user-defined nor Perl internal-only | |
2551 | properties, and will return C<undef> if called with one of those. | |
2552 | ||
1fdd5e53 KW |
2553 | The L</search_invlist()> function is provided for finding a code point within |
2554 | an inversion list. | |
2555 | ||
681d705c KW |
2556 | =cut |
2557 | ||
2558 | # User-defined properties could be handled with some changes to utf8_heavy.pl; | |
2559 | # and implementing here of dealing with EXTRAS. If done, consideration should | |
2560 | # be given to the fact that the user subroutine could return different results | |
2561 | # with each call; security issues need to be thought about. | |
2562 | ||
2563 | # These are created by mktables for this routine and stored in unicore/UCD.pl | |
2564 | # where their structures are described. | |
2565 | our %loose_defaults; | |
2566 | our $MAX_UNICODE_CODEPOINT; | |
2567 | ||
92feec86 | 2568 | sub prop_invlist ($;$) { |
681d705c | 2569 | my $prop = $_[0]; |
92feec86 | 2570 | |
b08d569e KW |
2571 | # Undocumented way to get at Perl internal properties; it may be changed |
2572 | # or removed without notice at any time. | |
92feec86 KW |
2573 | my $internal_ok = defined $_[1] && $_[1] eq '_perl_core_internal_ok'; |
2574 | ||
681d705c KW |
2575 | return if ! defined $prop; |
2576 | ||
2577 | require "utf8_heavy.pl"; | |
2578 | ||
2579 | # Warnings for these are only for regexes, so not applicable to us | |
2580 | no warnings 'deprecated'; | |
2581 | ||
2582 | # Get the swash definition of the property-value. | |
2583 | my $swash = utf8::SWASHNEW(__PACKAGE__, $prop, undef, 1, 0); | |
2584 | ||
2585 | # Fail if not found, or isn't a boolean property-value, or is a | |
2586 | # user-defined property, or is internal-only. | |
2587 | return if ! $swash | |
2588 | || ref $swash eq "" | |
2589 | || $swash->{'BITS'} != 1 | |
2590 | || $swash->{'USER_DEFINED'} | |
92feec86 | 2591 | || (! $internal_ok && $prop =~ /^\s*_/); |
681d705c KW |
2592 | |
2593 | if ($swash->{'EXTRAS'}) { | |
2594 | carp __PACKAGE__, "::prop_invlist: swash returned for $prop unexpectedly has EXTRAS magic"; | |
2595 | return; | |
2596 | } | |
2597 | if ($swash->{'SPECIALS'}) { | |
2598 | carp __PACKAGE__, "::prop_invlist: swash returned for $prop unexpectedly has SPECIALS magic"; | |
2599 | return; | |
2600 | } | |
2601 | ||
2602 | my @invlist; | |
2603 | ||
31aa6e0b KW |
2604 | if ($swash->{'LIST'} =~ /^V/) { |
2605 | ||
2606 | # A 'V' as the first character marks the input as already an inversion | |
2607 | # list, in which case, all we need to do is put the remaining lines | |
2608 | # into our array. | |
2609 | @invlist = split "\n", $swash->{'LIST'} =~ s/ \s* (?: \# .* )? $ //xmgr; | |
2610 | shift @invlist; | |
2611 | } | |
2612 | else { | |
1784d2f9 KW |
2613 | # The input lines look like: |
2614 | # 0041\t005A # [26] | |
2615 | # 005F | |
681d705c | 2616 | |
1784d2f9 KW |
2617 | # Split into lines, stripped of trailing comments |
2618 | foreach my $range (split "\n", | |
2619 | $swash->{'LIST'} =~ s/ \s* (?: \# .* )? $ //xmgr) | |
2620 | { | |
2621 | # And find the beginning and end of the range on the line | |
2622 | my ($hex_begin, $hex_end) = split "\t", $range; | |
2623 | my $begin = hex $hex_begin; | |
2624 | ||
2625 | # If the new range merely extends the old, we remove the marker | |
2626 | # created the last time through the loop for the old's end, which | |
2627 | # causes the new one's end to be used instead. | |
2628 | if (@invlist && $begin == $invlist[-1]) { | |
2629 | pop @invlist; | |
2630 | } | |
2631 | else { | |
2632 | # Add the beginning of the range | |
2633 | push @invlist, $begin; | |
2634 | } | |
681d705c | 2635 | |
1784d2f9 KW |
2636 | if (defined $hex_end) { # The next item starts with the code point 1 |
2637 | # beyond the end of the range. | |
2638 | no warnings 'portable'; | |
2639 | my $end = hex $hex_end; | |
2640 | last if $end == $Unicode::UCD::MAX_CP; | |
2641 | push @invlist, $end + 1; | |
2642 | } | |
2643 | else { # No end of range, is a single code point. | |
2644 | push @invlist, $begin + 1; | |
2645 | } | |
681d705c KW |
2646 | } |
2647 | } | |
2648 | ||
681d705c | 2649 | # Could need to be inverted: add or subtract a 0 at the beginning of the |
2d88a86a | 2650 | # list. |
681d705c KW |
2651 | if ($swash->{'INVERT_IT'}) { |
2652 | if (@invlist && $invlist[0] == 0) { | |
2653 | shift @invlist; | |
2654 | } | |
2655 | else { | |
2656 | unshift @invlist, 0; | |
2657 | } | |
681d705c KW |
2658 | } |
2659 | ||
2660 | return @invlist; | |
2661 | } | |
7319f91d | 2662 | |
62b3b855 KW |
2663 | =pod |
2664 | ||
2665 | =head2 B<prop_invmap()> | |
2666 | ||
2667 | use Unicode::UCD 'prop_invmap'; | |
ad5f730f | 2668 | my ($list_ref, $map_ref, $format, $default) |
62b3b855 KW |
2669 | = prop_invmap("General Category"); |
2670 | ||
2671 | C<prop_invmap> is used to get the complete mapping definition for a property, | |
2672 | in the form of an inversion map. An inversion map consists of two parallel | |
2673 | arrays. One is an ordered list of code points that mark range beginnings, and | |
2674 | the other gives the value (or mapping) that all code points in the | |
2675 | corresponding range have. | |
2676 | ||
2677 | C<prop_invmap> is called with the name of the desired property. The name is | |
2678 | loosely matched, meaning that differences in case, white-space, hyphens, and | |
2679 | underscores are not meaningful (except for the trailing underscore in the | |
2680 | old-form grandfathered-in property C<"L_">, which is better written as C<"LC">, | |
2681 | or even better, C<"Gc=LC">). | |
2682 | ||
2683 | Many Unicode properties have more than one name (or alias). C<prop_invmap> | |
2684 | understands all of these, including Perl extensions to them. Ambiguities are | |
d963b40d KW |
2685 | resolved as described above for L</prop_aliases()> (except if a property has |
2686 | both a complete mapping, and a binary C<Y>/C<N> mapping, then specifying the | |
2687 | property name prefixed by C<"is"> causes the binary one to be returned). The | |
2688 | Perl internal property "Perl_Decimal_Digit, described below, is also accepted. | |
2689 | An empty list is returned if the property name is unknown. | |
ee94c7d1 KW |
2690 | See L<perluniprops/Properties accessible through Unicode::UCD> for the |
2691 | properties acceptable as inputs to this function. | |
62b3b855 KW |
2692 | |
2693 | It is a fatal error to call this function except in list context. | |
2694 | ||
13d1b68a | 2695 | In addition to the two arrays that form the inversion map, C<prop_invmap> |
62b3b855 | 2696 | returns two other values; one is a scalar that gives some details as to the |
5b2b1977 KW |
2697 | format of the entries of the map array; the other is a default value, useful |
2698 | in maps whose format name begins with the letter C<"a">, as described | |
2699 | L<below in its subsection|/a>; and for specialized purposes, such as | |
2700 | converting to another data structure, described at the end of this main | |
2701 | section. | |
62b3b855 KW |
2702 | |
2703 | This means that C<prop_invmap> returns a 4 element list. For example, | |
2704 | ||
2705 | my ($blocks_ranges_ref, $blocks_maps_ref, $format, $default) | |
2706 | = prop_invmap("Block"); | |
2707 | ||
2708 | In this call, the two arrays will be populated as shown below (for Unicode | |
2709 | 6.0): | |
2710 | ||
2711 | Index @blocks_ranges @blocks_maps | |
2712 | 0 0x0000 Basic Latin | |
2713 | 1 0x0080 Latin-1 Supplement | |
2714 | 2 0x0100 Latin Extended-A | |
2715 | 3 0x0180 Latin Extended-B | |
2716 | 4 0x0250 IPA Extensions | |
2717 | 5 0x02B0 Spacing Modifier Letters | |
2718 | 6 0x0300 Combining Diacritical Marks | |
2719 | 7 0x0370 Greek and Coptic | |
2720 | 8 0x0400 Cyrillic | |
2721 | ... | |
2722 | 233 0x2B820 No_Block | |
2723 | 234 0x2F800 CJK Compatibility Ideographs Supplement | |
2724 | 235 0x2FA20 No_Block | |
2725 | 236 0xE0000 Tags | |
2726 | 237 0xE0080 No_Block | |
2727 | 238 0xE0100 Variation Selectors Supplement | |
2728 | 239 0xE01F0 No_Block | |
2729 | 240 0xF0000 Supplementary Private Use Area-A | |
2730 | 241 0x100000 Supplementary Private Use Area-B | |
2731 | 242 0x110000 No_Block | |
2732 | ||
2733 | The first line (with Index [0]) means that the value for code point 0 is "Basic | |
2734 | Latin". The entry "0x0080" in the @blocks_ranges column in the second line | |
2735 | means that the value from the first line, "Basic Latin", extends to all code | |
2736 | points in the range from 0 up to but not including 0x0080, that is, through | |
647396da | 2737 | 127. In other words, the code points from 0 to 127 are all in the "Basic |
62b3b855 KW |
2738 | Latin" block. Similarly, all code points in the range from 0x0080 up to (but |
2739 | not including) 0x0100 are in the block named "Latin-1 Supplement", etc. | |
2740 | (Notice that the return is the old-style block names; see L</Old-style versus | |
2741 | new-style block names>). | |
2742 | ||
2743 | The final line (with Index [242]) means that the value for all code points above | |
2744 | the legal Unicode maximum code point have the value "No_Block", which is the | |
2745 | term Unicode uses for a non-existing block. | |
2746 | ||
2747 | The arrays completely specify the mappings for all possible code points. | |
2748 | The final element in an inversion map returned by this function will always be | |
2749 | for the range that consists of all the code points that aren't legal Unicode, | |
2750 | but that are expressible on the platform. (That is, it starts with code point | |
2751 | 0x110000, the first code point above the legal Unicode maximum, and extends to | |
2752 | infinity.) The value for that range will be the same that any typical | |
2753 | unassigned code point has for the specified property. (Certain unassigned | |
2754 | code points are not "typical"; for example the non-character code points, or | |
2755 | those in blocks that are to be written right-to-left. The above-Unicode | |
2756 | range's value is not based on these atypical code points.) It could be argued | |
2757 | that, instead of treating these as unassigned Unicode code points, the value | |
2758 | for this range should be C<undef>. If you wish, you can change the returned | |
2759 | arrays accordingly. | |
2760 | ||
ad5f730f KW |
2761 | The maps for almost all properties are simple scalars that should be |
2762 | interpreted as-is. | |
62b3b855 KW |
2763 | These values are those given in the Unicode-supplied data files, which may be |
2764 | inconsistent as to capitalization and as to which synonym for a property-value | |
2765 | is given. The results may be normalized by using the L</prop_value_aliases()> | |
2766 | function. | |
2767 | ||
2768 | There are exceptions to the simple scalar maps. Some properties have some | |
2769 | elements in their map list that are themselves lists of scalars; and some | |
2770 | special strings are returned that are not to be interpreted as-is. Element | |
2771 | [2] (placed into C<$format> in the example above) of the returned four element | |
647396da | 2772 | list tells you if the map has any of these special elements or not, as follows: |
62b3b855 KW |
2773 | |
2774 | =over | |
2775 | ||
dc8d8ea6 | 2776 | =item B<C<s>> |
62b3b855 KW |
2777 | |
2778 | means all the elements of the map array are simple scalars, with no special | |
2779 | elements. Almost all properties are like this, like the C<block> example | |
2780 | above. | |
2781 | ||
dc8d8ea6 | 2782 | =item B<C<sl>> |
62b3b855 | 2783 | |
647396da | 2784 | means that some of the map array elements have the form given by C<"s">, and |
62b3b855 KW |
2785 | the rest are lists of scalars. For example, here is a portion of the output |
2786 | of calling C<prop_invmap>() with the "Script Extensions" property: | |
2787 | ||
2788 | @scripts_ranges @scripts_maps | |
2789 | ... | |
c2ca0207 KW |
2790 | 0x0953 Devanagari |
2791 | 0x0964 [ Bengali, Devanagari, Gurumukhi, Oriya ] | |
2792 | 0x0966 Devanagari | |
62b3b855 KW |
2793 | 0x0970 Common |
2794 | ||
647396da KW |
2795 | Here, the code points 0x964 and 0x965 are both used in Bengali, |
2796 | Devanagari, Gurmukhi, and Oriya, but no other scripts. | |
62b3b855 | 2797 | |
647396da | 2798 | The Name_Alias property is also of this form. But each scalar consists of two |
58b75e36 | 2799 | components: 1) the name, and 2) the type of alias this is. They are |
7620cb10 KW |
2800 | separated by a colon and a space. In Unicode 6.1, there are several alias types: |
2801 | ||
2802 | =over | |
2803 | ||
2804 | =item C<correction> | |
2805 | ||
2806 | indicates that the name is a corrected form for the | |
2807 | original name (which remains valid) for the same code point. | |
2808 | ||
2809 | =item C<control> | |
2810 | ||
2811 | adds a new name for a control character. | |
2812 | ||
2813 | =item C<alternate> | |
2814 | ||
2815 | is an alternate name for a character | |
2816 | ||
2817 | =item C<figment> | |
2818 | ||
2819 | is a name for a character that has been documented but was never in any | |
2820 | actual standard. | |
2821 | ||
2822 | =item C<abbreviation> | |
2823 | ||
2824 | is a common abbreviation for a character | |
2825 | ||
2826 | =back | |
2827 | ||
2828 | The lists are ordered (roughly) so the most preferred names come before less | |
2829 | preferred ones. | |
58b75e36 KW |
2830 | |
2831 | For example, | |
2832 | ||
7620cb10 KW |
2833 | @aliases_ranges @alias_maps |
2834 | ... | |
2835 | 0x009E [ 'PRIVACY MESSAGE: control', 'PM: abbreviation' ] | |
2836 | 0x009F [ 'APPLICATION PROGRAM COMMAND: control', | |
2837 | 'APC: abbreviation' | |
2838 | ] | |
2839 | 0x00A0 'NBSP: abbreviation' | |
2840 | 0x00A1 "" | |
2841 | 0x00AD 'SHY: abbreviation' | |
2842 | 0x00AE "" | |
2843 | 0x01A2 'LATIN CAPITAL LETTER GHA: correction' | |
2844 | 0x01A3 'LATIN SMALL LETTER GHA: correction' | |
2845 | 0x01A4 "" | |
58b75e36 | 2846 | ... |
58b75e36 | 2847 | |
7620cb10 KW |
2848 | A map to the empty string means that there is no alias defined for the code |
2849 | point. | |
58b75e36 | 2850 | |
d11155ec | 2851 | =item B<C<a>> |
62b3b855 | 2852 | |
647396da | 2853 | is like C<"s"> in that all the map array elements are scalars, but here they are |
d11155ec KW |
2854 | restricted to all being integers, and some have to be adjusted (hence the name |
2855 | C<"a">) to get the correct result. For example, in: | |
62b3b855 | 2856 | |
5b2b1977 | 2857 | my ($uppers_ranges_ref, $uppers_maps_ref, $format, $default) |
62b3b855 KW |
2858 | = prop_invmap("Simple_Uppercase_Mapping"); |
2859 | ||
2860 | the returned arrays look like this: | |
2861 | ||
2862 | @$uppers_ranges_ref @$uppers_maps_ref Note | |
bf7fe2df | 2863 | 0 0 |
d11155ec | 2864 | 97 65 'a' maps to 'A', b => B ... |
bf7fe2df | 2865 | 123 0 |
d11155ec | 2866 | 181 924 MICRO SIGN => Greek Cap MU |
bf7fe2df | 2867 | 182 0 |
62b3b855 KW |
2868 | ... |
2869 | ||
5b2b1977 KW |
2870 | and C<$default> is 0. |
2871 | ||
d11155ec KW |
2872 | Let's start with the second line. It says that the uppercase of code point 97 |
2873 | is 65; or C<uc("a")> == "A". But the line is for the entire range of code | |
5b2b1977 KW |
2874 | points 97 through 122. To get the mapping for any code point in this range, |
2875 | you take the offset it has from the beginning code point of the range, and add | |
d11155ec KW |
2876 | that to the mapping for that first code point. So, the mapping for 122 ("z") |
2877 | is derived by taking the offset of 122 from 97 (=25) and adding that to 65, | |
2878 | yielding 90 ("z"). Likewise for everything in between. | |
2879 | ||
d11155ec KW |
2880 | Requiring this simple adjustment allows the returned arrays to be |
2881 | significantly smaller than otherwise, up to a factor of 10, speeding up | |
2882 | searching through them. | |
62b3b855 | 2883 | |
5b2b1977 KW |
2884 | Ranges that map to C<$default>, C<"0">, behave somewhat differently. For |
2885 | these, each code point maps to itself. So, in the first line in the example, | |
2886 | S<C<ord(uc(chr(0)))>> is 0, S<C<ord(uc(chr(1)))>> is 1, .. | |
2887 | S<C<ord(uc(chr(96)))>> is 96. | |
2888 | ||
d11155ec | 2889 | =item B<C<al>> |
62b3b855 | 2890 | |
d11155ec | 2891 | means that some of the map array elements have the form given by C<"a">, and |
62b3b855 KW |
2892 | the rest are ordered lists of code points. |
2893 | For example, in: | |
2894 | ||
5b2b1977 | 2895 | my ($uppers_ranges_ref, $uppers_maps_ref, $format, $default) |
62b3b855 KW |
2896 | = prop_invmap("Uppercase_Mapping"); |
2897 | ||
2898 | the returned arrays look like this: | |
2899 | ||
2900 | @$uppers_ranges_ref @$uppers_maps_ref | |
bf7fe2df | 2901 | 0 0 |
d11155ec | 2902 | 97 65 |
bf7fe2df | 2903 | 123 0 |
d11155ec | 2904 | 181 924 |
bf7fe2df | 2905 | 182 0 |
62b3b855 KW |
2906 | ... |
2907 | 0x0149 [ 0x02BC 0x004E ] | |
bf7fe2df | 2908 | 0x014A 0 |
d11155ec | 2909 | 0x014B 330 |
62b3b855 KW |
2910 | ... |
2911 | ||
2912 | This is the full Uppercase_Mapping property (as opposed to the | |
d11155ec | 2913 | Simple_Uppercase_Mapping given in the example for format C<"a">). The only |
62b3b855 KW |
2914 | difference between the two in the ranges shown is that the code point at |
2915 | 0x0149 (LATIN SMALL LETTER N PRECEDED BY APOSTROPHE) maps to a string of two | |
2916 | characters, 0x02BC (MODIFIER LETTER APOSTROPHE) followed by 0x004E (LATIN | |
2917 | CAPITAL LETTER N). | |
2918 | ||
d11155ec KW |
2919 | No adjustments are needed to entries that are references to arrays; each such |
2920 | entry will have exactly one element in its range, so the offset is always 0. | |
bf7fe2df | 2921 | |
5b2b1977 KW |
2922 | The fourth (index [3]) element (C<$default>) in the list returned for this |
2923 | format is 0. | |
2924 | ||
d11155ec | 2925 | =item B<C<ae>> |
b0b13ada | 2926 | |
d11155ec KW |
2927 | This is like C<"a">, but some elements are the empty string, and should not be |
2928 | adjusted. | |
b0b13ada KW |
2929 | The one internal Perl property accessible by C<prop_invmap> is of this type: |
2930 | "Perl_Decimal_Digit" returns an inversion map which gives the numeric values | |
2931 | that are represented by the Unicode decimal digit characters. Characters that | |
2932 | don't represent decimal digits map to the empty string, like so: | |
2933 | ||
2934 | @digits @values | |
2935 | 0x0000 "" | |
d11155ec | 2936 | 0x0030 0 |
b0b13ada | 2937 | 0x003A: "" |
d11155ec | 2938 | 0x0660: 0 |
b0b13ada | 2939 | 0x066A: "" |
d11155ec | 2940 | 0x06F0: 0 |
b0b13ada | 2941 | 0x06FA: "" |
d11155ec | 2942 | 0x07C0: 0 |
b0b13ada | 2943 | 0x07CA: "" |
d11155ec | 2944 | 0x0966: 0 |
b0b13ada KW |
2945 | ... |
2946 | ||
2947 | This means that the code points from 0 to 0x2F do not represent decimal digits; | |
d11155ec KW |
2948 | the code point 0x30 (DIGIT ZERO) represents 0; code point 0x31, (DIGIT ONE), |
2949 | represents 0+1-0 = 1; ... code point 0x39, (DIGIT NINE), represents 0+9-0 = 9; | |
2950 | ... code points 0x3A through 0x65F do not represent decimal digits; 0x660 | |
2951 | (ARABIC-INDIC DIGIT ZERO), represents 0; ... 0x07C1 (NKO DIGIT ONE), | |
2952 | represents 0+1-0 = 1 ... | |
b0b13ada | 2953 | |
5b2b1977 KW |
2954 | The fourth (index [3]) element (C<$default>) in the list returned for this |
2955 | format is the empty string. | |
2956 | ||
d11155ec | 2957 | =item B<C<ale>> |
62b3b855 | 2958 | |
d11155ec KW |
2959 | is a combination of the C<"al"> type and the C<"ae"> type. Some of |
2960 | the map array elements have the forms given by C<"al">, and | |
62b3b855 KW |
2961 | the rest are the empty string. The property C<NFKC_Casefold> has this form. |
2962 | An example slice is: | |
2963 | ||
2964 | @$ranges_ref @$maps_ref Note | |
2965 | ... | |
d11155ec KW |
2966 | 0x00AA 97 FEMININE ORDINAL INDICATOR => 'a' |
2967 | 0x00AB 0 | |
62b3b855 | 2968 | 0x00AD SOFT HYPHEN => "" |
d11155ec | 2969 | 0x00AE 0 |
62b3b855 | 2970 | 0x00AF [ 0x0020, 0x0304 ] MACRON => SPACE . COMBINING MACRON |
d11155ec | 2971 | 0x00B0 0 |
62b3b855 KW |
2972 | ... |
2973 | ||
5b2b1977 KW |
2974 | The fourth (index [3]) element (C<$default>) in the list returned for this |
2975 | format is 0. | |
2976 | ||
4f143a72 | 2977 | =item B<C<ar>> |
6cc45523 KW |
2978 | |
2979 | means that all the elements of the map array are either rational numbers or | |
2980 | the string C<"NaN">, meaning "Not a Number". A rational number is either an | |
2981 | integer, or two integers separated by a solidus (C<"/">). The second integer | |
2982 | represents the denominator of the division implied by the solidus, and is | |
60c78852 | 2983 | actually always positive, so it is guaranteed not to be 0 and to not be |
6329003c | 2984 | signed. When the element is a plain integer (without the |
4f143a72 KW |
2985 | solidus), it may need to be adjusted to get the correct value by adding the |
2986 | offset, just as other C<"a"> properties. No adjustment is needed for | |
2987 | fractions, as the range is guaranteed to have just a single element, and so | |
2988 | the offset is always 0. | |
2989 | ||
2990 | If you want to convert the returned map to entirely scalar numbers, you | |
6cc45523 KW |
2991 | can use something like this: |
2992 | ||
2993 | my ($invlist_ref, $invmap_ref, $format) = prop_invmap($property); | |
4f143a72 | 2994 | if ($format && $format eq "ar") { |
60c78852 | 2995 | map { $_ = eval $_ if $_ ne 'NaN' } @$map_ref; |
6cc45523 KW |
2996 | } |
2997 | ||
2998 | Here's some entries from the output of the property "Nv", which has format | |
4f143a72 | 2999 | C<"ar">. |
6cc45523 | 3000 | |
4f143a72 | 3001 | @numerics_ranges @numerics_maps Note |
6cc45523 | 3002 | 0x00 "NaN" |
4f143a72 | 3003 | 0x30 0 DIGIT 0 .. DIGIT 9 |
6cc45523 | 3004 | 0x3A "NaN" |
4f143a72 | 3005 | 0xB2 2 SUPERSCRIPTs 2 and 3 |
6cc45523 | 3006 | 0xB4 "NaN" |
4f143a72 | 3007 | 0xB9 1 SUPERSCRIPT 1 |
6cc45523 | 3008 | 0xBA "NaN" |
4f143a72 KW |
3009 | 0xBC 1/4 VULGAR FRACTION 1/4 |
3010 | 0xBD 1/2 VULGAR FRACTION 1/2 | |
3011 | 0xBE 3/4 VULGAR FRACTION 3/4 | |
6cc45523 | 3012 | 0xBF "NaN" |
4f143a72 KW |
3013 | 0x660 0 ARABIC-INDIC DIGIT ZERO .. NINE |
3014 | 0x66A "NaN" | |
6cc45523 | 3015 | |
5b2b1977 KW |
3016 | The fourth (index [3]) element (C<$default>) in the list returned for this |
3017 | format is C<"NaN">. | |
3018 | ||
dc8d8ea6 | 3019 | =item B<C<n>> |
62b3b855 KW |
3020 | |
3021 | means the Name property. All the elements of the map array are simple | |
3022 | scalars, but some of them contain special strings that require more work to | |
3023 | get the actual name. | |
3024 | ||
3025 | Entries such as: | |
3026 | ||
3027 | CJK UNIFIED IDEOGRAPH-<code point> | |
3028 | ||
3029 | mean that the name for the code point is "CJK UNIFIED IDEOGRAPH-" | |
3030 | with the code point (expressed in hexadecimal) appended to it, like "CJK | |
647396da KW |
3031 | UNIFIED IDEOGRAPH-3403" (similarly for S<C<CJK COMPATIBILITY IDEOGRAPH-E<lt>code |
3032 | pointE<gt>>>). | |
62b3b855 KW |
3033 | |
3034 | Also, entries like | |
3035 | ||
3036 | <hangul syllable> | |
3037 | ||
3038 | means that the name is algorithmically calculated. This is easily done by | |
3039 | the function L<charnames/charnames::viacode(code)>. | |
3040 | ||
3041 | Note that for control characters (C<Gc=cc>), Unicode's data files have the | |
3042 | string "C<E<lt>controlE<gt>>", but the real name of each of these characters is the empty | |
7620cb10 | 3043 | string. This function returns that real name, the empty string. (There are |
647396da KW |
3044 | names for these characters, but they are considered aliases, not the Name |
3045 | property name, and are contained in the C<Name_Alias> property.) | |
62b3b855 | 3046 | |
d11155ec | 3047 | =item B<C<ad>> |
62b3b855 | 3048 | |
d11155ec | 3049 | means the Decomposition_Mapping property. This property is like C<"al"> |
bea2c146 | 3050 | properties, except that one of the scalar elements is of the form: |
62b3b855 KW |
3051 | |
3052 | <hangul syllable> | |
3053 | ||
bea2c146 KW |
3054 | This signifies that this entry should be replaced by the decompositions for |
3055 | all the code points whose decomposition is algorithmically calculated. (All | |
13d1b68a | 3056 | of them are currently in one range and no others outside the range are likely |
6329003c | 3057 | to ever be added to Unicode; the C<"n"> format |
bea2c146 | 3058 | has this same entry.) These can be generated via the function |
62b3b855 KW |
3059 | L<Unicode::Normalize::NFD()|Unicode::Normalize>. |
3060 | ||
62b3b855 KW |
3061 | Note that the mapping is the one that is specified in the Unicode data files, |
3062 | and to get the final decomposition, it may need to be applied recursively. | |
b0e24409 KW |
3063 | Unicode in fact discourages use of this property except internally in |
3064 | implementations of the Unicode Normalization Algorithm. | |
62b3b855 | 3065 | |
5b2b1977 KW |
3066 | The fourth (index [3]) element (C<$default>) in the list returned for this |
3067 | format is 0. | |
3068 | ||
62b3b855 KW |
3069 | =back |
3070 | ||
d11155ec KW |
3071 | Note that a format begins with the letter "a" if and only the property it is |
3072 | for requires adjustments by adding the offsets in multi-element ranges. For | |
3073 | all these properties, an entry should be adjusted only if the map is a scalar | |
3074 | which is an integer. That is, it must match the regular expression: | |
3075 | ||
3076 | / ^ -? \d+ $ /xa | |
3077 | ||
3078 | Further, the first element in a range never needs adjustment, as the | |
3079 | adjustment would be just adding 0. | |
3080 | ||
1fdd5e53 KW |
3081 | A binary search such as that provided by L</search_invlist()>, can be used to |
3082 | quickly find a code point in the inversion list, and hence its corresponding | |
3083 | mapping. | |
62b3b855 | 3084 | |
5b2b1977 KW |
3085 | The final, fourth element (index [3], assigned to C<$default> in the "block" |
3086 | example) in the four element list returned by this function is used with the | |
3087 | C<"a"> format types; it may also be useful for applications | |
62b3b855 KW |
3088 | that wish to convert the returned inversion map data structure into some |
3089 | other, such as a hash. It gives the mapping that most code points map to | |
3090 | under the property. If you establish the convention that any code point not | |
3091 | explicitly listed in your data structure maps to this value, you can | |
3092 | potentially make your data structure much smaller. As you construct your data | |
3093 | structure from the one returned by this function, simply ignore those ranges | |
5b2b1977 | 3094 | that map to this value. For example, to |
62b3b855 | 3095 | convert to the data structure searchable by L</charinrange()>, you can follow |
6329003c | 3096 | this recipe for properties that don't require adjustments: |
62b3b855 | 3097 | |
ad5f730f | 3098 | my ($list_ref, $map_ref, $format, $default) = prop_invmap($property); |
62b3b855 | 3099 | my @range_list; |
6329003c KW |
3100 | |
3101 | # Look at each element in the list, but the -2 is needed because we | |
3102 | # look at $i+1 in the loop, and the final element is guaranteed to map | |
ad5f730f | 3103 | # to $default by prop_invmap(), so we would skip it anyway. |
62b3b855 | 3104 | for my $i (0 .. @$list_ref - 2) { |
ad5f730f | 3105 | next if $map_ref->[$i] eq $default; |
62b3b855 KW |
3106 | push @range_list, [ $list_ref->[$i], |
3107 | $list_ref->[$i+1], | |
3108 | $map_ref->[$i] | |
3109 | ]; | |
3110 | } | |
3111 | ||
3112 | print charinrange(\@range_list, $code_point), "\n"; | |
3113 | ||
62b3b855 | 3114 | With this, C<charinrange()> will return C<undef> if its input code point maps |
ad5f730f | 3115 | to C<$default>. You can avoid this by omitting the C<next> statement, and adding |
62b3b855 KW |
3116 | a line after the loop to handle the final element of the inversion map. |
3117 | ||
6329003c KW |
3118 | Similarly, this recipe can be used for properties that do require adjustments: |
3119 | ||
3120 | for my $i (0 .. @$list_ref - 2) { | |
ad5f730f | 3121 | next if $map_ref->[$i] eq $default; |
6329003c KW |
3122 | |
3123 | # prop_invmap() guarantees that if the mapping is to an array, the | |
3124 | # range has just one element, so no need to worry about adjustments. | |
3125 | if (ref $map_ref->[$i]) { | |
3126 | push @range_list, | |
3127 | [ $list_ref->[$i], $list_ref->[$i], $map_ref->[$i] ]; | |
3128 | } | |
3129 | else { # Otherwise each element is actually mapped to a separate | |
3130 | # value, so the range has to be split into single code point | |
3131 | # ranges. | |
3132 | ||
3133 | my $adjustment = 0; | |
3134 | ||
3135 | # For each code point that gets mapped to something... | |
3136 | for my $j ($list_ref->[$i] .. $list_ref->[$i+1] -1 ) { | |
3137 | ||
3138 | # ... add a range consisting of just it mapping to the | |
3139 | # original plus the adjustment, which is incremented for the | |
3140 | # next time through the loop, as the offset increases by 1 | |
3141 | # for each element in the range | |
3142 | push @range_list, | |
3143 | [ $j, $j, $map_ref->[$i] + $adjustment++ ]; | |
3144 | } | |
3145 | } | |
3146 | } | |
62b3b855 KW |
3147 | |
3148 | Note that the inversion maps returned for the C<Case_Folding> and | |
3149 | C<Simple_Case_Folding> properties do not include the Turkic-locale mappings. | |
3150 | Use L</casefold()> for these. | |
3151 | ||
62b3b855 KW |
3152 | C<prop_invmap> does not know about any user-defined properties, and will |
3153 | return C<undef> if called with one of those. | |
3154 | ||
91e78470 KW |
3155 | The returned values for the Perl extension properties, such as C<Any> and |
3156 | C<Greek> are somewhat misleading. The values are either C<"Y"> or C<"N>". | |
3157 | All Unicode properties are bipartite, so you can actually use the C<"Y"> or | |
816b0b09 | 3158 | C<"N>" in a Perl regular expression for these, like C<qr/\p{ID_Start=Y/}> or |
91e78470 KW |
3159 | C<qr/\p{Upper=N/}>. But the Perl extensions aren't specified this way, only |
3160 | like C</qr/\p{Any}>, I<etc>. You can't actually use the C<"Y"> and C<"N>" in | |
3161 | them. | |
3162 | ||
816b0b09 MB |
3163 | =head3 Getting every available name |
3164 | ||
3165 | Instead of reading the Unicode Database directly from files, as you were able | |
3166 | to do for a long time, you are encouraged to use the supplied functions. So, | |
53597948 MB |
3167 | instead of reading C<Name.pl> - which may disappear without notice in the |
3168 | future - directly, as with | |
816b0b09 MB |
3169 | |
3170 | my (%name, %cp); | |
3171 | for (split m/\s*\n/ => do "unicore/Name.pl") { | |
3172 | my ($cp, $name) = split m/\t/ => $_; | |
3173 | $cp{$name} = $cp; | |
3174 | $name{$cp} = $name unless $cp =~ m/ /; | |
3175 | } | |
3176 | ||
3177 | You ought to use L</prop_invmap> like this: | |
3178 | ||
3179 | my (%name, %cp, %cps, $n); | |
3180 | # All codepoints | |
3181 | foreach my $cat (qw( Name Name_Alias )) { | |
3182 | my ($codepoints, $names, $format, $default) = prop_invmap($cat); | |
3183 | # $format => "n", $default => "" | |
3184 | foreach my $i (0 .. @$codepoints - 2) { | |
3185 | my ($cp, $n) = ($codepoints->[$i], $names->[$i]); | |
3186 | # If $n is a ref, the same codepoint has multiple names | |
3187 | foreach my $name (ref $n ? @$n : $n) { | |
3188 | $name{$cp} //= $name; | |
3189 | $cp{$name} //= $cp; | |
3190 | } | |
3191 | } | |
3192 | } | |
3193 | # Named sequences | |
3194 | { my %ns = namedseq(); | |
3195 | foreach my $name (sort { $ns{$a} cmp $ns{$b} } keys %ns) { | |
3196 | $cp{$name} //= [ map { ord } split "" => $ns{$name} ]; | |
3197 | } | |
3198 | } | |
3199 | ||
62b3b855 KW |
3200 | =cut |
3201 | ||
3202 | # User-defined properties could be handled with some changes to utf8_heavy.pl; | |
3203 | # if done, consideration should be given to the fact that the user subroutine | |
3204 | # could return different results with each call, which could lead to some | |
3205 | # security issues. | |
3206 | ||
3207 | # One could store things in memory so they don't have to be recalculated, but | |
3208 | # it is unlikely this will be called often, and some properties would take up | |
3209 | # significant memory. | |
3210 | ||
3211 | # These are created by mktables for this routine and stored in unicore/UCD.pl | |
3212 | # where their structures are described. | |
3213 | our @algorithmic_named_code_points; | |
3214 | our $HANGUL_BEGIN; | |
3215 | our $HANGUL_COUNT; | |
3216 | ||
088d3c62 | 3217 | sub prop_invmap ($;$) { |
62b3b855 KW |
3218 | |
3219 | croak __PACKAGE__, "::prop_invmap: must be called in list context" unless wantarray; | |
3220 | ||
3221 | my $prop = $_[0]; | |
3222 | return unless defined $prop; | |
3223 | ||
088d3c62 KW |
3224 | # Undocumented way to get at Perl internal properties; it may be changed |
3225 | # or removed without notice at any time. It currently also changes the | |
3226 | # output to use the format specified in the file rather than the one we | |
3227 | # normally compute and return | |
3228 | my $internal_ok = defined $_[1] && $_[1] eq '_perl_core_internal_ok'; | |
3229 | ||
62b3b855 | 3230 | # Fail internal properties |
088d3c62 | 3231 | return if $prop =~ /^_/ && ! $internal_ok; |
62b3b855 KW |
3232 | |
3233 | # The values returned by this function. | |
3234 | my (@invlist, @invmap, $format, $missing); | |
3235 | ||
3236 | # The swash has two components we look at, the base list, and a hash, | |
3237 | # named 'SPECIALS', containing any additional members whose mappings don't | |
13d1b68a | 3238 | # fit into the base list scheme of things. These generally 'override' |
62b3b855 KW |
3239 | # any value in the base list for the same code point. |
3240 | my $overrides; | |
3241 | ||
3242 | require "utf8_heavy.pl"; | |
3243 | require "unicore/UCD.pl"; | |
3244 | ||
3245 | RETRY: | |
3246 | ||
647396da KW |
3247 | # If there are multiple entries for a single code point |
3248 | my $has_multiples = 0; | |
3249 | ||
62b3b855 KW |
3250 | # Try to get the map swash for the property. They have 'To' prepended to |
3251 | # the property name, and 32 means we will accept 32 bit return values. | |
647396da | 3252 | # The 0 means we aren't calling this from tr///. |
62b3b855 KW |
3253 | my $swash = utf8::SWASHNEW(__PACKAGE__, "To$prop", undef, 32, 0); |
3254 | ||
3255 | # If didn't find it, could be because needs a proxy. And if was the | |
3256 | # 'Block' or 'Name' property, use a proxy even if did find it. Finding it | |
647396da KW |
3257 | # in these cases would be the result of the installation changing mktables |
3258 | # to output the Block or Name tables. The Block table gives block names | |
3259 | # in the new-style, and this routine is supposed to return old-style block | |
3260 | # names. The Name table is valid, but we need to execute the special code | |
3261 | # below to add in the algorithmic-defined name entries. | |
34132297 | 3262 | # And NFKCCF needs conversion, so handle that here too. |
62b3b855 | 3263 | if (ref $swash eq "" |
34132297 | 3264 | || $swash->{'TYPE'} =~ / ^ To (?: Blk | Na | NFKCCF ) $ /x) |
62b3b855 KW |
3265 | { |
3266 | ||
3267 | # Get the short name of the input property, in standard form | |
3268 | my ($second_try) = prop_aliases($prop); | |
3269 | return unless $second_try; | |
3270 | $second_try = utf8::_loose_name(lc $second_try); | |
3271 | ||
3272 | if ($second_try eq "in") { | |
3273 | ||
3274 | # This property is identical to age for inversion map purposes | |
3275 | $prop = "age"; | |
3276 | goto RETRY; | |
3277 | } | |
cfc5eb77 | 3278 | elsif ($second_try =~ / ^ s ( cf | fc | [ltu] c ) $ /x) { |
62b3b855 | 3279 | |
75e7c50b KW |
3280 | # These properties use just the LIST part of the full mapping, |
3281 | # which includes the simple maps that are otherwise overridden by | |
3282 | # the SPECIALS. So all we need do is to not look at the SPECIALS; | |
3283 | # set $overrides to indicate that | |
62b3b855 | 3284 | $overrides = -1; |
62b3b855 | 3285 | |
75e7c50b | 3286 | # The full name is the simple name stripped of its initial 's' |
cfc5eb77 KW |
3287 | $prop = $1; |
3288 | ||
3289 | # .. except for this case | |
3290 | $prop = 'cf' if $prop eq 'fc'; | |
3291 | ||
62b3b855 KW |
3292 | goto RETRY; |
3293 | } | |
3294 | elsif ($second_try eq "blk") { | |
3295 | ||
3296 | # We use the old block names. Just create a fake swash from its | |
3297 | # data. | |
3298 | _charblocks(); | |
3299 | my %blocks; | |
3300 | $blocks{'LIST'} = ""; | |
3301 | $blocks{'TYPE'} = "ToBlk"; | |
3302 | $utf8::SwashInfo{ToBlk}{'missing'} = "No_Block"; | |
3303 | $utf8::SwashInfo{ToBlk}{'format'} = "s"; | |
3304 | ||
3305 | foreach my $block (@BLOCKS) { | |
3306 | $blocks{'LIST'} .= sprintf "%x\t%x\t%s\n", | |
3307 | $block->[0], | |
3308 | $block->[1], | |
3309 | $block->[2]; | |
3310 | } | |
3311 | $swash = \%blocks; | |
3312 | } | |
3313 | elsif ($second_try eq "na") { | |
3314 | ||
3315 | # Use the combo file that has all the Name-type properties in it, | |
3316 | # extracting just the ones that are for the actual 'Name' | |
3317 | # property. And create a fake swash from it. | |
3318 | my %names; | |
3319 | $names{'LIST'} = ""; | |
3320 | my $original = do "unicore/Name.pl"; | |
62b3b855 KW |
3321 | my $algorithm_names = \@algorithmic_named_code_points; |
3322 | ||
3b6a8189 KW |
3323 | # We need to remove the names from it that are aliases. For that |
3324 | # we need to also read in that table. Create a hash with the keys | |
3325 | # being the code points, and the values being a list of the | |
3326 | # aliases for the code point key. | |
ce8d64d9 KW |
3327 | my ($aliases_code_points, $aliases_maps, undef, undef) |
3328 | = &prop_invmap("_Perl_Name_Alias", '_perl_core_internal_ok'); | |
3b6a8189 KW |
3329 | my %aliases; |
3330 | for (my $i = 0; $i < @$aliases_code_points; $i++) { | |
3331 | my $code_point = $aliases_code_points->[$i]; | |
3332 | $aliases{$code_point} = $aliases_maps->[$i]; | |
3333 | ||
3334 | # If not already a list, make it into one, so that later we | |
3335 | # can treat things uniformly | |
3336 | if (! ref $aliases{$code_point}) { | |
3337 | $aliases{$code_point} = [ $aliases{$code_point} ]; | |
3338 | } | |
3339 | ||
3340 | # Remove the alias type from the entry, retaining just the | |
3341 | # name. | |
3342 | map { s/:.*// } @{$aliases{$code_point}}; | |
3343 | } | |
3344 | ||
62b3b855 KW |
3345 | my $i = 0; |
3346 | foreach my $line (split "\n", $original) { | |
3347 | my ($hex_code_point, $name) = split "\t", $line; | |
3348 | ||
3349 | # Weeds out all comments, blank lines, and named sequences | |
df46a385 | 3350 | next if $hex_code_point =~ /[^[:xdigit:]]/a; |
62b3b855 KW |
3351 | |
3352 | my $code_point = hex $hex_code_point; | |
3353 | ||
3354 | # The name of all controls is the default: the empty string. | |
a1ae4420 KW |
3355 | # The set of controls is immutable |
3356 | next if chr($code_point) =~ /[[:cntrl:]]/u; | |
62b3b855 | 3357 | |
3b6a8189 KW |
3358 | # If this is a name_alias, it isn't a name |
3359 | next if grep { $_ eq $name } @{$aliases{$code_point}}; | |
62b3b855 KW |
3360 | |
3361 | # If we are beyond where one of the special lines needs to | |
3362 | # be inserted ... | |
3b6a8189 | 3363 | while ($i < @$algorithm_names |
62b3b855 KW |
3364 | && $code_point > $algorithm_names->[$i]->{'low'}) |
3365 | { | |
3366 | ||
3367 | # ... then insert it, ahead of what we were about to | |
3368 | # output | |
3b6a8189 | 3369 | $names{'LIST'} .= sprintf "%x\t%x\t%s\n", |
62b3b855 KW |
3370 | $algorithm_names->[$i]->{'low'}, |
3371 | $algorithm_names->[$i]->{'high'}, | |
3372 | $algorithm_names->[$i]->{'name'}; | |
3373 | ||
62b3b855 KW |
3374 | # Done with this range. |
3375 | $i++; | |
3376 | ||
3b6a8189 KW |
3377 | # We loop until all special lines that precede the next |
3378 | # regular one are output. | |
62b3b855 KW |
3379 | } |
3380 | ||
3b6a8189 KW |
3381 | # Here, is a normal name. |
3382 | $names{'LIST'} .= sprintf "%x\t\t%s\n", $code_point, $name; | |
3383 | } # End of loop through all the names | |
62b3b855 KW |
3384 | |
3385 | $names{'TYPE'} = "ToNa"; | |
3386 | $utf8::SwashInfo{ToNa}{'missing'} = ""; | |
3387 | $utf8::SwashInfo{ToNa}{'format'} = "n"; | |
3388 | $swash = \%names; | |
3389 | } | |
3390 | elsif ($second_try =~ / ^ ( d [mt] ) $ /x) { | |
3391 | ||
3392 | # The file is a combination of dt and dm properties. Create a | |
3393 | # fake swash from the portion that we want. | |
3394 | my $original = do "unicore/Decomposition.pl"; | |
3395 | my %decomps; | |
3396 | ||
3397 | if ($second_try eq 'dt') { | |
3398 | $decomps{'TYPE'} = "ToDt"; | |
3399 | $utf8::SwashInfo{'ToDt'}{'missing'} = "None"; | |
3400 | $utf8::SwashInfo{'ToDt'}{'format'} = "s"; | |
d11155ec | 3401 | } # 'dm' is handled below, with 'nfkccf' |
62b3b855 KW |
3402 | |
3403 | $decomps{'LIST'} = ""; | |
3404 | ||
3405 | # This property has one special range not in the file: for the | |
1a4c9760 KW |
3406 | # hangul syllables. But not in Unicode version 1. |
3407 | UnicodeVersion() unless defined $v_unicode_version; | |
3408 | my $done_hangul = ($v_unicode_version lt v2.0.0) | |
3409 | ? 1 | |
3410 | : 0; # Have we done the hangul range ? | |
62b3b855 KW |
3411 | foreach my $line (split "\n", $original) { |
3412 | my ($hex_lower, $hex_upper, $type_and_map) = split "\t", $line; | |
3413 | my $code_point = hex $hex_lower; | |
3414 | my $value; | |
bea2c146 | 3415 | my $redo = 0; |
62b3b855 KW |
3416 | |
3417 | # The type, enclosed in <...>, precedes the mapping separated | |
3418 | # by blanks | |
3419 | if ($type_and_map =~ / ^ < ( .* ) > \s+ (.*) $ /x) { | |
3420 | $value = ($second_try eq 'dt') ? $1 : $2 | |
3421 | } | |
3422 | else { # If there is no type specified, it's canonical | |
3423 | $value = ($second_try eq 'dt') | |
3424 | ? "Canonical" : | |
3425 | $type_and_map; | |
3426 | } | |
3427 | ||
3428 | # Insert the hangul range at the appropriate spot. | |
3429 | if (! $done_hangul && $code_point > $HANGUL_BEGIN) { | |
3430 | $done_hangul = 1; | |
3431 | $decomps{'LIST'} .= | |
3432 | sprintf "%x\t%x\t%s\n", | |
3433 | $HANGUL_BEGIN, | |
3434 | $HANGUL_BEGIN + $HANGUL_COUNT - 1, | |
3435 | ($second_try eq 'dt') | |
3436 | ? "Canonical" | |
3437 | : "<hangul syllable>"; | |
3438 | } | |
3439 | ||
1a4c9760 KW |
3440 | if ($value =~ / / && $hex_upper ne "" && $hex_upper ne $hex_lower) { |
3441 | $line = sprintf("%04X\t%s\t%s", hex($hex_lower) + 1, $hex_upper, $value); | |
3442 | $hex_upper = ""; | |
3443 | $redo = 1; | |
3444 | } | |
3445 | ||
62b3b855 KW |
3446 | # And append this to our constructed LIST. |
3447 | $decomps{'LIST'} .= "$hex_lower\t$hex_upper\t$value\n"; | |
bea2c146 KW |
3448 | |
3449 | redo if $redo; | |
62b3b855 KW |
3450 | } |
3451 | $swash = \%decomps; | |
3452 | } | |
d11155ec KW |
3453 | elsif ($second_try ne 'nfkccf') { # Don't know this property. Fail. |
3454 | return; | |
3455 | } | |
3456 | ||
3457 | if ($second_try eq 'nfkccf' || $second_try eq 'dm') { | |
34132297 | 3458 | |
d11155ec KW |
3459 | # The 'nfkccf' property is stored in the old format for backwards |
3460 | # compatibility for any applications that has read its file | |
3461 | # directly before prop_invmap() existed. | |
3462 | # And the code above has extracted the 'dm' property from its file | |
3463 | # yielding the same format. So here we convert them to adjusted | |
3464 | # format for compatibility with the other properties similar to | |
3465 | # them. | |
3466 | my %revised_swash; | |
34132297 | 3467 | |
d11155ec | 3468 | # We construct a new converted list. |
34132297 | 3469 | my $list = ""; |
d11155ec KW |
3470 | |
3471 | my @ranges = split "\n", $swash->{'LIST'}; | |
3472 | for (my $i = 0; $i < @ranges; $i++) { | |
3473 | my ($hex_begin, $hex_end, $map) = split "\t", $ranges[$i]; | |
3474 | ||
3475 | # The dm property has maps that are space separated sequences | |
3476 | # of code points, as well as the special entry "<hangul | |
3477 | # syllable>, which also contains a blank. | |
3478 | my @map = split " ", $map; | |
3479 | if (@map > 1) { | |
3480 | ||
3481 | # If it's just the special entry, append as-is. | |
3482 | if ($map eq '<hangul syllable>') { | |
3483 | $list .= "$ranges[$i]\n"; | |
3484 | } | |
3485 | else { | |
3486 | ||
e2c04025 | 3487 | # These should all be single-element ranges. |
1a4c9760 | 3488 | croak __PACKAGE__, "::prop_invmap: Not expecting a mapping with multiple code points in a multi-element range, $ranges[$i]" if $hex_end ne "" && $hex_end ne $hex_begin; |
d11155ec KW |
3489 | |
3490 | # Convert them to decimal, as that's what's expected. | |
3491 | $list .= "$hex_begin\t\t" | |
3492 | . join(" ", map { hex } @map) | |
3493 | . "\n"; | |
3494 | } | |
3495 | next; | |
3496 | } | |
3497 | ||
3498 | # Here, the mapping doesn't have a blank, is for a single code | |
3499 | # point. | |
34132297 KW |
3500 | my $begin = hex $hex_begin; |
3501 | my $end = (defined $hex_end && $hex_end ne "") | |
3502 | ? hex $hex_end | |
3503 | : $begin; | |
d11155ec KW |
3504 | |
3505 | # Again, the output is to be in decimal. | |
34132297 | 3506 | my $decimal_map = hex $map; |
d11155ec KW |
3507 | |
3508 | # We know that multi-element ranges with the same mapping | |
3509 | # should not be adjusted, as after the adjustment | |
3510 | # multi-element ranges are for consecutive increasing code | |
3511 | # points. Further, the final element in the list won't be | |
3512 | # adjusted, as there is nothing after it to include in the | |
3513 | # adjustment | |
3514 | if ($begin != $end || $i == @ranges -1) { | |
3515 | ||
3516 | # So just convert these to single-element ranges | |
3517 | foreach my $code_point ($begin .. $end) { | |
3518 | $list .= sprintf("%04X\t\t%d\n", | |
3519 | $code_point, $decimal_map); | |
3520 | } | |
34132297 | 3521 | } |
d11155ec | 3522 | else { |
34132297 | 3523 | |
d11155ec KW |
3524 | # Here, we have a candidate for adjusting. What we do is |
3525 | # look through the subsequent adjacent elements in the | |
3526 | # input. If the map to the next one differs by 1 from the | |
3527 | # one before, then we combine into a larger range with the | |
3528 | # initial map. Loop doing this until we find one that | |
3529 | # can't be combined. | |
3530 | ||
3531 | my $offset = 0; # How far away are we from the initial | |
3532 | # map | |
3533 | my $squished = 0; # ? Did we squish at least two | |
3534 | # elements together into one range | |
3535 | for ( ; $i < @ranges; $i++) { | |
3536 | my ($next_hex_begin, $next_hex_end, $next_map) | |
3537 | = split "\t", $ranges[$i+1]; | |
3538 | ||
3539 | # In the case of 'dm', the map may be a sequence of | |
3540 | # multiple code points, which are never combined with | |
3541 | # another range | |
3542 | last if $next_map =~ / /; | |
3543 | ||
3544 | $offset++; | |
3545 | my $next_decimal_map = hex $next_map; | |
3546 | ||
3547 | # If the next map is not next in sequence, it | |
3548 | # shouldn't be combined. | |
3549 | last if $next_decimal_map != $decimal_map + $offset; | |
3550 | ||
3551 | my $next_begin = hex $next_hex_begin; | |
3552 | ||
3553 | # Likewise, if the next element isn't adjacent to the | |
3554 | # previous one, it shouldn't be combined. | |
3555 | last if $next_begin != $begin + $offset; | |
3556 | ||
3557 | my $next_end = (defined $next_hex_end | |
3558 | && $next_hex_end ne "") | |
3559 | ? hex $next_hex_end | |
3560 | : $next_begin; | |
3561 | ||
3562 | # And finally, if the next element is a multi-element | |
3563 | # range, it shouldn't be combined. | |
3564 | last if $next_end != $next_begin; | |
3565 | ||
3566 | # Here, we will combine. Loop to see if we should | |
3567 | # combine the next element too. | |
3568 | $squished = 1; | |
3569 | } | |
3570 | ||
3571 | if ($squished) { | |
3572 | ||
3573 | # Here, 'i' is the element number of the last element to | |
3574 | # be combined, and the range is single-element, or we | |
3575 | # wouldn't be combining. Get it's code point. | |
3576 | my ($hex_end, undef, undef) = split "\t", $ranges[$i]; | |
3577 | $list .= "$hex_begin\t$hex_end\t$decimal_map\n"; | |
3578 | } else { | |
3579 | ||
13d1b68a | 3580 | # Here, no combining done. Just append the initial |
d11155ec KW |
3581 | # (and current) values. |
3582 | $list .= "$hex_begin\t\t$decimal_map\n"; | |
3583 | } | |
3584 | } | |
3585 | } # End of loop constructing the converted list | |
3586 | ||
3587 | # Finish up the data structure for our converted swash | |
3588 | my $type = ($second_try eq 'nfkccf') ? 'ToNFKCCF' : 'ToDm'; | |
3589 | $revised_swash{'LIST'} = $list; | |
3590 | $revised_swash{'TYPE'} = $type; | |
3591 | $revised_swash{'SPECIALS'} = $swash->{'SPECIALS'}; | |
3592 | $swash = \%revised_swash; | |
3593 | ||
3594 | $utf8::SwashInfo{$type}{'missing'} = 0; | |
3595 | $utf8::SwashInfo{$type}{'format'} = 'a'; | |
62b3b855 KW |
3596 | } |
3597 | } | |
3598 | ||
3599 | if ($swash->{'EXTRAS'}) { | |
3600 | carp __PACKAGE__, "::prop_invmap: swash returned for $prop unexpectedly has EXTRAS magic"; | |
3601 | return; | |
3602 | } | |
3603 | ||
3604 | # Here, have a valid swash return. Examine it. | |
34132297 | 3605 | my $returned_prop = $swash->{'TYPE'}; |
62b3b855 KW |
3606 | |
3607 | # All properties but binary ones should have 'missing' and 'format' | |
3608 | # entries | |
3609 | $missing = $utf8::SwashInfo{$returned_prop}{'missing'}; | |
3610 | $missing = 'N' unless defined $missing; | |
3611 | ||
3612 | $format = $utf8::SwashInfo{$returned_prop}{'format'}; | |
3613 | $format = 'b' unless defined $format; | |
3614 | ||
d11155ec KW |
3615 | my $requires_adjustment = $format =~ /^a/; |
3616 | ||
31aa6e0b KW |
3617 | if ($swash->{'LIST'} =~ /^V/) { |
3618 | @invlist = split "\n", $swash->{'LIST'} =~ s/ \s* (?: \# .* )? $ //xmgr; | |
41e588f3 KW |
3619 | |
3620 | shift @invlist; # Get rid of 'V'; | |
3621 | ||
3622 | # Could need to be inverted: add or subtract a 0 at the beginning of | |
3623 | # the list. | |
3624 | if ($swash->{'INVERT_IT'}) { | |
3625 | if (@invlist && $invlist[0] == 0) { | |
3626 | shift @invlist; | |
3627 | } | |
3628 | else { | |
3629 | unshift @invlist, 0; | |
3630 | } | |
3631 | } | |
31aa6e0b KW |
3632 | foreach my $i (0 .. @invlist - 1) { |
3633 | $invmap[$i] = ($i % 2 == 0) ? 'Y' : 'N' | |
3634 | } | |
3635 | ||
3636 | # The map includes lines for all code points; add one for the range | |
3637 | # from 0 to the first Y. | |
3638 | if ($invlist[0] != 0) { | |
3639 | unshift @invlist, 0; | |
3640 | unshift @invmap, 'N'; | |
3641 | } | |
3642 | } | |
3643 | else { | |
41e588f3 KW |
3644 | if ($swash->{'INVERT_IT'}) { |
3645 | croak __PACKAGE__, ":prop_invmap: Don't know how to deal with inverted"; | |
3646 | } | |
3647 | ||
1784d2f9 KW |
3648 | # The LIST input lines look like: |
3649 | # ... | |
3650 | # 0374\t\tCommon | |
3651 | # 0375\t0377\tGreek # [3] | |
3652 | # 037A\t037D\tGreek # [4] | |
3653 | # 037E\t\tCommon | |
3654 | # 0384\t\tGreek | |
3655 | # ... | |
92bcf67b | 3656 | # |
1784d2f9 KW |
3657 | # Convert them to like |
3658 | # 0374 => Common | |
3659 | # 0375 => Greek | |
3660 | # 0378 => $missing | |
3661 | # 037A => Greek | |
3662 | # 037E => Common | |
3663 | # 037F => $missing | |
3664 | # 0384 => Greek | |
3665 | # | |
3666 | # For binary properties, the final non-comment column is absent, and | |
3667 | # assumed to be 'Y'. | |