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