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