cpan/Unicode-Collate/Collate.pm

   1 package Unicode::Collate;
   2
   3 BEGIN {
   4     unless ("A" eq pack('U', 0x41)) {
   5         die "Unicode::Collate cannot stringify a Unicode code point\n";
   6     }
   7 }
   8
   9 use 5.006;
  10 use strict;
  11 use warnings;
  12 use Carp;
  13 use File::Spec;
  14
  15 no warnings 'utf8';
  16
  17 our $VERSION = '0.89';
  18 our $PACKAGE = __PACKAGE__;
  19
  20 ### begin XS only ###
  21 require DynaLoader;
  22 our @ISA = qw(DynaLoader);
  23 bootstrap Unicode::Collate $VERSION;
  24 ### end XS only ###
  25
  26 my @Path = qw(Unicode Collate);
  27 my $KeyFile = "allkeys.txt";
  28
  29 # Perl's boolean
  30 use constant TRUE  => 1;
  31 use constant FALSE => "";
  32 use constant NOMATCHPOS => -1;
  33
  34 # A coderef to get combining class imported from Unicode::Normalize
  35 # (i.e. \&Unicode::Normalize::getCombinClass).
  36 # This is also used as a HAS_UNICODE_NORMALIZE flag.
  37 my $CVgetCombinClass;
  38
  39 # Supported Levels
  40 use constant MinLevel => 1;
  41 use constant MaxLevel => 4;
  42
  43 # Minimum weights at level 2 and 3, respectively
  44 use constant Min2Wt => 0x20;
  45 use constant Min3Wt => 0x02;
  46
  47 # Shifted weight at 4th level
  48 use constant Shift4Wt => 0xFFFF;
  49
  50 # A boolean for Variable and 16-bit weights at 4 levels of Collation Element
  51 # PROBLEM: The Default Unicode Collation Element Table
  52 # has weights over 0xFFFF at the 4th level.
  53 # The tie-breaking in the variable weights
  54 # other than "shift" (as well as "shift-trimmed") is unreliable.
  55 use constant VCE_TEMPLATE => 'Cn4';
  56
  57 # A sort key: 16-bit weights
  58 # See also the PROBLEM on VCE_TEMPLATE above.
  59 use constant KEY_TEMPLATE => 'n*';
  60
  61 # Level separator in a sort key:
  62 # i.e. pack(KEY_TEMPLATE, 0)
  63 use constant LEVEL_SEP => "\0\0";
  64
  65 # As Unicode code point separator for hash keys.
  66 # A joined code point string (denoted by JCPS below)
  67 # like "65;768" is used for internal processing
  68 # instead of Perl's Unicode string like "\x41\x{300}",
  69 # as the native code point is different from the Unicode code point
  70 # on EBCDIC platform.
  71 # This character must not be included in any stringified
  72 # representation of an integer.
  73 use constant CODE_SEP => ';';
  74         # NOTE: in regex /;/ is used for $jcps!
  75
  76 # boolean values of variable weights
  77 use constant NON_VAR => 0; # Non-Variable character
  78 use constant VAR     => 1; # Variable character
  79
  80 # specific code points
  81 use constant Hangul_SIni   => 0xAC00;
  82 use constant Hangul_SFin   => 0xD7A3;
  83
  84 # Logical_Order_Exception in PropList.txt
  85 my $DefaultRearrange = [ 0x0E40..0x0E44, 0x0EC0..0x0EC4 ];
  86
  87 sub UCA_Version { "24" }
  88
  89 sub Base_Unicode_Version { "6.1.0" }
  90
  91 ######
  92
  93 sub pack_U {
  94     return pack('U*', @_);
  95 }
  96
  97 ######
  98
  99 my (%VariableOK);
 100 @VariableOK{ qw/
 101     blanked  non-ignorable  shifted  shift-trimmed
 102   / } = (); # keys lowercased
 103
 104 our @ChangeOK = qw/
 105     alternate backwards level normalization rearrange
 106     katakana_before_hiragana upper_before_lower ignore_level2
 107     overrideHangul overrideCJK preprocess UCA_Version
 108     hangul_terminator variable
 109   /;
 110
 111 our @ChangeNG = qw/
 112     entry mapping table maxlength contraction
 113     ignoreChar ignoreName undefChar undefName rewrite
 114     versionTable alternateTable backwardsTable forwardsTable
 115     rearrangeTable variableTable
 116     derivCode normCode rearrangeHash backwardsFlag
 117     suppress suppressHash
 118     __useXS /; ### XS only
 119 # The hash key 'ignored' is deleted at v 0.21.
 120 # The hash key 'isShift' is deleted at v 0.23.
 121 # The hash key 'combining' is deleted at v 0.24.
 122 # The hash key 'entries' is deleted at v 0.30.
 123 # The hash key 'L3_ignorable' is deleted at v 0.40.
 124
 125 sub version {
 126     my $self = shift;
 127     return $self->{versionTable} || 'unknown';
 128 }
 129
 130 my (%ChangeOK, %ChangeNG);
 131 @ChangeOK{ @ChangeOK } = ();
 132 @ChangeNG{ @ChangeNG } = ();
 133
 134 sub change {
 135     my $self = shift;
 136     my %hash = @_;
 137     my %old;
 138     if (exists $hash{variable} && exists $hash{alternate}) {
 139         delete $hash{alternate};
 140     }
 141     elsif (!exists $hash{variable} && exists $hash{alternate}) {
 142         $hash{variable} = $hash{alternate};
 143     }
 144     foreach my $k (keys %hash) {
 145         if (exists $ChangeOK{$k}) {
 146             $old{$k} = $self->{$k};
 147             $self->{$k} = $hash{$k};
 148         }
 149         elsif (exists $ChangeNG{$k}) {
 150             croak "change of $k via change() is not allowed!";
 151         }
 152         # else => ignored
 153     }
 154     $self->checkCollator();
 155     return wantarray ? %old : $self;
 156 }
 157
 158 sub _checkLevel {
 159     my $level = shift;
 160     my $key   = shift; # 'level' or 'backwards'
 161     MinLevel <= $level or croak sprintf
 162         "Illegal level %d (in value for key '%s') lower than %d.",
 163             $level, $key, MinLevel;
 164     $level <= MaxLevel or croak sprintf
 165         "Unsupported level %d (in value for key '%s') higher than %d.",
 166             $level, $key, MaxLevel;
 167 }
 168
 169 my %DerivCode = (
 170     8 => \&_derivCE_8,
 171     9 => \&_derivCE_9,
 172    11 => \&_derivCE_9, # 11 == 9
 173    14 => \&_derivCE_14,
 174    16 => \&_derivCE_14, # 16 == 14
 175    18 => \&_derivCE_18,
 176    20 => \&_derivCE_20,
 177    22 => \&_derivCE_22,
 178    24 => \&_derivCE_24,
 179 );
 180
 181 sub checkCollator {
 182     my $self = shift;
 183     _checkLevel($self->{level}, "level");
 184
 185     $self->{derivCode} = $DerivCode{ $self->{UCA_Version} }
 186         or croak "Illegal UCA version (passed $self->{UCA_Version}).";
 187
 188     $self->{variable} ||= $self->{alternate} || $self->{variableTable} ||
 189                                 $self->{alternateTable} || 'shifted';
 190     $self->{variable} = $self->{alternate} = lc($self->{variable});
 191     exists $VariableOK{ $self->{variable} }
 192         or croak "$PACKAGE unknown variable parameter name: $self->{variable}";
 193
 194     if (! defined $self->{backwards}) {
 195         $self->{backwardsFlag} = 0;
 196     }
 197     elsif (! ref $self->{backwards}) {
 198         _checkLevel($self->{backwards}, "backwards");
 199         $self->{backwardsFlag} = 1 << $self->{backwards};
 200     }
 201     else {
 202         my %level;
 203         $self->{backwardsFlag} = 0;
 204         for my $b (@{ $self->{backwards} }) {
 205             _checkLevel($b, "backwards");
 206             $level{$b} = 1;
 207         }
 208         for my $v (sort keys %level) {
 209             $self->{backwardsFlag} += 1 << $v;
 210         }
 211     }
 212
 213     defined $self->{rearrange} or $self->{rearrange} = [];
 214     ref $self->{rearrange}
 215         or croak "$PACKAGE: list for rearrangement must be store in ARRAYREF";
 216
 217     # keys of $self->{rearrangeHash} are $self->{rearrange}.
 218     $self->{rearrangeHash} = undef;
 219
 220     if (@{ $self->{rearrange} }) {
 221         @{ $self->{rearrangeHash} }{ @{ $self->{rearrange} } } = ();
 222     }
 223
 224     $self->{normCode} = undef;
 225
 226     if (defined $self->{normalization}) {
 227         eval { require Unicode::Normalize };
 228         $@ and croak "Unicode::Normalize is required to normalize strings";
 229
 230         $CVgetCombinClass ||= \&Unicode::Normalize::getCombinClass;
 231
 232         if ($self->{normalization} =~ /^(?:NF)D\z/) { # tweak for default
 233             $self->{normCode} = \&Unicode::Normalize::NFD;
 234         }
 235         elsif ($self->{normalization} ne 'prenormalized') {
 236             my $norm = $self->{normalization};
 237             $self->{normCode} = sub {
 238                 Unicode::Normalize::normalize($norm, shift);
 239             };
 240             eval { $self->{normCode}->("") }; # try
 241             $@ and croak "$PACKAGE unknown normalization form name: $norm";
 242         }
 243     }
 244     return;
 245 }
 246
 247 sub new
 248 {
 249     my $class = shift;
 250     my $self = bless { @_ }, $class;
 251
 252 ### begin XS only ###
 253     if (! exists $self->{table}     && !defined $self->{rewrite} &&
 254         !defined $self->{undefName} && !defined $self->{ignoreName} &&
 255         !defined $self->{undefChar} && !defined $self->{ignoreChar}) {
 256         $self->{__useXS} = \&_fetch_simple;
 257     } else {
 258         $self->{__useXS} = undef;
 259     }
 260 ### end XS only ###
 261
 262     # keys of $self->{suppressHash} are $self->{suppress}.
 263     if ($self->{suppress} && @{ $self->{suppress} }) {
 264         @{ $self->{suppressHash} }{ @{ $self->{suppress} } } = ();
 265     } # before read_table()
 266
 267     # If undef is passed explicitly, no file is read.
 268     $self->{table} = $KeyFile if ! exists $self->{table};
 269     $self->read_table() if defined $self->{table};
 270
 271     if ($self->{entry}) {
 272         while ($self->{entry} =~ /([^\n]+)/g) {
 273             $self->parseEntry($1, TRUE);
 274         }
 275     }
 276
 277     $self->{level} ||= MaxLevel;
 278     $self->{UCA_Version} ||= UCA_Version();
 279
 280     $self->{overrideHangul} = FALSE
 281         if ! exists $self->{overrideHangul};
 282     $self->{overrideCJK} = FALSE
 283         if ! exists $self->{overrideCJK};
 284     $self->{normalization} = 'NFD'
 285         if ! exists $self->{normalization};
 286     $self->{rearrange} = $self->{rearrangeTable} ||
 287         ($self->{UCA_Version} <= 11 ? $DefaultRearrange : [])
 288         if ! exists $self->{rearrange};
 289     $self->{backwards} = $self->{backwardsTable}
 290         if ! exists $self->{backwards};
 291
 292     $self->checkCollator();
 293
 294     return $self;
 295 }
 296
 297 sub parseAtmark {
 298     my $self = shift;
 299     my $line = shift; # after s/^\s*\@//
 300
 301     if ($line =~ /^version\s*(\S*)/) {
 302         $self->{versionTable} ||= $1;
 303     }
 304     elsif ($line =~ /^variable\s+(\S*)/) { # since UTS #10-9
 305         $self->{variableTable} ||= $1;
 306     }
 307     elsif ($line =~ /^alternate\s+(\S*)/) { # till UTS #10-8
 308         $self->{alternateTable} ||= $1;
 309     }
 310     elsif ($line =~ /^backwards\s+(\S*)/) {
 311         push @{ $self->{backwardsTable} }, $1;
 312     }
 313     elsif ($line =~ /^forwards\s+(\S*)/) { # parhaps no use
 314         push @{ $self->{forwardsTable} }, $1;
 315     }
 316     elsif ($line =~ /^rearrange\s+(.*)/) { # (\S*) is NG
 317         push @{ $self->{rearrangeTable} }, _getHexArray($1);
 318     }
 319 }
 320
 321 sub read_table {
 322     my $self = shift;
 323
 324 ### begin XS only ###
 325     if ($self->{__useXS}) {
 326         my @rest = _fetch_rest(); # complex matter need to parse
 327         for my $line (@rest) {
 328             next if $line =~ /^\s*#/;
 329
 330             if ($line =~ s/^\s*\@//) {
 331                 $self->parseAtmark($line);
 332             } else {
 333                 $self->parseEntry($line);
 334             }
 335         }
 336         return;
 337     }
 338 ### end XS only ###
 339
 340     my($f, $fh);
 341     foreach my $d (@INC) {
 342         $f = File::Spec->catfile($d, @Path, $self->{table});
 343         last if open($fh, $f);
 344         $f = undef;
 345     }
 346     if (!defined $f) {
 347         $f = File::Spec->catfile(@Path, $self->{table});
 348         croak("$PACKAGE: Can't locate $f in \@INC (\@INC contains: @INC)");
 349     }
 350
 351     while (my $line = <$fh>) {
 352         next if $line =~ /^\s*#/;
 353
 354         if ($line =~ s/^\s*\@//) {
 355             $self->parseAtmark($line);
 356         } else {
 357             $self->parseEntry($line);
 358         }
 359     }
 360     close $fh;
 361 }
 362
 363
 364 ##
 365 ## get $line, parse it, and write an entry in $self
 366 ##
 367 sub parseEntry
 368 {
 369     my $self = shift;
 370     my $line = shift;
 371     my $tailoring = shift;
 372     my($name, $entry, @uv, @key);
 373
 374     if (defined $self->{rewrite}) {
 375         $line = $self->{rewrite}->($line);
 376     }
 377
 378     return if $line !~ /^\s*[0-9A-Fa-f]/;
 379
 380     # removes comment and gets name
 381     $name = $1
 382         if $line =~ s/[#%]\s*(.*)//;
 383     return if defined $self->{undefName} && $name =~ /$self->{undefName}/;
 384
 385     # gets element
 386     my($e, $k) = split /;/, $line;
 387     croak "Wrong Entry: <charList> must be separated by ';' from <collElement>"
 388         if ! $k;
 389
 390     @uv = _getHexArray($e);
 391     return if !@uv;
 392     return if @uv > 1 && $self->{suppressHash} && !$tailoring &&
 393                   exists $self->{suppressHash}{$uv[0]};
 394     $entry = join(CODE_SEP, @uv); # in JCPS
 395
 396     if (defined $self->{undefChar} || defined $self->{ignoreChar}) {
 397         my $ele = pack_U(@uv);
 398
 399         # regarded as if it were not entried in the table
 400         return
 401             if defined $self->{undefChar} && $ele =~ /$self->{undefChar}/;
 402
 403         # replaced as completely ignorable
 404         $k = '[.0000.0000.0000.0000]'
 405             if defined $self->{ignoreChar} && $ele =~ /$self->{ignoreChar}/;
 406     }
 407
 408     # replaced as completely ignorable
 409     $k = '[.0000.0000.0000.0000]'
 410         if defined $self->{ignoreName} && $name =~ /$self->{ignoreName}/;
 411
 412     my $is_L3_ignorable = TRUE;
 413
 414     foreach my $arr ($k =~ /\[([^\[\]]+)\]/g) { # SPACEs allowed
 415         my $var = $arr =~ /\*/; # exactly /^\*/ but be lenient.
 416         my @wt = _getHexArray($arr);
 417         push @key, pack(VCE_TEMPLATE, $var, @wt);
 418         $is_L3_ignorable = FALSE
 419             if $wt[0] || $wt[1] || $wt[2];
 420         # Conformance Test for 3.1.1 and 4.0.0 shows Level 3 ignorable
 421         # is completely ignorable.
 422         # For expansion, an entry $is_L3_ignorable
 423         # if and only if "all" CEs are [.0000.0000.0000].
 424     }
 425
 426     $self->{mapping}{$entry} = $is_L3_ignorable ? [] : \@key;
 427
 428     if (@uv > 1) {
 429         if (!$self->{maxlength}{$uv[0]} || $self->{maxlength}{$uv[0]} < @uv) {
 430             $self->{maxlength}{$uv[0]} = @uv;
 431         }
 432     }
 433     if (@uv > 2) {
 434         while (@uv) {
 435             pop @uv;
 436             my $fake_entry = join(CODE_SEP, @uv); # in JCPS
 437             $self->{contraction}{$fake_entry} = 1;
 438         }
 439     }
 440 }
 441
 442
 443 sub viewSortKey
 444 {
 445     my $self = shift;
 446     $self->visualizeSortKey($self->getSortKey(@_));
 447 }
 448
 449
 450 ##
 451 ## arrayref of JCPS   = splitEnt(string to be collated)
 452 ## arrayref of arrayref[JCPS, ini_pos, fin_pos] = splitEnt(string, true)
 453 ##
 454 sub splitEnt
 455 {
 456     my $self = shift;
 457     my $wLen = $_[1];
 458
 459     my $code = $self->{preprocess};
 460     my $norm = $self->{normCode};
 461     my $map  = $self->{mapping};
 462     my $max  = $self->{maxlength};
 463     my $reH  = $self->{rearrangeHash};
 464     my $vers = $self->{UCA_Version};
 465     my $ver9 = $vers >= 9 && $vers <= 11;
 466     my $uXS  = $self->{__useXS}; ### XS only
 467
 468     my ($str, @buf);
 469
 470     if ($wLen) {
 471         $code and croak "Preprocess breaks character positions. "
 472                         . "Don't use with index(), match(), etc.";
 473         $norm and croak "Normalization breaks character positions. "
 474                         . "Don't use with index(), match(), etc.";
 475         $str = $_[0];
 476     }
 477     else {
 478         $str = $_[0];
 479         $str = &$code($str) if ref $code;
 480         $str = &$norm($str) if ref $norm;
 481     }
 482
 483     # get array of Unicode code point of string.
 484     my @src = unpack_U($str);
 485
 486     # rearrangement:
 487     # Character positions are not kept if rearranged,
 488     # then neglected if $wLen is true.
 489     if ($reH && ! $wLen) {
 490         for (my $i = 0; $i < @src; $i++) {
 491             if (exists $reH->{ $src[$i] } && $i + 1 < @src) {
 492                 ($src[$i], $src[$i+1]) = ($src[$i+1], $src[$i]);
 493                 $i++;
 494             }
 495         }
 496     }
 497
 498     # remove a code point marked as a completely ignorable.
 499     for (my $i = 0; $i < @src; $i++) {
 500         if (_isIllegal($src[$i]) || $vers <= 20 && _isNonchar($src[$i])) {
 501             $src[$i] = undef;
 502         } elsif ($ver9) {
 503             $src[$i] = undef if $map->{ $src[$i] } &&
 504                              @{ $map->{ $src[$i] } } == 0;
 505 ### begin XS only ###
 506             if ($uXS) {
 507                 $src[$i] = undef if _ignorable_simple($src[$i]);
 508             }
 509 ### end XS only ###
 510         }
 511     }
 512
 513     for (my $i = 0; $i < @src; $i++) {
 514         my $jcps = $src[$i];
 515
 516         # skip removed code point
 517         if (! defined $jcps) {
 518             if ($wLen && @buf) {
 519                 $buf[-1][2] = $i + 1;
 520             }
 521             next;
 522         }
 523
 524         my $i_orig = $i;
 525
 526         # find contraction
 527         if ($max->{$jcps}) {
 528             my $temp_jcps = $jcps;
 529             my $jcpsLen = 1;
 530             my $maxLen = $max->{$jcps};
 531
 532             for (my $p = $i + 1; $jcpsLen < $maxLen && $p < @src; $p++) {
 533                 next if ! defined $src[$p];
 534                 $temp_jcps .= CODE_SEP . $src[$p];
 535                 $jcpsLen++;
 536                 if ($map->{$temp_jcps}) {
 537                     $jcps = $temp_jcps;
 538                     $i = $p;
 539                 }
 540             }
 541
 542         # discontiguous contraction with Combining Char (cf. UTS#10, S2.1).
 543         # This process requires Unicode::Normalize.
 544         # If "normalization" is undef, here should be skipped *always*
 545         # (in spite of bool value of $CVgetCombinClass),
 546         # since canonical ordering cannot be expected.
 547         # Blocked combining character should not be contracted.
 548
 549             # $self->{normCode} is false in the case of "prenormalized".
 550             if ($self->{normalization}) {
 551                 my $cont = $self->{contraction};
 552                 my $preCC = 0;
 553                 my $preCC_uc = 0;
 554                 my $jcps_uc = $jcps;
 555                 my(@out, @out_uc);
 556
 557                 for (my $p = $i + 1; $p < @src; $p++) {
 558                     next if ! defined $src[$p];
 559                     my $curCC = $CVgetCombinClass->($src[$p]);
 560                     last unless $curCC;
 561                     my $tail = CODE_SEP . $src[$p];
 562
 563                     if ($preCC_uc != $curCC && ($map->{$jcps_uc.$tail} ||
 564                                                $cont->{$jcps_uc.$tail})) {
 565                         $jcps_uc .= $tail;
 566                         push @out_uc, $p;
 567                     } else {
 568                         $preCC_uc = $curCC;
 569                     }
 570
 571                     if ($preCC != $curCC && $map->{$jcps.$tail}) {
 572                         $jcps .= $tail;
 573                         push @out, $p;
 574                     } else {
 575                         $preCC = $curCC;
 576                     }
 577                 }
 578
 579                 if ($map->{$jcps_uc}) {
 580                     $jcps = $jcps_uc;
 581                     $src[$_] = undef for @out_uc;
 582                 } else {
 583                     $src[$_] = undef for @out;
 584                 }
 585             }
 586         }
 587
 588         # skip completely ignorable
 589         if ($uXS && $jcps !~ /;/ && _ignorable_simple($jcps) || ### XS only
 590             $map->{$jcps} && @{ $map->{$jcps} } == 0) {
 591             if ($wLen && @buf) {
 592                 $buf[-1][2] = $i + 1;
 593             }
 594             next;
 595         }
 596
 597         push @buf, $wLen ? [$jcps, $i_orig, $i + 1] : $jcps;
 598     }
 599     return \@buf;
 600 }
 601
 602 ##
 603 ## VCE = _pack_override(input, codepoint, derivCode)
 604 ##
 605 sub _pack_override ($$$) {
 606     my $r = shift;
 607     my $u = shift;
 608     my $der = shift;
 609
 610     if (ref $r) {
 611         return pack(VCE_TEMPLATE, NON_VAR, @$r);
 612     } elsif (defined $r) {
 613         return pack(VCE_TEMPLATE, NON_VAR, $r, Min2Wt, Min3Wt, $u);
 614     } else {
 615         return $der->($u);
 616     }
 617 }
 618
 619 ##
 620 ## list of VCE = getWt(JCPS)
 621 ##
 622 sub getWt
 623 {
 624     my $self = shift;
 625     my $u    = shift;
 626     my $map  = $self->{mapping};
 627     my $der  = $self->{derivCode};
 628     my $uXS  = $self->{__useXS}; ### XS only
 629
 630     return if !defined $u;
 631     return map($self->varCE($_), @{ $map->{$u} })
 632         if $map->{$u};
 633 ### begin XS only ###
 634     return map($self->varCE($_), _fetch_simple($u))
 635         if $uXS && _exists_simple($u);
 636 ### end XS only ###
 637
 638     # JCPS must not be a contraction, then it's a code point.
 639     if (Hangul_SIni <= $u && $u <= Hangul_SFin) {
 640         my $hang = $self->{overrideHangul};
 641         my @hangulCE;
 642         if ($hang) {
 643             @hangulCE = map _pack_override($_, $u, $der), $hang->($u);
 644         } elsif (!defined $hang) {
 645             @hangulCE = $der->($u);
 646         } else {
 647             my $max  = $self->{maxlength};
 648             my @decH = _decompHangul($u);
 649
 650             if (@decH == 2) {
 651                 my $contract = join(CODE_SEP, @decH);
 652                 @decH = ($contract) if $map->{$contract};
 653             } else { # must be <@decH == 3>
 654                 if ($max->{$decH[0]}) {
 655                     my $contract = join(CODE_SEP, @decH);
 656                     if ($map->{$contract}) {
 657                         @decH = ($contract);
 658                     } else {
 659                         $contract = join(CODE_SEP, @decH[0,1]);
 660                         $map->{$contract} and @decH = ($contract, $decH[2]);
 661                     }
 662                     # even if V's ignorable, LT contraction is not supported.
 663                     # If such a situation were required, NFD should be used.
 664                 }
 665                 if (@decH == 3 && $max->{$decH[1]}) {
 666                     my $contract = join(CODE_SEP, @decH[1,2]);
 667                     $map->{$contract} and @decH = ($decH[0], $contract);
 668                 }
 669             }
 670
 671             @hangulCE = map({
 672                     $map->{$_} ? @{ $map->{$_} } :
 673                 $uXS && _exists_simple($_) ? _fetch_simple($_) : ### XS only
 674                     $der->($_);
 675                 } @decH);
 676         }
 677         return map $self->varCE($_), @hangulCE;
 678     } else {
 679         my $cjk  = $self->{overrideCJK};
 680         my $vers = $self->{UCA_Version};
 681         if ($cjk && _isUIdeo($u, $vers)) {
 682             my @cjkCE = map _pack_override($_, $u, $der), $cjk->($u);
 683             return map $self->varCE($_), @cjkCE;
 684         }
 685         if ($vers == 8 && defined $cjk && _isUIdeo($u, 0)) {
 686             return map $self->varCE($_), _uideoCE_8($u);
 687         }
 688         return map $self->varCE($_), $der->($u);
 689     }
 690 }
 691
 692
 693 ##
 694 ## string sortkey = getSortKey(string arg)
 695 ##
 696 sub getSortKey
 697 {
 698     my $self = shift;
 699     my $rEnt = $self->splitEnt(shift); # get an arrayref of JCPS
 700     my $vers = $self->{UCA_Version};
 701     my $term = $self->{hangul_terminator};
 702
 703     my @buf; # weight arrays
 704     if ($term) {
 705         my $preHST = '';
 706         my $termCE = $self->varCE(pack(VCE_TEMPLATE, NON_VAR, $term, 0,0,0));
 707         foreach my $jcps (@$rEnt) {
 708             # weird things like VL, TL-contraction are not considered!
 709             my $curHST = join '', map getHST($_, $vers), split /;/, $jcps;
 710             if ($preHST && !$curHST || # hangul before non-hangul
 711                 $preHST =~ /L\z/ && $curHST =~ /^T/ ||
 712                 $preHST =~ /V\z/ && $curHST =~ /^L/ ||
 713                 $preHST =~ /T\z/ && $curHST =~ /^[LV]/) {
 714                 push @buf, $termCE;
 715             }
 716             $preHST = $curHST;
 717             push @buf, $self->getWt($jcps);
 718         }
 719         push @buf, $termCE if $preHST; # end at hangul
 720     } else {
 721         foreach my $jcps (@$rEnt) {
 722             push @buf, $self->getWt($jcps);
 723         }
 724     }
 725
 726     return $self->mk_SortKey(\@buf); ### XS only
 727 }
 728
 729
 730 ##
 731 ## int compare = cmp(string a, string b)
 732 ##
 733 sub cmp { $_[0]->getSortKey($_[1]) cmp $_[0]->getSortKey($_[2]) }
 734 sub eq  { $_[0]->getSortKey($_[1]) eq  $_[0]->getSortKey($_[2]) }
 735 sub ne  { $_[0]->getSortKey($_[1]) ne  $_[0]->getSortKey($_[2]) }
 736 sub lt  { $_[0]->getSortKey($_[1]) lt  $_[0]->getSortKey($_[2]) }
 737 sub le  { $_[0]->getSortKey($_[1]) le  $_[0]->getSortKey($_[2]) }
 738 sub gt  { $_[0]->getSortKey($_[1]) gt  $_[0]->getSortKey($_[2]) }
 739 sub ge  { $_[0]->getSortKey($_[1]) ge  $_[0]->getSortKey($_[2]) }
 740
 741 ##
 742 ## list[strings] sorted = sort(list[strings] arg)
 743 ##
 744 sub sort {
 745     my $obj = shift;
 746     return
 747         map { $_->[1] }
 748             sort{ $a->[0] cmp $b->[0] }
 749                 map [ $obj->getSortKey($_), $_ ], @_;
 750 }
 751
 752
 753 ##
 754 ## bool _nonIgnorAtLevel(arrayref weights, int level)
 755 ##
 756 sub _nonIgnorAtLevel($$)
 757 {
 758     my $wt = shift;
 759     return if ! defined $wt;
 760     my $lv = shift;
 761     return grep($wt->[$_-1] != 0, MinLevel..$lv) ? TRUE : FALSE;
 762 }
 763
 764 ##
 765 ## bool _eqArray(
 766 ##    arrayref of arrayref[weights] source,
 767 ##    arrayref of arrayref[weights] substr,
 768 ##    int level)
 769 ## * comparison of graphemes vs graphemes.
 770 ##   @$source >= @$substr must be true (check it before call this);
 771 ##
 772 sub _eqArray($$$)
 773 {
 774     my $source = shift;
 775     my $substr = shift;
 776     my $lev = shift;
 777
 778     for my $g (0..@$substr-1){
 779         # Do the $g'th graphemes have the same number of AV weights?
 780         return if @{ $source->[$g] } != @{ $substr->[$g] };
 781
 782         for my $w (0..@{ $substr->[$g] }-1) {
 783             for my $v (0..$lev-1) {
 784                 return if $source->[$g][$w][$v] != $substr->[$g][$w][$v];
 785             }
 786         }
 787     }
 788     return 1;
 789 }
 790
 791 ##
 792 ## (int position, int length)
 793 ## int position = index(string, substring, position, [undoc'ed global])
 794 ##
 795 ## With "global" (only for the list context),
 796 ##  returns list of arrayref[position, length].
 797 ##
 798 sub index
 799 {
 800     my $self = shift;
 801     my $str  = shift;
 802     my $len  = length($str);
 803     my $subE = $self->splitEnt(shift);
 804     my $pos  = @_ ? shift : 0;
 805        $pos  = 0 if $pos < 0;
 806     my $glob = shift;
 807
 808     my $lev  = $self->{level};
 809     my $v2i  = $self->{UCA_Version} >= 9 &&
 810                 $self->{variable} ne 'non-ignorable';
 811
 812     if (! @$subE) {
 813         my $temp = $pos <= 0 ? 0 : $len <= $pos ? $len : $pos;
 814         return $glob
 815             ? map([$_, 0], $temp..$len)
 816             : wantarray ? ($temp,0) : $temp;
 817     }
 818     $len < $pos
 819         and return wantarray ? () : NOMATCHPOS;
 820     my $strE = $self->splitEnt($pos ? substr($str, $pos) : $str, TRUE);
 821     @$strE
 822         or return wantarray ? () : NOMATCHPOS;
 823
 824     my(@strWt, @iniPos, @finPos, @subWt, @g_ret);
 825
 826     my $last_is_variable;
 827     for my $vwt (map $self->getWt($_), @$subE) {
 828         my($var, @wt) = unpack(VCE_TEMPLATE, $vwt);
 829         my $to_be_pushed = _nonIgnorAtLevel(\@wt,$lev);
 830
 831         # "Ignorable (L1, L2) after Variable" since track. v. 9
 832         if ($v2i) {
 833             if ($var) {
 834                 $last_is_variable = TRUE;
 835             }
 836             elsif (!$wt[0]) { # ignorable
 837                 $to_be_pushed = FALSE if $last_is_variable;
 838             }
 839             else {
 840                 $last_is_variable = FALSE;
 841             }
 842         }
 843
 844         if (@subWt && !$var && !$wt[0]) {
 845             push @{ $subWt[-1] }, \@wt if $to_be_pushed;
 846         } elsif ($to_be_pushed) {
 847             push @subWt, [ \@wt ];
 848         }
 849         # else ===> skipped
 850     }
 851
 852     my $count = 0;
 853     my $end = @$strE - 1;
 854
 855     $last_is_variable = FALSE; # reuse
 856     for (my $i = 0; $i <= $end; ) { # no $i++
 857         my $found_base = 0;
 858
 859         # fetch a grapheme
 860         while ($i <= $end && $found_base == 0) {
 861             for my $vwt ($self->getWt($strE->[$i][0])) {
 862                 my($var, @wt) = unpack(VCE_TEMPLATE, $vwt);
 863                 my $to_be_pushed = _nonIgnorAtLevel(\@wt,$lev);
 864
 865                 # "Ignorable (L1, L2) after Variable" since track. v. 9
 866                 if ($v2i) {
 867                     if ($var) {
 868                         $last_is_variable = TRUE;
 869                     }
 870                     elsif (!$wt[0]) { # ignorable
 871                         $to_be_pushed = FALSE if $last_is_variable;
 872                     }
 873                     else {
 874                         $last_is_variable = FALSE;
 875                     }
 876                 }
 877
 878                 if (@strWt && !$var && !$wt[0]) {
 879                     push @{ $strWt[-1] }, \@wt if $to_be_pushed;
 880                     $finPos[-1] = $strE->[$i][2];
 881                 } elsif ($to_be_pushed) {
 882                     push @strWt, [ \@wt ];
 883                     push @iniPos, $found_base ? NOMATCHPOS : $strE->[$i][1];
 884                     $finPos[-1] = NOMATCHPOS if $found_base;
 885                     push @finPos, $strE->[$i][2];
 886                     $found_base++;
 887                 }
 888                 # else ===> no-op
 889             }
 890             $i++;
 891         }
 892
 893         # try to match
 894         while ( @strWt > @subWt || (@strWt == @subWt && $i > $end) ) {
 895             if ($iniPos[0] != NOMATCHPOS &&
 896                     $finPos[$#subWt] != NOMATCHPOS &&
 897                         _eqArray(\@strWt, \@subWt, $lev)) {
 898                 my $temp = $iniPos[0] + $pos;
 899
 900                 if ($glob) {
 901                     push @g_ret, [$temp, $finPos[$#subWt] - $iniPos[0]];
 902                     splice @strWt,  0, $#subWt;
 903                     splice @iniPos, 0, $#subWt;
 904                     splice @finPos, 0, $#subWt;
 905                 }
 906                 else {
 907                     return wantarray
 908                         ? ($temp, $finPos[$#subWt] - $iniPos[0])
 909                         :  $temp;
 910                 }
 911             }
 912             shift @strWt;
 913             shift @iniPos;
 914             shift @finPos;
 915         }
 916     }
 917
 918     return $glob
 919         ? @g_ret
 920         : wantarray ? () : NOMATCHPOS;
 921 }
 922
 923 ##
 924 ## scalarref to matching part = match(string, substring)
 925 ##
 926 sub match
 927 {
 928     my $self = shift;
 929     if (my($pos,$len) = $self->index($_[0], $_[1])) {
 930         my $temp = substr($_[0], $pos, $len);
 931         return wantarray ? $temp : \$temp;
 932         # An lvalue ref \substr should be avoided,
 933         # since its value is affected by modification of its referent.
 934     }
 935     else {
 936         return;
 937     }
 938 }
 939
 940 ##
 941 ## arrayref matching parts = gmatch(string, substring)
 942 ##
 943 sub gmatch
 944 {
 945     my $self = shift;
 946     my $str  = shift;
 947     my $sub  = shift;
 948     return map substr($str, $_->[0], $_->[1]),
 949                 $self->index($str, $sub, 0, 'g');
 950 }
 951
 952 ##
 953 ## bool subst'ed = subst(string, substring, replace)
 954 ##
 955 sub subst
 956 {
 957     my $self = shift;
 958     my $code = ref $_[2] eq 'CODE' ? $_[2] : FALSE;
 959
 960     if (my($pos,$len) = $self->index($_[0], $_[1])) {
 961         if ($code) {
 962             my $mat = substr($_[0], $pos, $len);
 963             substr($_[0], $pos, $len, $code->($mat));
 964         } else {
 965             substr($_[0], $pos, $len, $_[2]);
 966         }
 967         return TRUE;
 968     }
 969     else {
 970         return FALSE;
 971     }
 972 }
 973
 974 ##
 975 ## int count = gsubst(string, substring, replace)
 976 ##
 977 sub gsubst
 978 {
 979     my $self = shift;
 980     my $code = ref $_[2] eq 'CODE' ? $_[2] : FALSE;
 981     my $cnt = 0;
 982
 983     # Replacement is carried out from the end, then use reverse.
 984     for my $pos_len (reverse $self->index($_[0], $_[1], 0, 'g')) {
 985         if ($code) {
 986             my $mat = substr($_[0], $pos_len->[0], $pos_len->[1]);
 987             substr($_[0], $pos_len->[0], $pos_len->[1], $code->($mat));
 988         } else {
 989             substr($_[0], $pos_len->[0], $pos_len->[1], $_[2]);
 990         }
 991         $cnt++;
 992     }
 993     return $cnt;
 994 }
 995
 996 1;
 997 __END__
 998
 999 =head1 NAME
1000
1001 Unicode::Collate - Unicode Collation Algorithm
1002
1003 =head1 SYNOPSIS
1004
1005   use Unicode::Collate;
1006
1007   #construct
1008   $Collator = Unicode::Collate->new(%tailoring);
1009
1010   #sort
1011   @sorted = $Collator->sort(@not_sorted);
1012
1013   #compare
1014   $result = $Collator->cmp($a, $b); # returns 1, 0, or -1.
1015
1016 B<Note:> Strings in C<@not_sorted>, C<$a> and C<$b> are interpreted
1017 according to Perl's Unicode support. See L<perlunicode>,
1018 L<perluniintro>, L<perlunitut>, L<perlunifaq>, L<utf8>.
1019 Otherwise you can use C<preprocess> or should decode them before.
1020
1021 =head1 DESCRIPTION
1022
1023 This module is an implementation of Unicode Technical Standard #10
1024 (a.k.a. UTS #10) - Unicode Collation Algorithm (a.k.a. UCA).
1025
1026 =head2 Constructor and Tailoring
1027
1028 The C<new> method returns a collator object. If new() is called
1029 with no parameters, the collator should do the default collation.
1030
1031    $Collator = Unicode::Collate->new(
1032       UCA_Version => $UCA_Version,
1033       alternate => $alternate, # alias for 'variable'
1034       backwards => $levelNumber, # or \@levelNumbers
1035       entry => $element,
1036       hangul_terminator => $term_primary_weight,
1037       ignoreName => qr/$ignoreName/,
1038       ignoreChar => qr/$ignoreChar/,
1039       ignore_level2 => $bool,
1040       katakana_before_hiragana => $bool,
1041       level => $collationLevel,
1042       normalization  => $normalization_form,
1043       overrideCJK => \&overrideCJK,
1044       overrideHangul => \&overrideHangul,
1045       preprocess => \&preprocess,
1046       rearrange => \@charList,
1047       rewrite => \&rewrite,
1048       suppress => \@charList,
1049       table => $filename,
1050       undefName => qr/$undefName/,
1051       undefChar => qr/$undefChar/,
1052       upper_before_lower => $bool,
1053       variable => $variable,
1054    );
1055
1056 =over 4
1057
1058 =item UCA_Version
1059
1060 If the revision (previously "tracking version") number of UCA is given,
1061 behavior of that revision is emulated on collating.
1062 If omitted, the return value of C<UCA_Version()> is used.
1063
1064 The following revisions are supported.  The default is 24.
1065
1066      UCA       Unicode Standard         DUCET (@version)
1067    -------------------------------------------------------
1068       8              3.1                3.0.1 (3.0.1d9)
1069       9     3.1 with Corrigendum 3      3.1.1 (3.1.1)
1070      11              4.0                4.0.0 (4.0.0)
1071      14             4.1.0               4.1.0 (4.1.0)
1072      16              5.0                5.0.0 (5.0.0)
1073      18             5.1.0               5.1.0 (5.1.0)
1074      20             5.2.0               5.2.0 (5.2.0)
1075      22             6.0.0               6.0.0 (6.0.0)
1076      24             6.1.0               6.1.0 (6.1.0)
1077
1078 * Noncharacters (e.g. U+FFFF) are not ignored, and can be overridden
1079 since C<UCA_Version> 22.
1080
1081 * Fully ignorable characters were ignored, and would not interrupt
1082 contractions with C<UCA_Version> 9 and 11.
1083
1084 * Treatment of ignorables after variables and some behaviors
1085 were changed at C<UCA_Version> 9.
1086
1087 * Characters regarded as CJK unified ideographs (cf. C<overrideCJK>)
1088 depend on C<UCA_Version>.
1089
1090 * Many hangul jamo are assigned at C<UCA_Version> 20, that will affect
1091 C<hangul_terminator>.
1092
1093 =item alternate
1094
1095 -- see 3.2.2 Alternate Weighting, version 8 of UTS #10
1096
1097 For backward compatibility, C<alternate> (old name) can be used
1098 as an alias for C<variable>.
1099
1100 =item backwards
1101
1102 -- see 3.1.2 French Accents, UTS #10.
1103
1104      backwards => $levelNumber or \@levelNumbers
1105
1106 Weights in reverse order; ex. level 2 (diacritic ordering) in French.
1107 If omitted (or C<$levelNumber> is C<undef> or C<\@levelNumbers> is C<[]>),
1108 forwards at all the levels.
1109
1110 =item entry
1111
1112 -- see 3.1 Linguistic Features; 3.2.1 File Format, UTS #10.
1113
1114 If the same character (or a sequence of characters) exists
1115 in the collation element table through C<table>,
1116 mapping to collation elements is overridden.
1117 If it does not exist, the mapping is defined additionally.
1118
1119     entry => <<'ENTRY', # for DUCET v4.0.0 (allkeys-4.0.0.txt)
1120 0063 0068 ; [.0E6A.0020.0002.0063] # ch
1121 0043 0068 ; [.0E6A.0020.0007.0043] # Ch
1122 0043 0048 ; [.0E6A.0020.0008.0043] # CH
1123 006C 006C ; [.0F4C.0020.0002.006C] # ll
1124 004C 006C ; [.0F4C.0020.0007.004C] # Ll
1125 004C 004C ; [.0F4C.0020.0008.004C] # LL
1126 00F1      ; [.0F7B.0020.0002.00F1] # n-tilde
1127 006E 0303 ; [.0F7B.0020.0002.00F1] # n-tilde
1128 00D1      ; [.0F7B.0020.0008.00D1] # N-tilde
1129 004E 0303 ; [.0F7B.0020.0008.00D1] # N-tilde
1130 ENTRY
1131
1132     entry => <<'ENTRY', # for DUCET v4.0.0 (allkeys-4.0.0.txt)
1133 00E6 ; [.0E33.0020.0002.00E6][.0E8B.0020.0002.00E6] # ae ligature as <a><e>
1134 00C6 ; [.0E33.0020.0008.00C6][.0E8B.0020.0008.00C6] # AE ligature as <A><E>
1135 ENTRY
1136
1137 B<NOTE:> The code point in the UCA file format (before C<';'>)
1138 B<must> be a Unicode code point (defined as hexadecimal),
1139 but not a native code point.
1140 So C<0063> must always denote C<U+0063>,
1141 but not a character of C<"\x63">.
1142
1143 Weighting may vary depending on collation element table.
1144 So ensure the weights defined in C<entry> will be consistent with
1145 those in the collation element table loaded via C<table>.
1146
1147 In DUCET v4.0.0, primary weight of C<C> is C<0E60>
1148 and that of C<D> is C<0E6D>. So setting primary weight of C<CH> to C<0E6A>
1149 (as a value between C<0E60> and C<0E6D>)
1150 makes ordering as C<C E<lt> CH E<lt> D>.
1151 Exactly speaking DUCET already has some characters between C<C> and C<D>:
1152 C<small capital C> (C<U+1D04>) with primary weight C<0E64>,
1153 C<c-hook/C-hook> (C<U+0188/U+0187>) with C<0E65>,
1154 and C<c-curl> (C<U+0255>) with C<0E69>.
1155 Then primary weight C<0E6A> for C<CH> makes C<CH>
1156 ordered between C<c-curl> and C<D>.
1157
1158 =item hangul_terminator
1159
1160 -- see 7.1.4 Trailing Weights, UTS #10.
1161
1162 If a true value is given (non-zero but should be positive),
1163 it will be added as a terminator primary weight to the end of
1164 every standard Hangul syllable. Secondary and any higher weights
1165 for terminator are set to zero.
1166 If the value is false or C<hangul_terminator> key does not exist,
1167 insertion of terminator weights will not be performed.
1168
1169 Boundaries of Hangul syllables are determined
1170 according to conjoining Jamo behavior in F<the Unicode Standard>
1171 and F<HangulSyllableType.txt>.
1172
1173 B<Implementation Note:>
1174 (1) For expansion mapping (Unicode character mapped
1175 to a sequence of collation elements), a terminator will not be added
1176 between collation elements, even if Hangul syllable boundary exists there.
1177 Addition of terminator is restricted to the next position
1178 to the last collation element.
1179
1180 (2) Non-conjoining Hangul letters
1181 (Compatibility Jamo, halfwidth Jamo, and enclosed letters) are not
1182 automatically terminated with a terminator primary weight.
1183 These characters may need terminator included in a collation element
1184 table beforehand.
1185
1186 =item ignoreChar
1187
1188 =item ignoreName
1189
1190 -- see 3.2.2 Variable Weighting, UTS #10.
1191
1192 Makes the entry in the table completely ignorable;
1193 i.e. as if the weights were zero at all level.
1194
1195 Through C<ignoreChar>, any character matching C<qr/$ignoreChar/>
1196 will be ignored. Through C<ignoreName>, any character whose name
1197 (given in the C<table> file as a comment) matches C<qr/$ignoreName/>
1198 will be ignored.
1199
1200 E.g. when 'a' and 'e' are ignorable,
1201 'element' is equal to 'lament' (or 'lmnt').
1202
1203 =item ignore_level2
1204
1205 -- see 5.1 Parametric Tailoring, UTS #10.
1206
1207 By default, case-sensitive comparison (that is level 3 difference)
1208 won't ignore accents (that is level 2 difference).
1209
1210 If the parameter is made true, accents (and other primary ignorable
1211 characters) are ignored, even though cases are taken into account.
1212
1213 B<NOTE>: C<level> should be 3 or greater.
1214
1215 =item katakana_before_hiragana
1216
1217 -- see 7.3.1 Tertiary Weight Table, UTS #10.
1218
1219 By default, hiragana is before katakana.
1220 If the parameter is made true, this is reversed.
1221
1222 B<NOTE>: This parameter simplemindedly assumes that any hiragana/katakana
1223 distinctions must occur in level 3, and their weights at level 3 must be
1224 same as those mentioned in 7.3.1, UTS #10.
1225 If you define your collation elements which violate this requirement,
1226 this parameter does not work validly.
1227
1228 =item level
1229
1230 -- see 4.3 Form Sort Key, UTS #10.
1231
1232 Set the maximum level.
1233 Any higher levels than the specified one are ignored.
1234
1235   Level 1: alphabetic ordering
1236   Level 2: diacritic ordering
1237   Level 3: case ordering
1238   Level 4: tie-breaking (e.g. in the case when variable is 'shifted')
1239
1240   ex.level => 2,
1241
1242 If omitted, the maximum is the 4th.
1243
1244 =item normalization
1245
1246 -- see 4.1 Normalize, UTS #10.
1247
1248 If specified, strings are normalized before preparation of sort keys
1249 (the normalization is executed after preprocess).
1250
1251 A form name C<Unicode::Normalize::normalize()> accepts will be applied
1252 as C<$normalization_form>.
1253 Acceptable names include C<'NFD'>, C<'NFC'>, C<'NFKD'>, and C<'NFKC'>.
1254 See C<Unicode::Normalize::normalize()> for detail.
1255 If omitted, C<'NFD'> is used.
1256
1257 C<normalization> is performed after C<preprocess> (if defined).
1258
1259 Furthermore, special values, C<undef> and C<"prenormalized">, can be used,
1260 though they are not concerned with C<Unicode::Normalize::normalize()>.
1261
1262 If C<undef> (not a string C<"undef">) is passed explicitly
1263 as the value for this key,
1264 any normalization is not carried out (this may make tailoring easier
1265 if any normalization is not desired). Under C<(normalization =E<gt> undef)>,
1266 only contiguous contractions are resolved;
1267 e.g. even if C<A-ring> (and C<A-ring-cedilla>) is ordered after C<Z>,
1268 C<A-cedilla-ring> would be primary equal to C<A>.
1269 In this point,
1270 C<(normalization =E<gt> undef, preprocess =E<gt> sub { NFD(shift) })>
1271 B<is not> equivalent to C<(normalization =E<gt> 'NFD')>.
1272
1273 In the case of C<(normalization =E<gt> "prenormalized")>,
1274 any normalization is not performed, but
1275 discontiguous contractions with combining characters are performed.
1276 Therefore
1277 C<(normalization =E<gt> 'prenormalized', preprocess =E<gt> sub { NFD(shift) })>
1278 B<is> equivalent to C<(normalization =E<gt> 'NFD')>.
1279 If source strings are finely prenormalized,
1280 C<(normalization =E<gt> 'prenormalized')> may save time for normalization.
1281
1282 Except C<(normalization =E<gt> undef)>,
1283 B<Unicode::Normalize> is required (see also B<CAVEAT>).
1284
1285 =item overrideCJK
1286
1287 -- see 7.1 Derived Collation Elements, UTS #10.
1288
1289 By default, CJK unified ideographs are ordered in Unicode codepoint
1290 order, but those in the CJK Unified Ideographs block are lesser than
1291 those in the CJK Unified Ideographs Extension A etc.
1292
1293     In the CJK Unified Ideographs block:
1294     U+4E00..U+9FA5 if UCA_Version is 8, 9 or 11.
1295     U+4E00..U+9FBB if UCA_Version is 14 or 16.
1296     U+4E00..U+9FC3 if UCA_Version is 18.
1297     U+4E00..U+9FCB if UCA_Version is 20 or 22.
1298     U+4E00..U+9FCC if UCA_Version is 24.
1299
1300     In the CJK Unified Ideographs Extension blocks:
1301     Ext.A (U+3400..U+4DB5) and Ext.B (U+20000..U+2A6D6) in any UCA_Version.
1302     Ext.C (U+2A700..U+2B734) if UCA_Version is 20 or greater.
1303     Ext.D (U+2B740..U+2B81D) if UCA_Version is 22 or greater.
1304
1305 Through C<overrideCJK>, ordering of CJK unified ideographs (including
1306 extensions) can be overridden.
1307
1308 ex. CJK unified ideographs in the JIS code point order.
1309
1310   overrideCJK => sub {
1311       my $u = shift;             # get a Unicode codepoint
1312       my $b = pack('n', $u);     # to UTF-16BE
1313       my $s = your_unicode_to_sjis_converter($b); # convert
1314       my $n = unpack('n', $s);   # convert sjis to short
1315       [ $n, 0x20, 0x2, $u ];     # return the collation element
1316   },
1317
1318 The return value may be an arrayref of 1st to 4th weights as shown
1319 above. The return value may be an integer as the primary weight
1320 as shown below.  If C<undef> is returned, the default derived
1321 collation element will be used.
1322
1323   overrideCJK => sub {
1324       my $u = shift;             # get a Unicode codepoint
1325       my $b = pack('n', $u);     # to UTF-16BE
1326       my $s = your_unicode_to_sjis_converter($b); # convert
1327       my $n = unpack('n', $s);   # convert sjis to short
1328       return $n;                 # return the primary weight
1329   },
1330
1331 The return value may be a list containing zero or more of
1332 an arrayref, an integer, or C<undef>.
1333
1334 ex. ignores all CJK unified ideographs.
1335
1336   overrideCJK => sub {()}, # CODEREF returning empty list
1337
1338    # where ->eq("Pe\x{4E00}rl", "Perl") is true
1339    # as U+4E00 is a CJK unified ideograph and to be ignorable.
1340
1341 If C<undef> is passed explicitly as the value for this key,
1342 weights for CJK unified ideographs are treated as undefined.
1343 But assignment of weight for CJK unified ideographs
1344 in C<table> or C<entry> is still valid.
1345
1346 B<Note:> In addition to them, 12 CJK compatibility ideographs (C<U+FA0E>,
1347 C<U+FA0F>, C<U+FA11>, C<U+FA13>, C<U+FA14>, C<U+FA1F>, C<U+FA21>, C<U+FA23>,
1348 C<U+FA24>, C<U+FA27>, C<U+FA28>, C<U+FA29>) are also treated as CJK unified
1349 ideographs. But they can't be overridden via C<overrideCJK> when you use
1350 DUCET, as the table includes weights for them. C<table> or C<entry> has
1351 priority over C<overrideCJK>.
1352
1353 =item overrideHangul
1354
1355 -- see 7.1 Derived Collation Elements, UTS #10.
1356
1357 By default, Hangul syllables are decomposed into Hangul Jamo,
1358 even if C<(normalization =E<gt> undef)>.
1359 But the mapping of Hangul syllables may be overridden.
1360
1361 This parameter works like C<overrideCJK>, so see there for examples.
1362
1363 If you want to override the mapping of Hangul syllables,
1364 NFD and NFKD are not appropriate, since NFD and NFKD will decompose
1365 Hangul syllables before overriding. FCD may decompose Hangul syllables
1366 as the case may be.
1367
1368 If C<undef> is passed explicitly as the value for this key,
1369 weight for Hangul syllables is treated as undefined
1370 without decomposition into Hangul Jamo.
1371 But definition of weight for Hangul syllables
1372 in C<table> or C<entry> is still valid.
1373
1374 =item preprocess
1375
1376 -- see 5.1 Preprocessing, UTS #10.
1377
1378 If specified, the coderef is used to preprocess each string
1379 before the formation of sort keys.
1380
1381 ex. dropping English articles, such as "a" or "the".
1382 Then, "the pen" is before "a pencil".
1383
1384      preprocess => sub {
1385            my $str = shift;
1386            $str =~ s/\b(?:an?|the)\s+//gi;
1387            return $str;
1388         },
1389
1390 C<preprocess> is performed before C<normalization> (if defined).
1391
1392 ex. decoding strings in a legacy encoding such as shift-jis:
1393
1394     $sjis_collator = Unicode::Collate->new(
1395         preprocess => \&your_shiftjis_to_unicode_decoder,
1396     );
1397     @result = $sjis_collator->sort(@shiftjis_strings);
1398
1399 B<Note:> Strings returned from the coderef will be interpreted
1400 according to Perl's Unicode support. See L<perlunicode>,
1401 L<perluniintro>, L<perlunitut>, L<perlunifaq>, L<utf8>.
1402
1403 =item rearrange
1404
1405 -- see 3.1.3 Rearrangement, UTS #10.
1406
1407 Characters that are not coded in logical order and to be rearranged.
1408 If C<UCA_Version> is equal to or lesser than 11, default is:
1409
1410     rearrange => [ 0x0E40..0x0E44, 0x0EC0..0x0EC4 ],
1411
1412 If you want to disallow any rearrangement, pass C<undef> or C<[]>
1413 (a reference to empty list) as the value for this key.
1414
1415 If C<UCA_Version> is equal to or greater than 14, default is C<[]>
1416 (i.e. no rearrangement).
1417
1418 B<According to the version 9 of UCA, this parameter shall not be used;
1419 but it is not warned at present.>
1420
1421 =item rewrite
1422
1423 If specified, the coderef is used to rewrite lines in C<table> or C<entry>.
1424 The coderef will get each line, and then should return a rewritten line
1425 according to the UCA file format.
1426 If the coderef returns an empty line, the line will be skipped.
1427
1428 e.g. any primary ignorable characters into tertiary ignorable:
1429
1430     rewrite => sub {
1431         my $line = shift;
1432         $line =~ s/\[\.0000\..{4}\..{4}\./[.0000.0000.0000./g;
1433         return $line;
1434     },
1435
1436 This example shows rewriting weights. C<rewrite> is allowed to
1437 affect code points, weights, and the name.
1438
1439 B<NOTE>: C<table> is available to use another table file;
1440 preparing a modified table once would be more efficient than
1441 rewriting lines on reading an unmodified table every time.
1442
1443 =item suppress
1444
1445 -- see suppress contractions in 5.14.11 Special-Purpose Commands,
1446 UTS #35 (LDML).
1447
1448 Contractions beginning with the specified characters are suppressed,
1449 even if those contractions are defined in C<table>.
1450
1451 An example for Russian and some languages using the Cyrillic script:
1452
1453     suppress => [0x0400..0x0417, 0x041A..0x0437, 0x043A..0x045F],
1454
1455 where 0x0400 stands for C<U+0400>, CYRILLIC CAPITAL LETTER IE WITH GRAVE.
1456
1457 B<NOTE>: Contractions via C<entry> are not be suppressed.
1458
1459 =item table
1460
1461 -- see 3.2 Default Unicode Collation Element Table, UTS #10.
1462
1463 You can use another collation element table if desired.
1464
1465 The table file should locate in the F<Unicode/Collate> directory
1466 on C<@INC>. Say, if the filename is F<Foo.txt>,
1467 the table file is searched as F<Unicode/Collate/Foo.txt> in C<@INC>.
1468
1469 By default, F<allkeys.txt> (as the filename of DUCET) is used.
1470 If you will prepare your own table file, any name other than F<allkeys.txt>
1471 may be better to avoid namespace conflict.
1472
1473 B<NOTE>: When XSUB is used, the DUCET is compiled on building this
1474 module, and it may save time at the run time.
1475 Explicit saying C<table =E<gt> 'allkeys.txt'> (or using another table),
1476 or using C<ignoreChar>, C<ignoreName>, C<undefChar>, C<undefName> or
1477 C<rewrite> will prevent this module from using the compiled DUCET.
1478
1479 If C<undef> is passed explicitly as the value for this key,
1480 no file is read (but you can define collation elements via C<entry>).
1481
1482 A typical way to define a collation element table
1483 without any file of table:
1484
1485    $onlyABC = Unicode::Collate->new(
1486        table => undef,
1487        entry => << 'ENTRIES',
1488 0061 ; [.0101.0020.0002.0061] # LATIN SMALL LETTER A
1489 0041 ; [.0101.0020.0008.0041] # LATIN CAPITAL LETTER A
1490 0062 ; [.0102.0020.0002.0062] # LATIN SMALL LETTER B
1491 0042 ; [.0102.0020.0008.0042] # LATIN CAPITAL LETTER B
1492 0063 ; [.0103.0020.0002.0063] # LATIN SMALL LETTER C
1493 0043 ; [.0103.0020.0008.0043] # LATIN CAPITAL LETTER C
1494 ENTRIES
1495     );
1496
1497 If C<ignoreName> or C<undefName> is used, character names should be
1498 specified as a comment (following C<#>) on each line.
1499
1500 =item undefChar
1501
1502 =item undefName
1503
1504 -- see 6.3.4 Reducing the Repertoire, UTS #10.
1505
1506 Undefines the collation element as if it were unassigned in the C<table>.
1507 This reduces the size of the table.
1508 If an unassigned character appears in the string to be collated,
1509 the sort key is made from its codepoint
1510 as a single-character collation element,
1511 as it is greater than any other assigned collation elements
1512 (in the codepoint order among the unassigned characters).
1513 But, it'd be better to ignore characters
1514 unfamiliar to you and maybe never used.
1515
1516 Through C<undefChar>, any character matching C<qr/$undefChar/>
1517 will be undefined. Through C<undefName>, any character whose name
1518 (given in the C<table> file as a comment) matches C<qr/$undefName/>
1519 will be undefined.
1520
1521 ex. Collation weights for beyond-BMP characters are not stored in object:
1522
1523     undefChar => qr/[^\0-\x{fffd}]/,
1524
1525 =item upper_before_lower
1526
1527 -- see 6.6 Case Comparisons, UTS #10.
1528
1529 By default, lowercase is before uppercase.
1530 If the parameter is made true, this is reversed.
1531
1532 B<NOTE>: This parameter simplemindedly assumes that any lowercase/uppercase
1533 distinctions must occur in level 3, and their weights at level 3 must be
1534 same as those mentioned in 7.3.1, UTS #10.
1535 If you define your collation elements which differs from this requirement,
1536 this parameter doesn't work validly.
1537
1538 =item variable
1539
1540 -- see 3.2.2 Variable Weighting, UTS #10.
1541
1542 This key allows for variable weighting of variable collation elements,
1543 which are marked with an ASTERISK in the table
1544 (NOTE: Many punctuation marks and symbols are variable in F<allkeys.txt>).
1545
1546    variable => 'blanked', 'non-ignorable', 'shifted', or 'shift-trimmed'.
1547
1548 These names are case-insensitive.
1549 By default (if specification is omitted), 'shifted' is adopted.
1550
1551    'Blanked'        Variable elements are made ignorable at levels 1 through 3;
1552                     considered at the 4th level.
1553
1554    'Non-Ignorable'  Variable elements are not reset to ignorable.
1555
1556    'Shifted'        Variable elements are made ignorable at levels 1 through 3
1557                     their level 4 weight is replaced by the old level 1 weight.
1558                     Level 4 weight for Non-Variable elements is 0xFFFF.
1559
1560    'Shift-Trimmed'  Same as 'shifted', but all FFFF's at the 4th level
1561                     are trimmed.
1562
1563 =back
1564
1565 =head2 Methods for Collation
1566
1567 =over 4
1568
1569 =item C<@sorted = $Collator-E<gt>sort(@not_sorted)>
1570
1571 Sorts a list of strings.
1572
1573 =item C<$result = $Collator-E<gt>cmp($a, $b)>
1574
1575 Returns 1 (when C<$a> is greater than C<$b>)
1576 or 0 (when C<$a> is equal to C<$b>)
1577 or -1 (when C<$a> is lesser than C<$b>).
1578
1579 =item C<$result = $Collator-E<gt>eq($a, $b)>
1580
1581 =item C<$result = $Collator-E<gt>ne($a, $b)>
1582
1583 =item C<$result = $Collator-E<gt>lt($a, $b)>
1584
1585 =item C<$result = $Collator-E<gt>le($a, $b)>
1586
1587 =item C<$result = $Collator-E<gt>gt($a, $b)>
1588
1589 =item C<$result = $Collator-E<gt>ge($a, $b)>
1590
1591 They works like the same name operators as theirs.
1592
1593    eq : whether $a is equal to $b.
1594    ne : whether $a is not equal to $b.
1595    lt : whether $a is lesser than $b.
1596    le : whether $a is lesser than $b or equal to $b.
1597    gt : whether $a is greater than $b.
1598    ge : whether $a is greater than $b or equal to $b.
1599
1600 =item C<$sortKey = $Collator-E<gt>getSortKey($string)>
1601
1602 -- see 4.3 Form Sort Key, UTS #10.
1603
1604 Returns a sort key.
1605
1606 You compare the sort keys using a binary comparison
1607 and get the result of the comparison of the strings using UCA.
1608
1609    $Collator->getSortKey($a) cmp $Collator->getSortKey($b)
1610
1611       is equivalent to
1612
1613    $Collator->cmp($a, $b)
1614
1615 =item C<$sortKeyForm = $Collator-E<gt>viewSortKey($string)>
1616
1617 Converts a sorting key into its representation form.
1618 If C<UCA_Version> is 8, the output is slightly different.
1619
1620    use Unicode::Collate;
1621    my $c = Unicode::Collate->new();
1622    print $c->viewSortKey("Perl"),"\n";
1623
1624    # output:
1625    # [0B67 0A65 0B7F 0B03 | 0020 0020 0020 0020 | 0008 0002 0002 0002 | FFFF FFFF FFFF FFFF]
1626    #  Level 1               Level 2               Level 3               Level 4
1627
1628 =back
1629
1630 =head2 Methods for Searching
1631
1632 The C<match>, C<gmatch>, C<subst>, C<gsubst> methods work
1633 like C<m//>, C<m//g>, C<s///>, C<s///g>, respectively,
1634 but they are not aware of any pattern, but only a literal substring.
1635
1636 B<DISCLAIMER:> If C<preprocess> or C<normalization> parameter is true
1637 for C<$Collator>, calling these methods (C<index>, C<match>, C<gmatch>,
1638 C<subst>, C<gsubst>) is croaked, as the position and the length might
1639 differ from those on the specified string.
1640
1641 C<rearrange> and C<hangul_terminator> parameters are neglected.
1642 C<katakana_before_hiragana> and C<upper_before_lower> don't affect
1643 matching and searching, as it doesn't matter whether greater or lesser.
1644
1645 =over 4
1646
1647 =item C<$position = $Collator-E<gt>index($string, $substring[, $position])>
1648
1649 =item C<($position, $length) = $Collator-E<gt>index($string, $substring[, $position])>
1650
1651 If C<$substring> matches a part of C<$string>, returns
1652 the position of the first occurrence of the matching part in scalar context;
1653 in list context, returns a two-element list of
1654 the position and the length of the matching part.
1655
1656 If C<$substring> does not match any part of C<$string>,
1657 returns C<-1> in scalar context and
1658 an empty list in list context.
1659
1660 e.g. you say
1661
1662   my $Collator = Unicode::Collate->new( normalization => undef, level => 1 );
1663                                      # (normalization => undef) is REQUIRED.
1664   my $str = "Ich muß studieren Perl.";
1665   my $sub = "MÜSS";
1666   my $match;
1667   if (my($pos,$len) = $Collator->index($str, $sub)) {
1668       $match = substr($str, $pos, $len);
1669   }
1670
1671 and get C<"muß"> in C<$match> since C<"muß">
1672 is primary equal to C<"MÜSS">.
1673
1674 =item C<$match_ref = $Collator-E<gt>match($string, $substring)>
1675
1676 =item C<($match)   = $Collator-E<gt>match($string, $substring)>
1677
1678 If C<$substring> matches a part of C<$string>, in scalar context, returns
1679 B<a reference to> the first occurrence of the matching part
1680 (C<$match_ref> is always true if matches,
1681 since every reference is B<true>);
1682 in list context, returns the first occurrence of the matching part.
1683
1684 If C<$substring> does not match any part of C<$string>,
1685 returns C<undef> in scalar context and
1686 an empty list in list context.
1687
1688 e.g.
1689
1690     if ($match_ref = $Collator->match($str, $sub)) { # scalar context
1691         print "matches [$$match_ref].\n";
1692     } else {
1693         print "doesn't match.\n";
1694     }
1695
1696      or
1697
1698     if (($match) = $Collator->match($str, $sub)) { # list context
1699         print "matches [$match].\n";
1700     } else {
1701         print "doesn't match.\n";
1702     }
1703
1704 =item C<@match = $Collator-E<gt>gmatch($string, $substring)>
1705
1706 If C<$substring> matches a part of C<$string>, returns
1707 all the matching parts (or matching count in scalar context).
1708
1709 If C<$substring> does not match any part of C<$string>,
1710 returns an empty list.
1711
1712 =item C<$count = $Collator-E<gt>subst($string, $substring, $replacement)>
1713
1714 If C<$substring> matches a part of C<$string>,
1715 the first occurrence of the matching part is replaced by C<$replacement>
1716 (C<$string> is modified) and C<$count> (always equals to C<1>) is returned.
1717
1718 C<$replacement> can be a C<CODEREF>,
1719 taking the matching part as an argument,
1720 and returning a string to replace the matching part
1721 (a bit similar to C<s/(..)/$coderef-E<gt>($1)/e>).
1722
1723 =item C<$count = $Collator-E<gt>gsubst($string, $substring, $replacement)>
1724
1725 If C<$substring> matches a part of C<$string>,
1726 all the occurrences of the matching part are replaced by C<$replacement>
1727 (C<$string> is modified) and C<$count> is returned.
1728
1729 C<$replacement> can be a C<CODEREF>,
1730 taking the matching part as an argument,
1731 and returning a string to replace the matching part
1732 (a bit similar to C<s/(..)/$coderef-E<gt>($1)/eg>).
1733
1734 e.g.
1735
1736   my $Collator = Unicode::Collate->new( normalization => undef, level => 1 );
1737                                      # (normalization => undef) is REQUIRED.
1738   my $str = "Camel donkey zebra came\x{301}l CAMEL horse cam\0e\0l...";
1739   $Collator->gsubst($str, "camel", sub { "<b>$_[0]</b>" });
1740
1741   # now $str is "<b>Camel</b> donkey zebra <b>came\x{301}l</b> <b>CAMEL</b> horse <b>cam\0e\0l</b>...";
1742   # i.e., all the camels are made bold-faced.
1743
1744    Examples: levels and ignore_level2 - what does camel match?
1745   ---------------------------------------------------------------------------
1746    level  ignore_level2  |  camel  Camel  came\x{301}l  c-a-m-e-l  cam\0e\0l
1747   -----------------------|---------------------------------------------------
1748      1        false      |   yes    yes      yes          yes        yes
1749      2        false      |   yes    yes      no           yes        yes
1750      3        false      |   yes    no       no           yes        yes
1751      4        false      |   yes    no       no           no         yes
1752   -----------------------|---------------------------------------------------
1753      1        true       |   yes    yes      yes          yes        yes
1754      2        true       |   yes    yes      yes          yes        yes
1755      3        true       |   yes    no       yes          yes        yes
1756      4        true       |   yes    no       yes          no         yes
1757   ---------------------------------------------------------------------------
1758    note: if variable => non-ignorable, camel doesn't match c-a-m-e-l
1759          at any level.
1760
1761 =back
1762
1763 =head2 Other Methods
1764
1765 =over 4
1766
1767 =item C<%old_tailoring = $Collator-E<gt>change(%new_tailoring)>
1768
1769 =item C<$modified_collator = $Collator-E<gt>change(%new_tailoring)>
1770
1771 Changes the value of specified keys and returns the changed part.
1772
1773     $Collator = Unicode::Collate->new(level => 4);
1774
1775     $Collator->eq("perl", "PERL"); # false
1776
1777     %old = $Collator->change(level => 2); # returns (level => 4).
1778
1779     $Collator->eq("perl", "PERL"); # true
1780
1781     $Collator->change(%old); # returns (level => 2).
1782
1783     $Collator->eq("perl", "PERL"); # false
1784
1785 Not all C<(key,value)>s are allowed to be changed.
1786 See also C<@Unicode::Collate::ChangeOK> and C<@Unicode::Collate::ChangeNG>.
1787
1788 In the scalar context, returns the modified collator
1789 (but it is B<not> a clone from the original).
1790
1791     $Collator->change(level => 2)->eq("perl", "PERL"); # true
1792
1793     $Collator->eq("perl", "PERL"); # true; now max level is 2nd.
1794
1795     $Collator->change(level => 4)->eq("perl", "PERL"); # false
1796
1797 =item C<$version = $Collator-E<gt>version()>
1798
1799 Returns the version number (a string) of the Unicode Standard
1800 which the C<table> file used by the collator object is based on.
1801 If the table does not include a version line (starting with C<@version>),
1802 returns C<"unknown">.
1803
1804 =item C<UCA_Version()>
1805
1806 Returns the revision number of UTS #10 this module consults,
1807 that should correspond with the DUCET incorporated.
1808
1809 =item C<Base_Unicode_Version()>
1810
1811 Returns the version number of UTS #10 this module consults,
1812 that should correspond with the DUCET incorporated.
1813
1814 =back
1815
1816 =head1 EXPORT
1817
1818 No method will be exported.
1819
1820 =head1 INSTALL
1821
1822 Though this module can be used without any C<table> file,
1823 to use this module easily, it is recommended to install a table file
1824 in the UCA format, by copying it under the directory
1825 <a place in @INC>/Unicode/Collate.
1826
1827 The most preferable one is "The Default Unicode Collation Element Table"
1828 (aka DUCET), available from the Unicode Consortium's website:
1829
1830    http://www.unicode.org/Public/UCA/
1831
1832    http://www.unicode.org/Public/UCA/latest/allkeys.txt (latest version)
1833
1834 If DUCET is not installed, it is recommended to copy the file
1835 from http://www.unicode.org/Public/UCA/latest/allkeys.txt
1836 to <a place in @INC>/Unicode/Collate/allkeys.txt
1837 manually.
1838
1839 =head1 CAVEATS
1840
1841 =over 4
1842
1843 =item Normalization
1844
1845 Use of the C<normalization> parameter requires the B<Unicode::Normalize>
1846 module (see L<Unicode::Normalize>).
1847
1848 If you need not it (say, in the case when you need not
1849 handle any combining characters),
1850 assign C<normalization =E<gt> undef> explicitly.
1851
1852 -- see 6.5 Avoiding Normalization, UTS #10.
1853
1854 =item Conformance Test
1855
1856 The Conformance Test for the UCA is available
1857 under L<http://www.unicode.org/Public/UCA/>.
1858
1859 For F<CollationTest_SHIFTED.txt>,
1860 a collator via C<Unicode::Collate-E<gt>new( )> should be used;
1861 for F<CollationTest_NON_IGNORABLE.txt>, a collator via
1862 C<Unicode::Collate-E<gt>new(variable =E<gt> "non-ignorable", level =E<gt> 3)>.
1863
1864 B<Unicode::Normalize is required to try The Conformance Test.>
1865
1866 =back
1867
1868 =head1 AUTHOR, COPYRIGHT AND LICENSE
1869
1870 The Unicode::Collate module for perl was written by SADAHIRO Tomoyuki,
1871 <SADAHIRO@cpan.org>. This module is Copyright(C) 2001-2012,
1872 SADAHIRO Tomoyuki. Japan. All rights reserved.
1873
1874 This module is free software; you can redistribute it and/or
1875 modify it under the same terms as Perl itself.
1876
1877 The file Unicode/Collate/allkeys.txt was copied verbatim
1878 from L<http://www.unicode.org/Public/UCA/6.1.0/allkeys.txt>.
1879 For this file, Copyright (c) 2001-2011 Unicode, Inc.
1880 Distributed under the Terms of Use in L<http://www.unicode.org/copyright.html>.
1881
1882 =head1 SEE ALSO
1883
1884 =over 4
1885
1886 =item Unicode Collation Algorithm - UTS #10
1887
1888 L<http://www.unicode.org/reports/tr10/>
1889
1890 =item The Default Unicode Collation Element Table (DUCET)
1891
1892 L<http://www.unicode.org/Public/UCA/latest/allkeys.txt>
1893
1894 =item The conformance test for the UCA
1895
1896 L<http://www.unicode.org/Public/UCA/latest/CollationTest.html>
1897
1898 L<http://www.unicode.org/Public/UCA/latest/CollationTest.zip>
1899
1900 =item Hangul Syllable Type
1901
1902 L<http://www.unicode.org/Public/UNIDATA/HangulSyllableType.txt>
1903
1904 =item Unicode Normalization Forms - UAX #15
1905
1906 L<http://www.unicode.org/reports/tr15/>
1907
1908 =item Unicode Locale Data Markup Language (LDML) - UTS #35
1909
1910 L<http://www.unicode.org/reports/tr35/>
1911
1912 =back
1913
1914 =cut