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