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