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