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