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