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