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