1package Unicode::UCD; 2 3use strict; 4use warnings; 5no warnings 'surrogate'; # surrogates can be inputs to this 6use charnames (); 7 8our $VERSION = '0.72'; 9 10require Exporter; 11 12our @ISA = qw(Exporter); 13 14our @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 34use Carp; 35 36sub IS_ASCII_PLATFORM { ord("A") == 65 } 37 38=head1 NAME 39 40Unicode::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 117The Unicode::UCD module offers a series of functions that 118provide a simple interface to the Unicode 119Character Database. 120 121=head2 code point argument 122 123Some of the functions are called with a I<code point argument>, which is either 124a decimal or a hexadecimal scalar designating a code point in the platform's 125native character set (extended to Unicode), or a string containing C<U+> 126followed by hexadecimals 127designating a Unicode code point. A leading 0 will force a hexadecimal 128interpretation, as will a hexadecimal digit that isn't a decimal digit. 129 130Examples: 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 139Note that the largest code point in Unicode is U+10FFFF. 140 141=cut 142 143my $v_unicode_version; # v-string. 144 145sub 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 157sub _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 192This returns information about the input L</code point argument> 193as a reference to a hash of fields as defined by the Unicode 194standard. If the L</code point argument> is not assigned in the standard 195(i.e., has the general category C<Cn> meaning C<Unassigned>) 196or is a non-character (meaning it is guaranteed to never be assigned in 197the standard), 198C<undef> is returned. 199 200Fields that aren't applicable to the particular code point argument exist in the 201returned hash, and are empty. 202 203For results that are less "raw" than this function returns, or to get the values for 204any property, not just the few covered by this function, use the 205L</charprop()> function. 206 207The keys in the hash with the meanings of their values are: 208 209=over 210 211=item B<code> 212 213the input native L</code point argument> expressed in hexadecimal, with 214leading zeros 215added if necessary to make it contain at least four hexdigits 216 217=item B<name> 218 219name of I<code>, all IN UPPER CASE. 220Some control-type code points do not have names. 221This field will be empty for C<Surrogate> and C<Private Use> code points, 222and for the others without a name, 223it will contain a description enclosed in angle brackets, like 224C<E<lt>controlE<gt>>. 225 226 227=item B<category> 228 229The short name of the general category of I<code>. 230This will match one of the keys in the hash returned by L</general_categories()>. 231 232The L</prop_value_aliases()> function can be used to get all the synonyms 233of the category name. 234 235=item B<combining> 236 237the combining class number for I<code> used in the Canonical Ordering Algorithm. 238For Unicode 5.1, this is described in Section 3.11 C<Canonical Ordering Behavior> 239available at 240L<http://www.unicode.org/versions/Unicode5.1.0/> 241 242The L</prop_value_aliases()> function can be used to get all the synonyms 243of the combining class number. 244 245=item B<bidi> 246 247bidirectional type of I<code>. 248This will match one of the keys in the hash returned by L</bidi_types()>. 249 250The L</prop_value_aliases()> function can be used to get all the synonyms 251of the bidi type name. 252 253=item B<decomposition> 254 255is 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 257I<code>. Each has at least four hexdigits. 258The codes may be preceded by a word enclosed in angle brackets, then a space, 259like C<E<lt>compatE<gt> >, giving the type of decomposition 260 261This decomposition may be an intermediate one whose components are also 262decomposable. Use L<Unicode::Normalize> to get the final decomposition in one 263step. 264 265=item B<decimal> 266 267if I<code> represents a decimal digit this is its integer numeric value 268 269=item B<digit> 270 271if I<code> represents some other digit-like number, this is its integer 272numeric value 273 274=item B<numeric> 275 276if I<code> represents a whole or rational number, this is its numeric value. 277Rational values are expressed as a string like C<1/4>. 278 279=item B<mirrored> 280 281C<Y> or C<N> designating if I<code> is mirrored in bidirectional text 282 283=item B<unicode10> 284 285name of I<code> in the Unicode 1.0 standard if one 286existed for this code point and is different from the current name 287 288=item B<comment> 289 290As of Unicode 6.0, this is always empty. 291 292=item B<upper> 293 294is, if non-empty, the uppercase mapping for I<code> expressed as at least four 295hexdigits. This indicates that the full uppercase mapping is a single 296character, and is identical to the simple (single-character only) mapping. 297When this field is empty, it means that the simple uppercase mapping is 298I<code> itself; you'll need some other means, (like L</charprop()> or 299L</casespec()> to get the full mapping. 300 301=item B<lower> 302 303is, if non-empty, the lowercase mapping for I<code> expressed as at least four 304hexdigits. This indicates that the full lowercase mapping is a single 305character, and is identical to the simple (single-character only) mapping. 306When this field is empty, it means that the simple lowercase mapping is 307I<code> itself; you'll need some other means, (like L</charprop()> or 308L</casespec()> to get the full mapping. 309 310=item B<title> 311 312is, if non-empty, the titlecase mapping for I<code> expressed as at least four 313hexdigits. This indicates that the full titlecase mapping is a single 314character, and is identical to the simple (single-character only) mapping. 315When this field is empty, it means that the simple titlecase mapping is 316I<code> itself; you'll need some other means, (like L</charprop()> or 317L</casespec()> to get the full mapping. 318 319=item B<block> 320 321the block I<code> belongs to (used in C<\p{Blk=...}>). 322The L</prop_value_aliases()> function can be used to get all the synonyms 323of the block name. 324 325See L</Blocks versus Scripts>. 326 327=item B<script> 328 329the script I<code> belongs to. 330The L</prop_value_aliases()> function can be used to get all the synonyms 331of the script name. Note that this is the older "Script" property value, and 332not the improved "Script_Extensions" value. 333 334See L</Blocks versus Scripts>. 335 336=back 337 338Note that you cannot do (de)composition and casing based solely on the 339I<decomposition>, I<combining>, I<lower>, I<upper>, and I<title> fields; you 340will need also the L</casespec()> function and the C<Composition_Exclusion> 341property. (Or you could just use the L<lc()|perlfunc/lc>, 342L<uc()|perlfunc/uc>, and L<ucfirst()|perlfunc/ucfirst> functions, and the 343L<Unicode::Normalize> module.) 344 345=cut 346 347# NB: This function is nearly duplicated in charnames.pm 348sub _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 369my %real_to_rational; 370 371# To store the contents of files found on disk. 372my @BIDIS; 373my @CATEGORIES; 374my @DECOMPOSITIONS; 375my @NUMERIC_TYPES; 376my %SIMPLE_LOWER; 377my %SIMPLE_TITLE; 378my %SIMPLE_UPPER; 379my %UNICODE_1_NAMES; 380my %ISO_COMMENT; 381 382# Eval'd so can run on versions earlier than the property is available in 383my $Hangul_Syllables_re = eval 'qr/\p{Block=Hangul_Syllables}/'; 384 385sub 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 517sub _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 537sub _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 608sub 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 627This returns the value of the Unicode property given by the second parameter 628for the L</code point argument> given by the first. 629 630The passed-in property may be specified as any of the synonyms returned by 631L</prop_aliases()>. 632 633The return value is always a scalar, either a string or a number. For 634properties where there are synonyms for the values, the synonym returned by 635this function is the longest, most descriptive form, the one returned by 636L</prop_value_aliases()> when called in a scalar context. Of course, you can 637call L</prop_value_aliases()> on the result to get other synonyms. 638 639The return values are more "cooked" than the L</charinfo()> ones. For 640example, the C<"uc"> property value is the actual string containing the full 641uppercase mapping of the input code point. You have to go to extra trouble 642with C<charinfo> to get this value from its C<upper> hash element when the 643full mapping differs from the simple one. 644 645Special note should be made of the return values for a few properties: 646 647=over 648 649=item Block 650 651The value returned is the new-style (see L</Old-style versus new-style block 652names>). 653 654=item Decomposition_Mapping 655 656Like L</charinfo()>, the result may be an intermediate decomposition whose 657components are also decomposable. Use L<Unicode::Normalize> to get the final 658decomposition in one step. 659 660Unlike L</charinfo()>, this does not include the decomposition type. Use the 661C<Decomposition_Type> property to get that. 662 663=item Name_Alias 664 665If the input code point's name has more than one synonym, they are returned 666joined into a single comma-separated string. 667 668=item Numeric_Value 669 670If the result is a fraction, it is converted into a floating point number to 671the accuracy of your platform. 672 673=item Script_Extensions 674 675If the result is multiple script names, they are returned joined into a single 676comma-separated string. 677 678=back 679 680When called with a property that is a Perl extension that isn't expressible in 681a compound form, this function currently returns C<undef>, as the only two 682possible values are I<true> or I<false> (1 or 0 I suppose). This behavior may 683change in the future, so don't write code that relies on it. C<Present_In> is 684a Perl extension that is expressible in a bipartite or compound form (for 685example, C<\p{Present_In=4.0}>), so C<charprop> accepts it. But C<Any> is a 686Perl extension that isn't expressible that way, so C<charprop> returns 687C<undef> for it. Also C<charprop> returns C<undef> for all Perl extensions 688that are internal-only. 689 690=cut 691 692sub 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 785This returns a reference to a hash whose keys are all the distinct Unicode (no 786Perl extension) properties, and whose values are the respective values for 787those properties for the input L</code point argument>. 788 789Each key is the property name in its longest, most descriptive form. The 790values are what L</charprop()> would return. 791 792This function is expensive in time and memory. 793 794=cut 795 796sub 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 830With a L</code point argument> C<charblock()> returns the I<block> the code point 831belongs to, e.g. C<Basic Latin>. The old-style block name is returned (see 832L</Old-style versus new-style block names>). 833The L</prop_value_aliases()> function can be used to get all the synonyms 834of the block name. 835 836If the code point is unassigned, this returns the block it would belong to if 837it were assigned. (If the Unicode version being used is so early as to not 838have blocks, all code points are considered to be in C<No_Block>.) 839 840See also L</Blocks versus Scripts>. 841 842If supplied with an argument that can't be a code point, C<charblock()> tries to 843do the opposite and interpret the argument as an old-style block name. On an 844ASCII platform, the return value is a I<range set> with one range: an 845anonymous array with a single element that consists of another anonymous array 846whose first element is the first code point in the block, and whose second 847element is the final code point in the block. On an EBCDIC 848platform, the first two Unicode blocks are not contiguous. Their range sets 849are lists containing I<start-of-range>, I<end-of-range> code point pairs. You 850can test whether a code point is in a range set using the L</charinrange()> 851function. (To be precise, each I<range set> contains a third array element, 852after the range boundary ones: the old_style block name.) 853 854If the argument to C<charblock()> is not a known block, C<undef> is 855returned. 856 857=cut 858 859my @BLOCKS; 860my %BLOCKS; 861 862sub _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 923sub 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 953With a L</code point argument>, C<charscript()> returns the I<script> the 954code point belongs to, e.g., C<Latin>, C<Greek>, C<Han>. 955If the code point is unassigned or the Unicode version being used is so early 956that it doesn't have scripts, this function returns C<"Unknown">. 957The L</prop_value_aliases()> function can be used to get all the synonyms 958of the script name. 959 960Note that the Script_Extensions property is an improved version of the Script 961property, and you should probably be using that instead, with the 962L</charprop()> function. 963 964If supplied with an argument that can't be a code point, charscript() tries 965to do the opposite and interpret the argument as a script name. The 966return value is a I<range set>: an anonymous array of arrays that contain 967I<start-of-range>, I<end-of-range> code point pairs. You can test whether a 968code point is in a range set using the L</charinrange()> function. 969(To be precise, each I<range set> contains a third array element, 970after the range boundary ones: the script name.) 971 972If the C<charscript()> argument is not a known script, C<undef> is returned. 973 974See also L</Blocks versus Scripts>. 975 976=cut 977 978my @SCRIPTS; 979my %SCRIPTS; 980 981sub _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 997sub 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 1022C<charblocks()> returns a reference to a hash with the known block names 1023as the keys, and the code point ranges (see L</charblock()>) as the values. 1024 1025The names are in the old-style (see L</Old-style versus new-style block 1026names>). 1027 1028L<prop_invmap("block")|/prop_invmap()> can be used to get this same data in a 1029different type of data structure. 1030 1031L<prop_values("Block")|/prop_values()> can be used to get all 1032the known new-style block names as a list, without the code point ranges. 1033 1034See also L</Blocks versus Scripts>. 1035 1036=cut 1037 1038sub 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 1049C<charscripts()> returns a reference to a hash with the known script 1050names as the keys, and the code point ranges (see L</charscript()>) as 1051the values. 1052 1053L<prop_invmap("script")|/prop_invmap()> can be used to get this same data in a 1054different type of data structure. Since the Script_Extensions property is an 1055improved version of the Script property, you should instead use 1056L<prop_invmap("scx")|/prop_invmap()>. 1057 1058L<C<prop_values("Script")>|/prop_values()> can be used to get all 1059the known script names as a list, without the code point ranges. 1060 1061See also L</Blocks versus Scripts>. 1062 1063=cut 1064 1065sub charscripts { 1066 _charscripts() unless %SCRIPTS; 1067 return _dclone \%SCRIPTS; 1068} 1069 1070=head2 B<charinrange()> 1071 1072In addition to using the C<\p{Blk=...}> and C<\P{Blk=...}> constructs, you 1073can also test whether a code point is in the I<range> as returned by 1074L</charblock()> and L</charscript()> or as the values of the hash returned 1075by 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 1084my %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 1126sub 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 1136This returns a reference to a hash which has short 1137general category names (such as C<Lu>, C<Nd>, C<Zs>, C<S>) as keys and long 1138names (such as C<UppercaseLetter>, C<DecimalNumber>, C<SpaceSeparator>, 1139C<Symbol>) as values. The hash is reversible in case you need to go 1140from the long names to the short names. The general category is the 1141one returned from 1142L</charinfo()> under the C<category> key. 1143 1144The L</prop_values()> and L</prop_value_aliases()> functions can be used as an 1145alternative to this function; the first returning a simple list of the short 1146category names; and the second gets all the synonyms of a given category name. 1147 1148=cut 1149 1150my %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 1179This returns a reference to a hash which has the short 1180bidi (bidirectional) type names (such as C<L>, C<R>) as keys and long 1181names (such as C<Left-to-Right>, C<Right-to-Left>) as values. The 1182hash is reversible in case you need to go from the long names to the 1183short names. The bidi type is the one returned from 1184L</charinfo()> 1185under the C<bidi> key. For the exact meaning of the various bidi classes 1186the Unicode TR9 is recommended reading: 1187L<http://www.unicode.org/reports/tr9/> 1188(as of Unicode 5.0.0) 1189 1190The L</prop_values()> and L</prop_value_aliases()> functions can be used as an 1191alternative to this function; the first returning a simple list of the short 1192bidi type names; and the second gets all the synonyms of a given bidi type 1193name. 1194 1195=cut 1196 1197sub bidi_types { 1198 return _dclone \%BIDI_TYPES; 1199} 1200 1201=head2 B<compexcl()> 1202 1203WARNING: Unicode discourages the use of this function or any of the 1204alternative mechanisms listed in this section (the documentation of 1205C<compexcl()>), except internally in implementations of the Unicode 1206Normalization Algorithm. You should be using L<Unicode::Normalize> directly 1207instead of these. Using these will likely lead to half-baked results. 1208 1209 use Unicode::UCD 'compexcl'; 1210 1211 my $compexcl = compexcl(0x09dc); 1212 1213This routine returns C<undef> if the Unicode version being used is so early 1214that it doesn't have this property. 1215 1216C<compexcl()> is included for backwards 1217compatibility, but as of Perl 5.12 and more modern Unicode versions, for 1218most purposes it is probably more convenient to use one of the following 1219instead: 1220 1221 my $compexcl = chr(0x09dc) =~ /\p{Comp_Ex}; 1222 my $compexcl = chr(0x09dc) =~ /\p{Full_Composition_Exclusion}; 1223 1224or even 1225 1226 my $compexcl = chr(0x09dc) =~ /\p{CE}; 1227 my $compexcl = chr(0x09dc) =~ /\p{Composition_Exclusion}; 1228 1229The first two forms return B<true> if the L</code point argument> should not 1230be produced by composition normalization. For the final two forms to return 1231B<true>, it is additionally required that this fact not otherwise be 1232determinable from the Unicode data base. 1233 1234This routine behaves identically to the final two forms. That is, 1235it does not return B<true> if the code point has a decomposition 1236consisting of another single code point, nor if its decomposition starts 1237with a code point whose combining class is non-zero. Code points that meet 1238either of these conditions should also not be produced by composition 1239normalization, which is probably why you should use the 1240C<Full_Composition_Exclusion> property instead, as shown above. 1241 1242The routine returns B<false> otherwise. 1243 1244=cut 1245 1246# Eval'd so can run on versions earlier than the property is available in 1247my $Composition_Exclusion_re = eval 'qr/\p{Composition_Exclusion}/'; 1248 1249sub 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 1283This returns the (almost) locale-independent case folding of the 1284character specified by the L</code point argument>. (Starting in Perl v5.16, 1285the core function C<fc()> returns the C<full> mapping (described below) 1286faster than this does, and for entire strings.) 1287 1288If there is no case folding for the input code point, C<undef> is returned. 1289 1290If there is a case folding for that code point, a reference to a hash 1291with the following fields is returned: 1292 1293=over 1294 1295=item B<code> 1296 1297the input native L</code point argument> expressed in hexadecimal, with 1298leading zeros 1299added if necessary to make it contain at least four hexdigits 1300 1301=item B<full> 1302 1303one or more codes (separated by spaces) that, taken in order, give the 1304code points for the case folding for I<code>. 1305Each has at least four hexdigits. 1306 1307=item B<simple> 1308 1309is empty, or is exactly one code with at least four hexdigits which can be used 1310as an alternative case folding when the calling program cannot cope with the 1311fold being a sequence of multiple code points. If I<full> is just one code 1312point, then I<simple> equals I<full>. If there is no single code point folding 1313defined for I<code>, then I<simple> is the empty string. Otherwise, it is an 1314inferior, but still better-than-nothing alternative folding to I<full>. 1315 1316=item B<mapping> 1317 1318is the same as I<simple> if I<simple> is not empty, and it is the same as I<full> 1319otherwise. It can be considered to be the simplest possible folding for 1320I<code>. It is defined primarily for backwards compatibility. 1321 1322=item B<status> 1323 1324is 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 1326folds, I<simple> and I<full> (I<mapping> equals I<simple>). And it is C<F> if 1327there is only a I<full> fold (I<mapping> equals I<full>; I<simple> is empty). 1328Note that this 1329describes the contents of I<mapping>. It is defined primarily for backwards 1330compatibility. 1331 1332For Unicode versions between 3.1 and 3.1.1 inclusive, I<status> can also be 1333C<I> which is the same as C<C> but is a special case for dotted uppercase I and 1334dotless lowercase i: 1335 1336=over 1337 1338=item Z<>B<*> If you use this C<I> mapping 1339 1340the result is case-insensitive, 1341but dotless and dotted I's are not distinguished 1342 1343=item Z<>B<*> If you exclude this C<I> mapping 1344 1345the result is not fully case-insensitive, but 1346dotless and dotted I's are distinguished 1347 1348=back 1349 1350=item B<turkic> 1351 1352contains any special folding for Turkic languages. For versions of Unicode 1353starting with 3.2, this field is empty unless I<code> has a different folding 1354in Turkic languages, in which case it is one or more codes (separated by 1355spaces) that, taken in order, give the code points for the case folding for 1356I<code> in those languages. 1357Each code has at least four hexdigits. 1358Note that this folding does not maintain canonical equivalence without 1359additional processing. 1360 1361For Unicode versions between 3.1 and 3.1.1 inclusive, this field is empty unless 1362there is a 1363special folding for Turkic languages, in which case I<status> is C<I>, and 1364I<mapping>, I<full>, I<simple>, and I<turkic> are all equal. 1365 1366=back 1367 1368Programs that want complete generality and the best folding results should use 1369the folding contained in the I<full> field. But note that the fold for some 1370code points will be a sequence of multiple code points. 1371 1372Programs that can't cope with the fold mapping being multiple code points can 1373use the folding contained in the I<simple> field, with the loss of some 1374generality. In Unicode 5.1, about 7% of the defined foldings have no single 1375code point folding. 1376 1377The I<mapping> and I<status> fields are provided for backwards compatibility for 1378existing programs. They contain the same values as in previous versions of 1379this function. 1380 1381Locale is not completely independent. The I<turkic> field contains results to 1382use when the locale is a Turkic language. 1383 1384For more information about case mappings see 1385L<http://www.unicode.org/unicode/reports/tr21> 1386 1387=cut 1388 1389my %CASEFOLD; 1390 1391sub _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 1477sub 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 1521This returns all the case foldings in the current version of Unicode in the 1522form of a reference to a hash. Each key to the hash is the decimal 1523representation of a Unicode character that has a casefold to other than 1524itself. The casefold of a semi-colon is itself, so it isn't in the hash; 1525likewise for a lowercase "a", but there is an entry for a capital "A". The 1526hash value for each key is another hash, identical to what is returned by 1527L</casefold()> if called with that code point as its argument. So the value 1528C<< all_casefolds()->{ord("A")}' >> is equivalent to C<casefold(ord("A"))>; 1529 1530=cut 1531 1532sub 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 1543This returns the potentially locale-dependent case mappings of the L</code point 1544argument>. The mappings may be longer than a single code point (which the basic 1545Unicode case mappings as returned by L</charinfo()> never are). 1546 1547If there are no case mappings for the L</code point argument>, or if all three 1548possible mappings (I<lower>, I<title> and I<upper>) result in single code 1549points 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 1551returned by L</charinfo()>). 1552 1553Otherwise, a reference to a hash giving the mappings (or a reference to a hash 1554of such hashes, explained below) is returned with the following keys and their 1555meanings: 1556 1557The keys in the bottom layer hash with the meanings of their values are: 1558 1559=over 1560 1561=item B<code> 1562 1563the input native L</code point argument> expressed in hexadecimal, with 1564leading zeros 1565added if necessary to make it contain at least four hexdigits 1566 1567=item B<lower> 1568 1569one or more codes (separated by spaces) that, taken in order, give the 1570code points for the lower case of I<code>. 1571Each has at least four hexdigits. 1572 1573=item B<title> 1574 1575one or more codes (separated by spaces) that, taken in order, give the 1576code points for the title case of I<code>. 1577Each has at least four hexdigits. 1578 1579=item B<upper> 1580 1581one or more codes (separated by spaces) that, taken in order, give the 1582code points for the upper case of I<code>. 1583Each has at least four hexdigits. 1584 1585=item B<condition> 1586 1587the conditions for the mappings to be valid. 1588If C<undef>, the mappings are always valid. 1589When defined, this field is a list of conditions, 1590all of which must be true for the mappings to be valid. 1591The list consists of one or more 1592I<locales> (see below) 1593and/or I<contexts> (explained in the next paragraph), 1594separated by spaces. 1595(Other than as used to separate elements, spaces are to be ignored.) 1596Case distinctions in the condition list are not significant. 1597Conditions preceded by "NON_" represent the negation of the condition. 1598 1599A I<context> is one of those defined in the Unicode standard. 1600For Unicode 5.1, they are defined in Section 3.13 C<Default Case Operations> 1601available at 1602L<http://www.unicode.org/versions/Unicode5.1.0/>. 1603These are for context-sensitive casing. 1604 1605=back 1606 1607The hash described above is returned for locale-independent casing, where 1608at least one of the mappings has length longer than one. If C<undef> is 1609returned, the code point may have mappings, but if so, all are length one, 1610and are returned by L</charinfo()>. 1611Note that when this function does return a value, it will be for the complete 1612set of mappings for a code point, even those whose length is one. 1613 1614If there are additional casing rules that apply only in certain locales, 1615an additional key for each will be defined in the returned hash. Each such key 1616will be its locale name, defined as a 2-letter ISO 3166 country code, possibly 1617followed by a "_" and a 2-letter ISO language code (possibly followed by a "_" 1618and a variant code). You can find the lists of all possible locales, see 1619L<Locale::Country> and L<Locale::Language>. 1620(In Unicode 6.0, the only locales returned by this function 1621are C<lt>, C<tr>, and C<az>.) 1622 1623Each locale key is a reference to a hash that has the form above, and gives 1624the casing rules for that particular locale, which take precedence over the 1625locale-independent ones when in that locale. 1626 1627If the only casing for a code point is locale-dependent, then the returned 1628hash will not have any of the base keys, like C<code>, C<upper>, etc., but 1629will contain only locale keys. 1630 1631For more information about case mappings see 1632L<http://www.unicode.org/unicode/reports/tr21/> 1633 1634=cut 1635 1636my %CASESPEC; 1637 1638sub _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 1714sub 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 1733If used with a single argument in a scalar context, returns the string 1734consisting of the code points of the named sequence, or C<undef> if no 1735named sequence by that name exists. If used with a single argument in 1736a list context, it returns the list of the ordinals of the code points. 1737 1738If used with no 1739arguments in a list context, it returns a hash with the names of all the 1740named sequences as the keys and their sequences as strings as 1741the values. Otherwise, it returns C<undef> or an empty list depending 1742on the context. 1743 1744This function only operates on officially approved (not provisional) named 1745sequences. 1746 1747Note that as of Perl 5.14, C<\N{KATAKANA LETTER AINU P}> will insert the named 1748sequence into double-quoted strings, and C<charnames::string_vianame("KATAKANA 1749LETTER AINU P")> will return the same string this function does, but will also 1750operate on character names that aren't named sequences, without you having to 1751know which are which. See L<charnames>. 1752 1753=cut 1754 1755my %NAMEDSEQ; 1756 1757sub _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 1773sub 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 1803my %NUMERIC; 1804 1805sub _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 1855C<num()> returns the numeric value of the input Unicode string; or C<undef> if it 1856doesn't think the entire string has a completely valid, safe numeric value. 1857If called with an optional second parameter, a reference to a scalar, C<num()> 1858will set the scalar to the length of any valid initial substring; or to 0 if none. 1859 1860If the string is just one character in length, the Unicode numeric value 1861is returned if it has one, or C<undef> otherwise. If the optional scalar ref 1862is passed, it would be set to 1 if the return is valid; or 0 if the return is 1863C<undef>. Note that the numeric value returned need not be a whole number. 1864C<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 1878If the string is more than one character, C<undef> is returned unless 1879all its characters are decimal digits (that is, they would match C<\d+>), 1880from 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> 1882is returned. A further restriction is that the digits all have to be of 1883the same form. A half-width digit mixed with a full-width one will 1884return C<undef>. The Arabic script has two sets of digits; C<num> will 1885return C<undef> unless all the digits in the string come from the same 1886set. In all cases, the optional scalar ref parameter is set to how 1887long any valid initial substring of digits is; hence it will be set to the 1888entire string length if the main return value is not C<undef>. 1889 1890C<num> errs on the side of safety, and there may be valid strings of 1891decimal digits that it doesn't recognize. Note that Unicode defines 1892a number of "digit" characters that aren't "decimal digit" characters. 1893"Decimal digits" have the property that they have a positional value, i.e., 1894there is a units position, a 10's position, a 100's, etc, AND they are 1895arranged in Unicode in blocks of 10 contiguous code points. The Chinese 1896digits, for example, are not in such a contiguous block, and so Unicode 1897doesn't view them as decimal digits, but merely digits, and so C<\d> will not 1898match them. A single-character string containing one of these digits will 1899have its decimal value returned by C<num>, but any longer string containing 1900only these digits will return C<undef>. 1901 1902Strings of multiple sub- and superscripts are not recognized as numbers. You 1903can use either of the compatibility decompositions in Unicode::Normalize to 1904change 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 1912sub 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 1999Most Unicode properties have several synonymous names. Typically, there is at 2000least a short name, convenient to type, and a long name that more fully 2001describes the property, and hence is more easily understood. 2002 2003If you know one name for a Unicode property, you can use C<prop_aliases> to find 2004either the long name (when called in scalar context), or a list of all of the 2005names, somewhat ordered so that the short name is in the 0th element, the long 2006name in the next element, and any other synonyms are in the remaining 2007elements, in no particular order. 2008 2009The long name is returned in a form nicely capitalized, suitable for printing. 2010 2011The input parameter name is loosely matched, which means that white space, 2012hyphens, and underscores are ignored (except for the trailing underscore in 2013the old_form grandfathered-in C<"L_">, which is better written as C<"LC">, and 2014both of which mean C<General_Category=Cased Letter>). 2015 2016If the name is unknown, C<undef> is returned (or an empty list in list 2017context). Note that Perl typically recognizes property names in regular 2018expressions with an optional C<"Is_>" (with or without the underscore) 2019prefixed to them, such as C<\p{isgc=punct}>. This function does not recognize 2020those in the input, returning C<undef>. Nor are they included in the output 2021as possible synonyms. 2022 2023C<prop_aliases> does know about the Perl extensions to Unicode properties, 2024such as C<Any> and C<XPosixAlpha>, and the single form equivalents to Unicode 2025properties such as C<XDigit>, C<Greek>, C<In_Greek>, and C<Is_Greek>. The 2026final example demonstrates that the C<"Is_"> prefix is recognized for these 2027extensions; it is needed to resolve ambiguities. For example, 2028C<prop_aliases('lc')> returns the list C<(lc, Lowercase_Mapping)>, but 2029C<prop_aliases('islc')> returns C<(Is_LC, Cased_Letter)>. This is 2030because C<islc> is a Perl extension which is short for 2031C<General_Category=Cased Letter>. The lists returned for the Perl extensions 2032will not include the C<"Is_"> prefix (whether or not the input had it) unless 2033needed to resolve ambiguities, as shown in the C<"islc"> example, where the 2034returned list had one element containing C<"Is_">, and the other without. 2035 2036It is also possible for the reverse to happen: C<prop_aliases('isc')> returns 2037the list C<(isc, ISO_Comment)>; whereas C<prop_aliases('c')> returns 2038C<(C, Other)> (the latter being a Perl extension meaning 2039C<General_Category=Other>. 2040L<perluniprops/Properties accessible through Unicode::UCD> lists the available 2041forms, including which ones are discouraged from use. 2042 2043Those discouraged forms are accepted as input to C<prop_aliases>, but are not 2044returned in the lists. C<prop_aliases('isL&')> and C<prop_aliases('isL_')>, 2045which are old synonyms for C<"Is_LC"> and should not be used in new code, are 2046examples of this. These both return C<(Is_LC, Cased_Letter)>. Thus this 2047function allows you to take a discouraged form, and find its acceptable 2048alternatives. The same goes with single-form Block property equivalences. 2049Only the forms that begin with C<"In_"> are not discouraged; if you pass 2050C<prop_aliases> a discouraged form, you will get back the equivalent ones that 2051begin with C<"In_">. It will otherwise look like a new-style block name (see. 2052L</Old-style versus new-style block names>). 2053 2054C<prop_aliases> does not know about any user-defined properties, and will 2055return C<undef> if called with one of those. Likewise for Perl internal 2056properties, with the exception of "Perl_Decimal_Digit" which it does know 2057about (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. 2067our %string_property_loose_to_name; 2068our %ambiguous_names; 2069our %loose_perlprop_to_name; 2070our %prop_aliases; 2071 2072sub 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 2242Some Unicode properties have a restricted set of legal values. For example, 2243all binary properties are restricted to just C<true> or C<false>; and there 2244are only a few dozen possible General Categories. Use C<prop_values> 2245to find out if a given property is one such, and if so, to get a list of the 2246values: 2247 2248 print join ", ", prop_values("NFC_Quick_Check"); 2249 prints: 2250 M, N, Y 2251 2252If the property doesn't have such a restricted set, C<undef> is returned. 2253 2254There are usually several synonyms for each possible value. Use 2255L</prop_value_aliases()> to access those. 2256 2257Case, white space, hyphens, and underscores are ignored in the input property 2258name (except for the trailing underscore in the old-form grandfathered-in 2259general category property value C<"L_">, which is better written as C<"LC">). 2260 2261If the property name is unknown, C<undef> is returned. Note that Perl typically 2262recognizes 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}>. 2264This function does not recognize those in the property parameter, returning 2265C<undef>. 2266 2267For the block property, new-style block names are returned (see 2268L</Old-style versus new-style block names>). 2269 2270C<prop_values> does not know about any user-defined properties, and 2271will 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. 2277our %loose_to_standard_value; 2278our %prop_value_aliases; 2279 2280sub 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 2324Some Unicode properties have a restricted set of legal values. For example, 2325all binary properties are restricted to just C<true> or C<false>; and there 2326are only a few dozen possible General Categories. 2327 2328You can use L</prop_values()> to find out if a given property is one which has 2329a restricted set of values, and if so, what those values are. But usually 2330each value actually has several synonyms. For example, in Unicode binary 2331properties, I<truth> can be represented by any of the strings "Y", "Yes", "T", 2332or "True"; and the General Category "Punctuation" by that string, or "Punct", 2333or simply "P". 2334 2335Like property names, there is typically at least a short name for each such 2336property-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>() 2338to get the long name (when called in scalar context), or a list of all the 2339names, with the short name in the 0th element, the long name in the next 2340element, and any other synonyms in the remaining elements, in no particular 2341order, except that any all-numeric synonyms will be last. 2342 2343The long name is returned in a form nicely capitalized, suitable for printing. 2344 2345Case, white space, hyphens, and underscores are ignored in the input parameters 2346(except for the trailing underscore in the old-form grandfathered-in general 2347category property value C<"L_">, which is better written as C<"LC">). 2348 2349If either name is unknown, C<undef> is returned. Note that Perl typically 2350recognizes 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}>. 2352This function does not recognize those in the property parameter, returning 2353C<undef>. 2354 2355If called with a property that doesn't have synonyms for its values, it 2356returns the input value, possibly normalized with capitalization and 2357underscores, but not necessarily checking that the input value is valid. 2358 2359For the block property, new-style block names are returned (see 2360L</Old-style versus new-style block names>). 2361 2362To find the synonyms for single-forms, such as C<\p{Any}>, use 2363L</prop_aliases()> instead. 2364 2365C<prop_value_aliases> does not know about any user-defined properties, and 2366will return C<undef> if called with one of those. 2367 2368=cut 2369 2370sub 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 2464C<prop_invlist> returns an inversion list (described below) that defines all the 2465code points for the binary Unicode property (or "property=value" pair) given 2466by 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 2475If the input is unknown C<undef> is returned in scalar context; an empty-list 2476in list context. If the input is known, the number of elements in 2477the list is returned if called in scalar context. 2478 2479L<perluniprops|perluniprops/Properties accessible through \p{} and \P{}> gives 2480the list of properties that this function accepts, as well as all the possible 2481forms for them (including with the optional "Is_" prefixes). (Except this 2482function doesn't accept any Perl-internal properties, some of which are listed 2483there.) This function uses the same loose or tighter matching rules for 2484resolving the input property's name as is done for regular expressions. These 2485are also specified in L<perluniprops|perluniprops/Properties accessible 2486through \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 2503Inversion lists are a compact way of specifying Unicode property-value 2504definitions. The 0th item in the list is the lowest code point that has the 2505property-value. The next item (item [1]) is the lowest code point beyond that 2506one 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 2508property-value, and so on. Put another way, each element in the list gives 2509the beginning of a range that has the property-value (for even numbered 2510elements), or doesn't have the property-value (for odd numbered elements). 2511The name for this data structure stems from the fact that each element in the 2512list toggles (or inverts) whether the corresponding range is or isn't on the 2513list. 2514 2515In the final example above, the first ASCII Hex digit is code point 48, the 2516character "0", and all code points from it through 57 (a "9") are ASCII hex 2517digits. Code points 58 through 64 aren't, but 65 (an "A") through 70 (an "F") 2518are, as are 97 ("a") through 102 ("f"). 103 starts a range of code points 2519that aren't ASCII hex digits. That range extends to infinity, which on your 2520computer can be found in the variable C<$Unicode::UCD::MAX_CP>. (This 2521variable is as close to infinity as Perl can get on your platform, and may be 2522too high for some operations to work; you may wish to use a smaller number for 2523your purposes.) 2524 2525Note that the inversion lists returned by this function can possibly include 2526non-Unicode code points, that is anything above 0x10FFFF. Unicode properties 2527are not defined on such code points. You might wish to change the output to 2528not include these. Simply add 0x110000 at the end of the non-empty returned 2529list 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 2541It is a simple matter to expand out an inversion list to a full list of all 2542code 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 2556C<prop_invlist> does not know about any user-defined nor Perl internal-only 2557properties, and will return C<undef> if called with one of those. 2558 2559The L</search_invlist()> function is provided for finding a code point within 2560an 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. 2571our %loose_defaults; 2572our $MAX_UNICODE_CODEPOINT; 2573 2574sub 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 2677C<prop_invmap> is used to get the complete mapping definition for a property, 2678in the form of an inversion map. An inversion map consists of two parallel 2679arrays. One is an ordered list of code points that mark range beginnings, and 2680the other gives the value (or mapping) that all code points in the 2681corresponding range have. 2682 2683C<prop_invmap> is called with the name of the desired property. The name is 2684loosely matched, meaning that differences in case, white-space, hyphens, and 2685underscores are not meaningful (except for the trailing underscore in the 2686old-form grandfathered-in property C<"L_">, which is better written as C<"LC">, 2687or even better, C<"Gc=LC">). 2688 2689Many Unicode properties have more than one name (or alias). C<prop_invmap> 2690understands all of these, including Perl extensions to them. Ambiguities are 2691resolved as described above for L</prop_aliases()> (except if a property has 2692both a complete mapping, and a binary C<Y>/C<N> mapping, then specifying the 2693property name prefixed by C<"is"> causes the binary one to be returned). The 2694Perl internal property "Perl_Decimal_Digit, described below, is also accepted. 2695An empty list is returned if the property name is unknown. 2696See L<perluniprops/Properties accessible through Unicode::UCD> for the 2697properties acceptable as inputs to this function. 2698 2699It is a fatal error to call this function except in list context. 2700 2701In addition to the two arrays that form the inversion map, C<prop_invmap> 2702returns two other values; one is a scalar that gives some details as to the 2703format of the entries of the map array; the other is a default value, useful 2704in maps whose format name begins with the letter C<"a">, as described 2705L<below in its subsection|/a>; and for specialized purposes, such as 2706converting to another data structure, described at the end of this main 2707section. 2708 2709This 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 2714In this call, the two arrays will be populated as shown below (for Unicode 27156.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 2739The first line (with Index [0]) means that the value for code point 0 is "Basic 2740Latin". The entry "0x0080" in the @blocks_ranges column in the second line 2741means that the value from the first line, "Basic Latin", extends to all code 2742points in the range from 0 up to but not including 0x0080, that is, through 2743127. In other words, the code points from 0 to 127 are all in the "Basic 2744Latin" block. Similarly, all code points in the range from 0x0080 up to (but 2745not 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 2747new-style block names>). 2748 2749The final line (with Index [242]) means that the value for all code points above 2750the legal Unicode maximum code point have the value "No_Block", which is the 2751term Unicode uses for a non-existing block. 2752 2753The arrays completely specify the mappings for all possible code points. 2754The final element in an inversion map returned by this function will always be 2755for the range that consists of all the code points that aren't legal Unicode, 2756but that are expressible on the platform. (That is, it starts with code point 27570x110000, the first code point above the legal Unicode maximum, and extends to 2758infinity.) The value for that range will be the same that any typical 2759unassigned code point has for the specified property. (Certain unassigned 2760code points are not "typical"; for example the non-character code points, or 2761those in blocks that are to be written right-to-left. The above-Unicode 2762range's value is not based on these atypical code points.) It could be argued 2763that, instead of treating these as unassigned Unicode code points, the value 2764for this range should be C<undef>. If you wish, you can change the returned 2765arrays accordingly. 2766 2767The maps for almost all properties are simple scalars that should be 2768interpreted as-is. 2769These values are those given in the Unicode-supplied data files, which may be 2770inconsistent as to capitalization and as to which synonym for a property-value 2771is given. The results may be normalized by using the L</prop_value_aliases()> 2772function. 2773 2774There are exceptions to the simple scalar maps. Some properties have some 2775elements in their map list that are themselves lists of scalars; and some 2776special 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 2778list 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 2784means all the elements of the map array are simple scalars, with no special 2785elements. Almost all properties are like this, like the C<block> example 2786above. 2787 2788=item B<C<sl>> 2789 2790means that some of the map array elements have the form given by C<"s">, and 2791the rest are lists of scalars. For example, here is a portion of the output 2792of 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 2801Here, the code points 0x964 and 0x965 are both used in Bengali, 2802Devanagari, Gurmukhi, and Oriya, but no other scripts. 2803 2804The Name_Alias property is also of this form. But each scalar consists of two 2805components: 1) the name, and 2) the type of alias this is. They are 2806separated by a colon and a space. In Unicode 6.1, there are several alias types: 2807 2808=over 2809 2810=item C<correction> 2811 2812indicates that the name is a corrected form for the 2813original name (which remains valid) for the same code point. 2814 2815=item C<control> 2816 2817adds a new name for a control character. 2818 2819=item C<alternate> 2820 2821is an alternate name for a character 2822 2823=item C<figment> 2824 2825is a name for a character that has been documented but was never in any 2826actual standard. 2827 2828=item C<abbreviation> 2829 2830is a common abbreviation for a character 2831 2832=back 2833 2834The lists are ordered (roughly) so the most preferred names come before less 2835preferred ones. 2836 2837For 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 2854A map to the empty string means that there is no alias defined for the code 2855point. 2856 2857=item B<C<a>> 2858 2859is like C<"s"> in that all the map array elements are scalars, but here they are 2860restricted to all being integers, and some have to be adjusted (hence the name 2861C<"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 2866the 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 2876and C<$default> is 0. 2877 2878Let's start with the second line. It says that the uppercase of code point 97 2879is 65; or C<uc("a")> == "A". But the line is for the entire range of code 2880points 97 through 122. To get the mapping for any code point in this range, 2881you take the offset it has from the beginning code point of the range, and add 2882that to the mapping for that first code point. So, the mapping for 122 ("z") 2883is derived by taking the offset of 122 from 97 (=25) and adding that to 65, 2884yielding 90 ("z"). Likewise for everything in between. 2885 2886Requiring this simple adjustment allows the returned arrays to be 2887significantly smaller than otherwise, up to a factor of 10, speeding up 2888searching through them. 2889 2890Ranges that map to C<$default>, C<"0">, behave somewhat differently. For 2891these, each code point maps to itself. So, in the first line in the example, 2892S<C<ord(uc(chr(0)))>> is 0, S<C<ord(uc(chr(1)))>> is 1, .. 2893S<C<ord(uc(chr(96)))>> is 96. 2894 2895=item B<C<al>> 2896 2897means that some of the map array elements have the form given by C<"a">, and 2898the rest are ordered lists of code points. 2899For example, in: 2900 2901 my ($uppers_ranges_ref, $uppers_maps_ref, $format, $default) 2902 = prop_invmap("Uppercase_Mapping"); 2903 2904the 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 2918This is the full Uppercase_Mapping property (as opposed to the 2919Simple_Uppercase_Mapping given in the example for format C<"a">). The only 2920difference between the two in the ranges shown is that the code point at 29210x0149 (LATIN SMALL LETTER N PRECEDED BY APOSTROPHE) maps to a string of two 2922characters, 0x02BC (MODIFIER LETTER APOSTROPHE) followed by 0x004E (LATIN 2923CAPITAL LETTER N). 2924 2925No adjustments are needed to entries that are references to arrays; each such 2926entry will have exactly one element in its range, so the offset is always 0. 2927 2928The fourth (index [3]) element (C<$default>) in the list returned for this 2929format is 0. 2930 2931=item B<C<ae>> 2932 2933This is like C<"a">, but some elements are the empty string, and should not be 2934adjusted. 2935The 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 2937that are represented by the Unicode decimal digit characters. Characters that 2938don'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 2953This means that the code points from 0 to 0x2F do not represent decimal digits; 2954the code point 0x30 (DIGIT ZERO) represents 0; code point 0x31, (DIGIT ONE), 2955represents 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), 2958represents 0+1-0 = 1 ... 2959 2960The fourth (index [3]) element (C<$default>) in the list returned for this 2961format is the empty string. 2962 2963=item B<C<ale>> 2964 2965is a combination of the C<"al"> type and the C<"ae"> type. Some of 2966the map array elements have the forms given by C<"al">, and 2967the rest are the empty string. The property C<NFKC_Casefold> has this form. 2968An 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 2980The fourth (index [3]) element (C<$default>) in the list returned for this 2981format is 0. 2982 2983=item B<C<ar>> 2984 2985means that all the elements of the map array are either rational numbers or 2986the string C<"NaN">, meaning "Not a Number". A rational number is either an 2987integer, or two integers separated by a solidus (C<"/">). The second integer 2988represents the denominator of the division implied by the solidus, and is 2989actually always positive, so it is guaranteed not to be 0 and to not be 2990signed. When the element is a plain integer (without the 2991solidus), it may need to be adjusted to get the correct value by adding the 2992offset, just as other C<"a"> properties. No adjustment is needed for 2993fractions, as the range is guaranteed to have just a single element, and so 2994the offset is always 0. 2995 2996If you want to convert the returned map to entirely scalar numbers, you 2997can 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 3004Here's some entries from the output of the property "Nv", which has format 3005C<"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 3022The fourth (index [3]) element (C<$default>) in the list returned for this 3023format is C<"NaN">. 3024 3025=item B<C<n>> 3026 3027means the Name property. All the elements of the map array are simple 3028scalars, but some of them contain special strings that require more work to 3029get the actual name. 3030 3031Entries such as: 3032 3033 CJK UNIFIED IDEOGRAPH-<code point> 3034 3035mean that the name for the code point is "CJK UNIFIED IDEOGRAPH-" 3036with the code point (expressed in hexadecimal) appended to it, like "CJK 3037UNIFIED IDEOGRAPH-3403" (similarly for S<C<CJK COMPATIBILITY IDEOGRAPH-E<lt>code 3038pointE<gt>>>). 3039 3040Also, entries like 3041 3042 <hangul syllable> 3043 3044means that the name is algorithmically calculated. This is easily done by 3045the function L<charnames/charnames::viacode(code)>. 3046 3047Note that for control characters (C<Gc=cc>), Unicode's data files have the 3048string "C<E<lt>controlE<gt>>", but the real name of each of these characters is the empty 3049string. This function returns that real name, the empty string. (There are 3050names for these characters, but they are considered aliases, not the Name 3051property name, and are contained in the C<Name_Alias> property.) 3052 3053=item B<C<ad>> 3054 3055means the Decomposition_Mapping property. This property is like C<"al"> 3056properties, except that one of the scalar elements is of the form: 3057 3058 <hangul syllable> 3059 3060This signifies that this entry should be replaced by the decompositions for 3061all the code points whose decomposition is algorithmically calculated. (All 3062of them are currently in one range and no others outside the range are likely 3063to ever be added to Unicode; the C<"n"> format 3064has this same entry.) These can be generated via the function 3065L<Unicode::Normalize::NFD()|Unicode::Normalize>. 3066 3067Note that the mapping is the one that is specified in the Unicode data files, 3068and to get the final decomposition, it may need to be applied recursively. 3069Unicode in fact discourages use of this property except internally in 3070implementations of the Unicode Normalization Algorithm. 3071 3072The fourth (index [3]) element (C<$default>) in the list returned for this 3073format is 0. 3074 3075=back 3076 3077Note that a format begins with the letter "a" if and only the property it is 3078for requires adjustments by adding the offsets in multi-element ranges. For 3079all these properties, an entry should be adjusted only if the map is a scalar 3080which is an integer. That is, it must match the regular expression: 3081 3082 / ^ -? \d+ $ /xa 3083 3084Further, the first element in a range never needs adjustment, as the 3085adjustment would be just adding 0. 3086 3087A binary search such as that provided by L</search_invlist()>, can be used to 3088quickly find a code point in the inversion list, and hence its corresponding 3089mapping. 3090 3091The final, fourth element (index [3], assigned to C<$default> in the "block" 3092example) in the four element list returned by this function is used with the 3093C<"a"> format types; it may also be useful for applications 3094that wish to convert the returned inversion map data structure into some 3095other, such as a hash. It gives the mapping that most code points map to 3096under the property. If you establish the convention that any code point not 3097explicitly listed in your data structure maps to this value, you can 3098potentially make your data structure much smaller. As you construct your data 3099structure from the one returned by this function, simply ignore those ranges 3100that map to this value. For example, to 3101convert to the data structure searchable by L</charinrange()>, you can follow 3102this 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 3120With this, C<charinrange()> will return C<undef> if its input code point maps 3121to C<$default>. You can avoid this by omitting the C<next> statement, and adding 3122a line after the loop to handle the final element of the inversion map. 3123 3124Similarly, 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 3154Note that the inversion maps returned for the C<Case_Folding> and 3155C<Simple_Case_Folding> properties do not include the Turkic-locale mappings. 3156Use L</casefold()> for these. 3157 3158C<prop_invmap> does not know about any user-defined properties, and will 3159return C<undef> if called with one of those. 3160 3161The returned values for the Perl extension properties, such as C<Any> and 3162C<Greek> are somewhat misleading. The values are either C<"Y"> or C<"N>". 3163All Unicode properties are bipartite, so you can actually use the C<"Y"> or 3164C<"N>" in a Perl regular expression for these, like C<qr/\p{ID_Start=Y/}> or 3165C<qr/\p{Upper=N/}>. But the Perl extensions aren't specified this way, only 3166like C</qr/\p{Any}>, I<etc>. You can't actually use the C<"Y"> and C<"N>" in 3167them. 3168 3169=head3 Getting every available name 3170 3171Instead of reading the Unicode Database directly from files, as you were able 3172to do for a long time, you are encouraged to use the supplied functions. So, 3173instead of reading C<Name.pl> - which may disappear without notice in the 3174future - 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 3183You 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. 3219our @algorithmic_named_code_points; 3220our $HANGUL_BEGIN; 3221our $HANGUL_COUNT; 3222 3223sub 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 3251RETRY: 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 4006sub 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 4025C<search_invlist> is used to search an inversion list returned by 4026C<prop_invlist> or C<prop_invmap> for a particular L</code point argument>. 4027C<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 4029than the list's first element). A warning is raised in the first instance. 4030 4031Otherwise, it returns the index into the list of the range that contains the 4032code point.; that is, find C<i> such that 4033 4034 list[i]<= code_point < list[i+1]. 4035 4036As explained in L</prop_invlist()>, whether a code point is in the list or not 4037depends on if the index is even (in) or odd (not in). And as explained in 4038L</prop_invmap()>, the index is used with the returned parallel array to find 4039the 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 4102This returns the version of the Unicode Character Database, in other words, the 4103version of the Unicode standard the database implements. The version is a 4104string of numbers delimited by dots (C<'.'>). 4105 4106=cut 4107 4108my $UNICODEVERSION; 4109 4110sub 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 4124The difference between a block and a script is that scripts are closer 4125to the linguistic notion of a set of code points required to represent 4126languages, while block is more of an artifact of the Unicode code point 4127numbering and separation into blocks of consecutive code points (so far the 4128size of a block is some multiple of 16, like 128 or 256). 4129 4130For example the Latin B<script> is spread over several B<blocks>, such 4131as C<Basic Latin>, C<Latin 1 Supplement>, C<Latin Extended-A>, and 4132C<Latin Extended-B>. On the other hand, the Latin script does not 4133contain all the characters of the C<Basic Latin> block (also known as 4134ASCII): it includes only the letters, and not, for example, the digits 4135nor the punctuation. 4136 4137For blocks see L<http://www.unicode.org/Public/UNIDATA/Blocks.txt> 4138 4139For scripts see UTR #24: L<http://www.unicode.org/unicode/reports/tr24/> 4140 4141=head2 B<Matching Scripts and Blocks> 4142 4143Scripts are matched with the regular-expression construct 4144C<\p{...}> (e.g. C<\p{Tibetan}> matches characters of the Tibetan script), 4145while C<\p{Blk=...}> is used for blocks (e.g. C<\p{Blk=Tibetan}> matches 4146any of the 256 code points in the Tibetan block). 4147 4148=head2 Old-style versus new-style block names 4149 4150Unicode publishes the names of blocks in two different styles, though the two 4151are equivalent under Unicode's loose matching rules. 4152 4153The original style uses blanks and hyphens in the block names (except for 4154C<No_Block>), like so: 4155 4156 Miscellaneous Mathematical Symbols-B 4157 4158The newer style replaces these with underscores, like this: 4159 4160 Miscellaneous_Mathematical_Symbols_B 4161 4162This newer style is consistent with the values of other Unicode properties. 4163To preserve backward compatibility, all the functions in Unicode::UCD that 4164return block names (except as noted) return the old-style ones. 4165L</prop_value_aliases()> returns the new-style and can be used to convert from 4166old-style to new-style: 4167 4168 my $new_style = prop_values_aliases("block", $old_style); 4169 4170Perl also has single-form extensions that refer to blocks, C<In_Cyrillic>, 4171meaning C<Block=Cyrillic>. These have always been written in the new style. 4172 4173To 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>, 4178gets the lower end of the range (0th element) and then looks up the old name 4179for its block using C<charblock>). 4180 4181Note that starting in Unicode 6.1, many of the block names have shorter 4182synonyms. These are always given in the new style. 4183 4184=head2 Use with older Unicode versions 4185 4186The functions in this module work as well as can be expected when 4187used on earlier Unicode versions. But, obviously, they use the available data 4188from that Unicode version. For example, if the Unicode version predates the 4189definition of the script property (Unicode 3.1), then any function that deals 4190with scripts is going to return C<undef> for the script portion of the return 4191value. 4192 4193=head1 AUTHOR 4194 4195Jarkko Hietaniemi. Now maintained by perl5 porters. 4196 4197=cut 4198 41991; 4200