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