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