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