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