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