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