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