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