This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update Unicode-Collate to CPAN version 0.67
[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.67';
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, forwards at all the levels.
1354
1355 =item entry
1356
1357 -- see 3.1 Linguistic Features; 3.2.1 File Format, UTS #10.
1358
1359 If the same character (or a sequence of characters) exists
1360 in the collation element table through C<table>,
1361 mapping to collation elements is overrided.
1362 If it does not exist, the mapping is defined additionally.
1363
1364     entry => <<'ENTRY', # for DUCET v4.0.0 (allkeys-4.0.0.txt)
1365 0063 0068 ; [.0E6A.0020.0002.0063] # ch
1366 0043 0068 ; [.0E6A.0020.0007.0043] # Ch
1367 0043 0048 ; [.0E6A.0020.0008.0043] # CH
1368 006C 006C ; [.0F4C.0020.0002.006C] # ll
1369 004C 006C ; [.0F4C.0020.0007.004C] # Ll
1370 004C 004C ; [.0F4C.0020.0008.004C] # LL
1371 00F1      ; [.0F7B.0020.0002.00F1] # n-tilde
1372 006E 0303 ; [.0F7B.0020.0002.00F1] # n-tilde
1373 00D1      ; [.0F7B.0020.0008.00D1] # N-tilde
1374 004E 0303 ; [.0F7B.0020.0008.00D1] # N-tilde
1375 ENTRY
1376
1377     entry => <<'ENTRY', # for DUCET v4.0.0 (allkeys-4.0.0.txt)
1378 00E6 ; [.0E33.0020.0002.00E6][.0E8B.0020.0002.00E6] # ae ligature as <a><e>
1379 00C6 ; [.0E33.0020.0008.00C6][.0E8B.0020.0008.00C6] # AE ligature as <A><E>
1380 ENTRY
1381
1382 B<NOTE:> The code point in the UCA file format (before C<';'>)
1383 B<must> be a Unicode code point (defined as hexadecimal),
1384 but not a native code point.
1385 So C<0063> must always denote C<U+0063>,
1386 but not a character of C<"\x63">.
1387
1388 Weighting may vary depending on collation element table.
1389 So ensure the weights defined in C<entry> will be consistent with
1390 those in the collation element table loaded via C<table>.
1391
1392 In DUCET v4.0.0, primary weight of C<C> is C<0E60>
1393 and that of C<D> is C<0E6D>. So setting primary weight of C<CH> to C<0E6A>
1394 (as a value between C<0E60> and C<0E6D>)
1395 makes ordering as C<C E<lt> CH E<lt> D>.
1396 Exactly speaking DUCET already has some characters between C<C> and C<D>:
1397 C<small capital C> (C<U+1D04>) with primary weight C<0E64>,
1398 C<c-hook/C-hook> (C<U+0188/U+0187>) with C<0E65>,
1399 and C<c-curl> (C<U+0255>) with C<0E69>.
1400 Then primary weight C<0E6A> for C<CH> makes C<CH>
1401 ordered between C<c-curl> and C<D>.
1402
1403 =item hangul_terminator
1404
1405 -- see 7.1.4 Trailing Weights, UTS #10.
1406
1407 If a true value is given (non-zero but should be positive),
1408 it will be added as a terminator primary weight to the end of
1409 every standard Hangul syllable. Secondary and any higher weights
1410 for terminator are set to zero.
1411 If the value is false or C<hangul_terminator> key does not exist,
1412 insertion of terminator weights will not be performed.
1413
1414 Boundaries of Hangul syllables are determined
1415 according to conjoining Jamo behavior in F<the Unicode Standard>
1416 and F<HangulSyllableType.txt>.
1417
1418 B<Implementation Note:>
1419 (1) For expansion mapping (Unicode character mapped
1420 to a sequence of collation elements), a terminator will not be added
1421 between collation elements, even if Hangul syllable boundary exists there.
1422 Addition of terminator is restricted to the next position
1423 to the last collation element.
1424
1425 (2) Non-conjoining Hangul letters
1426 (Compatibility Jamo, halfwidth Jamo, and enclosed letters) are not
1427 automatically terminated with a terminator primary weight.
1428 These characters may need terminator included in a collation element
1429 table beforehand.
1430
1431 =item ignoreChar
1432
1433 =item ignoreName
1434
1435 -- see 3.2.2 Variable Weighting, UTS #10.
1436
1437 Makes the entry in the table completely ignorable;
1438 i.e. as if the weights were zero at all level.
1439
1440 Through C<ignoreChar>, any character matching C<qr/$ignoreChar/>
1441 will be ignored. Through C<ignoreName>, any character whose name
1442 (given in the C<table> file as a comment) matches C<qr/$ignoreName/>
1443 will be ignored.
1444
1445 E.g. when 'a' and 'e' are ignorable,
1446 'element' is equal to 'lament' (or 'lmnt').
1447
1448 =item katakana_before_hiragana
1449
1450 -- see 7.3.1 Tertiary Weight Table, UTS #10.
1451
1452 By default, hiragana is before katakana.
1453 If the parameter is made true, this is reversed.
1454
1455 B<NOTE>: This parameter simplemindedly assumes that any hiragana/katakana
1456 distinctions must occur in level 3, and their weights at level 3 must be
1457 same as those mentioned in 7.3.1, UTS #10.
1458 If you define your collation elements which violate this requirement,
1459 this parameter does not work validly.
1460
1461 =item level
1462
1463 -- see 4.3 Form Sort Key, UTS #10.
1464
1465 Set the maximum level.
1466 Any higher levels than the specified one are ignored.
1467
1468   Level 1: alphabetic ordering
1469   Level 2: diacritic ordering
1470   Level 3: case ordering
1471   Level 4: tie-breaking (e.g. in the case when variable is 'shifted')
1472
1473   ex.level => 2,
1474
1475 If omitted, the maximum is the 4th.
1476
1477 =item normalization
1478
1479 -- see 4.1 Normalize, UTS #10.
1480
1481 If specified, strings are normalized before preparation of sort keys
1482 (the normalization is executed after preprocess).
1483
1484 A form name C<Unicode::Normalize::normalize()> accepts will be applied
1485 as C<$normalization_form>.
1486 Acceptable names include C<'NFD'>, C<'NFC'>, C<'NFKD'>, and C<'NFKC'>.
1487 See C<Unicode::Normalize::normalize()> for detail.
1488 If omitted, C<'NFD'> is used.
1489
1490 C<normalization> is performed after C<preprocess> (if defined).
1491
1492 Furthermore, special values, C<undef> and C<"prenormalized">, can be used,
1493 though they are not concerned with C<Unicode::Normalize::normalize()>.
1494
1495 If C<undef> (not a string C<"undef">) is passed explicitly
1496 as the value for this key,
1497 any normalization is not carried out (this may make tailoring easier
1498 if any normalization is not desired). Under C<(normalization =E<gt> undef)>,
1499 only contiguous contractions are resolved;
1500 e.g. even if C<A-ring> (and C<A-ring-cedilla>) is ordered after C<Z>,
1501 C<A-cedilla-ring> would be primary equal to C<A>.
1502 In this point,
1503 C<(normalization =E<gt> undef, preprocess =E<gt> sub { NFD(shift) })>
1504 B<is not> equivalent to C<(normalization =E<gt> 'NFD')>.
1505
1506 In the case of C<(normalization =E<gt> "prenormalized")>,
1507 any normalization is not performed, but
1508 discontiguous contractions with combining characters are performed.
1509 Therefore
1510 C<(normalization =E<gt> 'prenormalized', preprocess =E<gt> sub { NFD(shift) })>
1511 B<is> equivalent to C<(normalization =E<gt> 'NFD')>.
1512 If source strings are finely prenormalized,
1513 C<(normalization =E<gt> 'prenormalized')> may save time for normalization.
1514
1515 Except C<(normalization =E<gt> undef)>,
1516 B<Unicode::Normalize> is required (see also B<CAVEAT>).
1517
1518 =item overrideCJK
1519
1520 -- see 7.1 Derived Collation Elements, UTS #10.
1521
1522 By default, CJK unified ideographs are ordered in Unicode codepoint
1523 order, but those in the CJK Unified Ideographs block are lesser than
1524 those in the CJK Unified Ideographs Extension A etc.
1525
1526     In the CJK Unified Ideographs block:
1527     U+4E00..U+9FA5 if UCA_Version is 8 to 11.
1528     U+4E00..U+9FBB if UCA_Version is 14 to 16.
1529     U+4E00..U+9FC3 if UCA_Version is 18.
1530     U+4E00..U+9FCB if UCA_Version is 20 or greater.
1531
1532     In the CJK Unified Ideographs Extension blocks:
1533     Ext.A (U+3400..U+4DB5) and Ext.B (U+20000..U+2A6D6) in any UCA_Version.
1534     Ext.C (U+2A700..U+2B734) if UCA_Version is 20 or greater.
1535     Ext.D (U+2B740..U+2B81D) if UCA_Version is 22 or greater.
1536
1537 Through C<overrideCJK>, ordering of CJK unified ideographs (including
1538 extensions) can be overrided.
1539
1540 ex. CJK unified ideographs in the JIS code point order.
1541
1542   overrideCJK => sub {
1543       my $u = shift;             # get a Unicode codepoint
1544       my $b = pack('n', $u);     # to UTF-16BE
1545       my $s = your_unicode_to_sjis_converter($b); # convert
1546       my $n = unpack('n', $s);   # convert sjis to short
1547       [ $n, 0x20, 0x2, $u ];     # return the collation element
1548   },
1549
1550 The return value may be an arrayref of 1st to 4th weights as shown
1551 above. The return value may be an integer as the primary weight
1552 as shown below.  If C<undef> is returned, the default derived
1553 collation element will be used.
1554
1555   overrideCJK => sub {
1556       my $u = shift;             # get a Unicode codepoint
1557       my $b = pack('n', $u);     # to UTF-16BE
1558       my $s = your_unicode_to_sjis_converter($b); # convert
1559       my $n = unpack('n', $s);   # convert sjis to short
1560       return $n;                 # return the primary weight
1561   },
1562
1563 The return value may be a list containing zero or more of
1564 an arrayref, an integer, or C<undef>.
1565
1566 ex. ignores all CJK unified ideographs.
1567
1568   overrideCJK => sub {()}, # CODEREF returning empty list
1569
1570    # where ->eq("Pe\x{4E00}rl", "Perl") is true
1571    # as U+4E00 is a CJK unified ideograph and to be ignorable.
1572
1573 If C<undef> is passed explicitly as the value for this key,
1574 weights for CJK unified ideographs are treated as undefined.
1575 But assignment of weight for CJK unified ideographs
1576 in C<table> or C<entry> is still valid.
1577
1578 B<Note:> In addition to them, 12 CJK compatibility ideographs (C<U+FA0E>,
1579 C<U+FA0F>, C<U+FA11>, C<U+FA13>, C<U+FA14>, C<U+FA1F>, C<U+FA21>, C<U+FA23>,
1580 C<U+FA24>, C<U+FA27>, C<U+FA28>, C<U+FA29>) are also treated as CJK unified
1581 ideographs. But they can't be overrided via C<overrideCJK> when you use
1582 DUCET, as the table includes weights for them. C<table> or C<entry> has
1583 priority over C<overrideCJK>.
1584
1585 =item overrideHangul
1586
1587 -- see 7.1 Derived Collation Elements, UTS #10.
1588
1589 By default, Hangul syllables are decomposed into Hangul Jamo,
1590 even if C<(normalization =E<gt> undef)>.
1591 But the mapping of Hangul syllables may be overrided.
1592
1593 This parameter works like C<overrideCJK>, so see there for examples.
1594
1595 If you want to override the mapping of Hangul syllables,
1596 NFD and NFKD are not appropriate, since NFD and NFKD will decompose
1597 Hangul syllables before overriding. FCD may decompose Hangul syllables
1598 as the case may be.
1599
1600 If C<undef> is passed explicitly as the value for this key,
1601 weight for Hangul syllables is treated as undefined
1602 without decomposition into Hangul Jamo.
1603 But definition of weight for Hangul syllables
1604 in C<table> or C<entry> is still valid.
1605
1606 =item preprocess
1607
1608 -- see 5.1 Preprocessing, UTS #10.
1609
1610 If specified, the coderef is used to preprocess
1611 before the formation of sort keys.
1612
1613 ex. dropping English articles, such as "a" or "the".
1614 Then, "the pen" is before "a pencil".
1615
1616      preprocess => sub {
1617            my $str = shift;
1618            $str =~ s/\b(?:an?|the)\s+//gi;
1619            return $str;
1620         },
1621
1622 C<preprocess> is performed before C<normalization> (if defined).
1623
1624 ex. decoding strings in a legacy encoding such as shift-jis:
1625
1626     $sjis_collator = Unicode::Collate->new(
1627         preprocess => \&your_shiftjis_to_unicode_decoder,
1628     );
1629     @result = $sjis_collator->sort(@shiftjis_strings);
1630
1631 B<Note:> Strings returned from the coderef will be interpreted
1632 according to Perl's Unicode support. See L<perlunicode>,
1633 L<perluniintro>, L<perlunitut>, L<perlunifaq>, L<utf8>.
1634
1635 =item rearrange
1636
1637 -- see 3.1.3 Rearrangement, UTS #10.
1638
1639 Characters that are not coded in logical order and to be rearranged.
1640 If C<UCA_Version> is equal to or lesser than 11, default is:
1641
1642     rearrange => [ 0x0E40..0x0E44, 0x0EC0..0x0EC4 ],
1643
1644 If you want to disallow any rearrangement, pass C<undef> or C<[]>
1645 (a reference to empty list) as the value for this key.
1646
1647 If C<UCA_Version> is equal to or greater than 14, default is C<[]>
1648 (i.e. no rearrangement).
1649
1650 B<According to the version 9 of UCA, this parameter shall not be used;
1651 but it is not warned at present.>
1652
1653 =item suppress
1654
1655 -- see suppress contractions in 5.14.11 Special-Purpose Commands,
1656 UTS #35 (LDML).
1657
1658 Contractions beginning with the specified characters are suppressed,
1659 even if those contractions are defined in C<table> or C<entry>.
1660
1661 An example for Russian and some languages using the Cyrillic script:
1662
1663     suppress => [0x0400..0x0417, 0x041A..0x0437, 0x043A..0x045F],
1664
1665 where 0x0400 stands for C<U+0400>, CYRILLIC CAPITAL LETTER IE WITH GRAVE.
1666
1667 =item table
1668
1669 -- see 3.2 Default Unicode Collation Element Table, UTS #10.
1670
1671 You can use another collation element table if desired.
1672
1673 The table file should locate in the F<Unicode/Collate> directory
1674 on C<@INC>. Say, if the filename is F<Foo.txt>,
1675 the table file is searched as F<Unicode/Collate/Foo.txt> in C<@INC>.
1676
1677 By default, F<allkeys.txt> (as the filename of DUCET) is used.
1678 If you will prepare your own table file, any name other than F<allkeys.txt>
1679 may be better to avoid namespace conflict.
1680
1681 B<NOTE>: When XSUB is used, the DUCET is compiled on building this
1682 module, and it may save time at the run time.
1683 Explicit saying C<table =E<gt> 'allkeys.txt'> (or using another table),
1684 or using C<ignoreChar>, C<ignoreName>, C<undefChar>, or C<undefName>
1685 will prevent this module from using the compiled DUCET.
1686
1687 If C<undef> is passed explicitly as the value for this key,
1688 no file is read (but you can define collation elements via C<entry>).
1689
1690 A typical way to define a collation element table
1691 without any file of table:
1692
1693    $onlyABC = Unicode::Collate->new(
1694        table => undef,
1695        entry => << 'ENTRIES',
1696 0061 ; [.0101.0020.0002.0061] # LATIN SMALL LETTER A
1697 0041 ; [.0101.0020.0008.0041] # LATIN CAPITAL LETTER A
1698 0062 ; [.0102.0020.0002.0062] # LATIN SMALL LETTER B
1699 0042 ; [.0102.0020.0008.0042] # LATIN CAPITAL LETTER B
1700 0063 ; [.0103.0020.0002.0063] # LATIN SMALL LETTER C
1701 0043 ; [.0103.0020.0008.0043] # LATIN CAPITAL LETTER C
1702 ENTRIES
1703     );
1704
1705 If C<ignoreName> or C<undefName> is used, character names should be
1706 specified as a comment (following C<#>) on each line.
1707
1708 =item undefChar
1709
1710 =item undefName
1711
1712 -- see 6.3.4 Reducing the Repertoire, UTS #10.
1713
1714 Undefines the collation element as if it were unassigned in the C<table>.
1715 This reduces the size of the table.
1716 If an unassigned character appears in the string to be collated,
1717 the sort key is made from its codepoint
1718 as a single-character collation element,
1719 as it is greater than any other assigned collation elements
1720 (in the codepoint order among the unassigned characters).
1721 But, it'd be better to ignore characters
1722 unfamiliar to you and maybe never used.
1723
1724 Through C<undefChar>, any character matching C<qr/$undefChar/>
1725 will be undefined. Through C<undefName>, any character whose name
1726 (given in the C<table> file as a comment) matches C<qr/$undefName/>
1727 will be undefined.
1728
1729 ex. Collation weights for beyond-BMP characters are not stored in object:
1730
1731     undefChar => qr/[^\0-\x{fffd}]/,
1732
1733 =item upper_before_lower
1734
1735 -- see 6.6 Case Comparisons, UTS #10.
1736
1737 By default, lowercase is before uppercase.
1738 If the parameter is made true, this is reversed.
1739
1740 B<NOTE>: This parameter simplemindedly assumes that any lowercase/uppercase
1741 distinctions must occur in level 3, and their weights at level 3 must be
1742 same as those mentioned in 7.3.1, UTS #10.
1743 If you define your collation elements which differs from this requirement,
1744 this parameter doesn't work validly.
1745
1746 =item variable
1747
1748 -- see 3.2.2 Variable Weighting, UTS #10.
1749
1750 This key allows to variable weighting for variable collation elements,
1751 which are marked with an ASTERISK in the table
1752 (NOTE: Many punction marks and symbols are variable in F<allkeys.txt>).
1753
1754    variable => 'blanked', 'non-ignorable', 'shifted', or 'shift-trimmed'.
1755
1756 These names are case-insensitive.
1757 By default (if specification is omitted), 'shifted' is adopted.
1758
1759    'Blanked'        Variable elements are made ignorable at levels 1 through 3;
1760                     considered at the 4th level.
1761
1762    'Non-Ignorable'  Variable elements are not reset to ignorable.
1763
1764    'Shifted'        Variable elements are made ignorable at levels 1 through 3
1765                     their level 4 weight is replaced by the old level 1 weight.
1766                     Level 4 weight for Non-Variable elements is 0xFFFF.
1767
1768    'Shift-Trimmed'  Same as 'shifted', but all FFFF's at the 4th level
1769                     are trimmed.
1770
1771 =back
1772
1773 =head2 Methods for Collation
1774
1775 =over 4
1776
1777 =item C<@sorted = $Collator-E<gt>sort(@not_sorted)>
1778
1779 Sorts a list of strings.
1780
1781 =item C<$result = $Collator-E<gt>cmp($a, $b)>
1782
1783 Returns 1 (when C<$a> is greater than C<$b>)
1784 or 0 (when C<$a> is equal to C<$b>)
1785 or -1 (when C<$a> is lesser than C<$b>).
1786
1787 =item C<$result = $Collator-E<gt>eq($a, $b)>
1788
1789 =item C<$result = $Collator-E<gt>ne($a, $b)>
1790
1791 =item C<$result = $Collator-E<gt>lt($a, $b)>
1792
1793 =item C<$result = $Collator-E<gt>le($a, $b)>
1794
1795 =item C<$result = $Collator-E<gt>gt($a, $b)>
1796
1797 =item C<$result = $Collator-E<gt>ge($a, $b)>
1798
1799 They works like the same name operators as theirs.
1800
1801    eq : whether $a is equal to $b.
1802    ne : whether $a is not equal to $b.
1803    lt : whether $a is lesser than $b.
1804    le : whether $a is lesser than $b or equal to $b.
1805    gt : whether $a is greater than $b.
1806    ge : whether $a is greater than $b or equal to $b.
1807
1808 =item C<$sortKey = $Collator-E<gt>getSortKey($string)>
1809
1810 -- see 4.3 Form Sort Key, UTS #10.
1811
1812 Returns a sort key.
1813
1814 You compare the sort keys using a binary comparison
1815 and get the result of the comparison of the strings using UCA.
1816
1817    $Collator->getSortKey($a) cmp $Collator->getSortKey($b)
1818
1819       is equivalent to
1820
1821    $Collator->cmp($a, $b)
1822
1823 =item C<$sortKeyForm = $Collator-E<gt>viewSortKey($string)>
1824
1825 Converts a sorting key into its representation form.
1826 If C<UCA_Version> is 8, the output is slightly different.
1827
1828    use Unicode::Collate;
1829    my $c = Unicode::Collate->new();
1830    print $c->viewSortKey("Perl"),"\n";
1831
1832    # output:
1833    # [0B67 0A65 0B7F 0B03 | 0020 0020 0020 0020 | 0008 0002 0002 0002 | FFFF FFFF FFFF FFFF]
1834    #  Level 1               Level 2               Level 3               Level 4
1835
1836 =back
1837
1838 =head2 Methods for Searching
1839
1840 B<DISCLAIMER:> If C<preprocess> or C<normalization> parameter is true
1841 for C<$Collator>, calling these methods (C<index>, C<match>, C<gmatch>,
1842 C<subst>, C<gsubst>) is croaked,
1843 as the position and the length might differ
1844 from those on the specified string.
1845 (And C<rearrange> and C<hangul_terminator> parameters are neglected.)
1846
1847 The C<match>, C<gmatch>, C<subst>, C<gsubst> methods work
1848 like C<m//>, C<m//g>, C<s///>, C<s///g>, respectively,
1849 but they are not aware of any pattern, but only a literal substring.
1850
1851 =over 4
1852
1853 =item C<$position = $Collator-E<gt>index($string, $substring[, $position])>
1854
1855 =item C<($position, $length) = $Collator-E<gt>index($string, $substring[, $position])>
1856
1857 If C<$substring> matches a part of C<$string>, returns
1858 the position of the first occurrence of the matching part in scalar context;
1859 in list context, returns a two-element list of
1860 the position and the length of the matching part.
1861
1862 If C<$substring> does not match any part of C<$string>,
1863 returns C<-1> in scalar context and
1864 an empty list in list context.
1865
1866 e.g. you say
1867
1868   my $Collator = Unicode::Collate->new( normalization => undef, level => 1 );
1869                                      # (normalization => undef) is REQUIRED.
1870   my $str = "Ich muß studieren Perl.";
1871   my $sub = "MÜSS";
1872   my $match;
1873   if (my($pos,$len) = $Collator->index($str, $sub)) {
1874       $match = substr($str, $pos, $len);
1875   }
1876
1877 and get C<"muß"> in C<$match> since C<"muß">
1878 is primary equal to C<"MÜSS">.
1879
1880 =item C<$match_ref = $Collator-E<gt>match($string, $substring)>
1881
1882 =item C<($match)   = $Collator-E<gt>match($string, $substring)>
1883
1884 If C<$substring> matches a part of C<$string>, in scalar context, returns
1885 B<a reference to> the first occurrence of the matching part
1886 (C<$match_ref> is always true if matches,
1887 since every reference is B<true>);
1888 in list context, returns the first occurrence of the matching part.
1889
1890 If C<$substring> does not match any part of C<$string>,
1891 returns C<undef> in scalar context and
1892 an empty list in list context.
1893
1894 e.g.
1895
1896     if ($match_ref = $Collator->match($str, $sub)) { # scalar context
1897         print "matches [$$match_ref].\n";
1898     } else {
1899         print "doesn't match.\n";
1900     }
1901
1902      or
1903
1904     if (($match) = $Collator->match($str, $sub)) { # list context
1905         print "matches [$match].\n";
1906     } else {
1907         print "doesn't match.\n";
1908     }
1909
1910 =item C<@match = $Collator-E<gt>gmatch($string, $substring)>
1911
1912 If C<$substring> matches a part of C<$string>, returns
1913 all the matching parts (or matching count in scalar context).
1914
1915 If C<$substring> does not match any part of C<$string>,
1916 returns an empty list.
1917
1918 =item C<$count = $Collator-E<gt>subst($string, $substring, $replacement)>
1919
1920 If C<$substring> matches a part of C<$string>,
1921 the first occurrence of the matching part is replaced by C<$replacement>
1922 (C<$string> is modified) and return C<$count> (always equals to C<1>).
1923
1924 C<$replacement> can be a C<CODEREF>,
1925 taking the matching part as an argument,
1926 and returning a string to replace the matching part
1927 (a bit similar to C<s/(..)/$coderef-E<gt>($1)/e>).
1928
1929 =item C<$count = $Collator-E<gt>gsubst($string, $substring, $replacement)>
1930
1931 If C<$substring> matches a part of C<$string>,
1932 all the occurrences of the matching part is replaced by C<$replacement>
1933 (C<$string> is modified) and return C<$count>.
1934
1935 C<$replacement> can be a C<CODEREF>,
1936 taking the matching part as an argument,
1937 and returning a string to replace the matching part
1938 (a bit similar to C<s/(..)/$coderef-E<gt>($1)/eg>).
1939
1940 e.g.
1941
1942   my $Collator = Unicode::Collate->new( normalization => undef, level => 1 );
1943                                      # (normalization => undef) is REQUIRED.
1944   my $str = "Camel donkey zebra came\x{301}l CAMEL horse cAm\0E\0L...";
1945   $Collator->gsubst($str, "camel", sub { "<b>$_[0]</b>" });
1946
1947   # now $str is "<b>Camel</b> donkey zebra <b>came\x{301}l</b> <b>CAMEL</b> horse <b>cAm\0E\0L</b>...";
1948   # i.e., all the camels are made bold-faced.
1949
1950 =back
1951
1952 =head2 Other Methods
1953
1954 =over 4
1955
1956 =item C<%old_tailoring = $Collator-E<gt>change(%new_tailoring)>
1957
1958 Change the value of specified keys and returns the changed part.
1959
1960     $Collator = Unicode::Collate->new(level => 4);
1961
1962     $Collator->eq("perl", "PERL"); # false
1963
1964     %old = $Collator->change(level => 2); # returns (level => 4).
1965
1966     $Collator->eq("perl", "PERL"); # true
1967
1968     $Collator->change(%old); # returns (level => 2).
1969
1970     $Collator->eq("perl", "PERL"); # false
1971
1972 Not all C<(key,value)>s are allowed to be changed.
1973 See also C<@Unicode::Collate::ChangeOK> and C<@Unicode::Collate::ChangeNG>.
1974
1975 In the scalar context, returns the modified collator
1976 (but it is B<not> a clone from the original).
1977
1978     $Collator->change(level => 2)->eq("perl", "PERL"); # true
1979
1980     $Collator->eq("perl", "PERL"); # true; now max level is 2nd.
1981
1982     $Collator->change(level => 4)->eq("perl", "PERL"); # false
1983
1984 =item C<$version = $Collator-E<gt>version()>
1985
1986 Returns the version number (a string) of the Unicode Standard
1987 which the C<table> file used by the collator object is based on.
1988 If the table does not include a version line (starting with C<@version>),
1989 returns C<"unknown">.
1990
1991 =item C<UCA_Version()>
1992
1993 Returns the tracking version number of UTS #10 this module consults.
1994 C<UCA_Version()> should return the tracking version corresponding
1995 with the DUCET incorporated.
1996
1997 =item C<Base_Unicode_Version()>
1998
1999 Returns the version number of UTS #10 this module consults.
2000
2001 =back
2002
2003 =head1 EXPORT
2004
2005 No method will be exported.
2006
2007 =head1 INSTALL
2008
2009 Though this module can be used without any C<table> file,
2010 to use this module easily, it is recommended to install a table file
2011 in the UCA format, by copying it under the directory
2012 <a place in @INC>/Unicode/Collate.
2013
2014 The most preferable one is "The Default Unicode Collation Element Table"
2015 (aka DUCET), available from the Unicode Consortium's website:
2016
2017    http://www.unicode.org/Public/UCA/
2018
2019    http://www.unicode.org/Public/UCA/latest/allkeys.txt (latest version)
2020
2021 If DUCET is not installed, it is recommended to copy the file
2022 from http://www.unicode.org/Public/UCA/latest/allkeys.txt
2023 to <a place in @INC>/Unicode/Collate/allkeys.txt
2024 manually.
2025
2026 =head1 CAVEATS
2027
2028 =over 4
2029
2030 =item Normalization
2031
2032 Use of the C<normalization> parameter requires the B<Unicode::Normalize>
2033 module (see L<Unicode::Normalize>).
2034
2035 If you need not it (say, in the case when you need not
2036 handle any combining characters),
2037 assign C<normalization =E<gt> undef> explicitly.
2038
2039 -- see 6.5 Avoiding Normalization, UTS #10.
2040
2041 =item Conformance Test
2042
2043 The Conformance Test for the UCA is available
2044 under L<http://www.unicode.org/Public/UCA/>.
2045
2046 For F<CollationTest_SHIFTED.txt>,
2047 a collator via C<Unicode::Collate-E<gt>new( )> should be used;
2048 for F<CollationTest_NON_IGNORABLE.txt>, a collator via
2049 C<Unicode::Collate-E<gt>new(variable =E<gt> "non-ignorable", level =E<gt> 3)>.
2050
2051 B<Unicode::Normalize is required to try The Conformance Test.>
2052
2053 =back
2054
2055 =head1 AUTHOR, COPYRIGHT AND LICENSE
2056
2057 The Unicode::Collate module for perl was written by SADAHIRO Tomoyuki,
2058 <SADAHIRO@cpan.org>. This module is Copyright(C) 2001-2010,
2059 SADAHIRO Tomoyuki. Japan. All rights reserved.
2060
2061 This module is free software; you can redistribute it and/or
2062 modify it under the same terms as Perl itself.
2063
2064 The file Unicode/Collate/allkeys.txt was copied verbatim
2065 from L<http://www.unicode.org/Public/UCA/5.2.0/allkeys.txt>.
2066 This file is Copyright (c) 1991-2009 Unicode, Inc. All rights reserved.
2067 Distributed under the Terms of Use in L<http://www.unicode.org/copyright.html>.
2068
2069 =head1 SEE ALSO
2070
2071 =over 4
2072
2073 =item Unicode Collation Algorithm - UTS #10
2074
2075 L<http://www.unicode.org/reports/tr10/>
2076
2077 =item The Default Unicode Collation Element Table (DUCET)
2078
2079 L<http://www.unicode.org/Public/UCA/latest/allkeys.txt>
2080
2081 =item The conformance test for the UCA
2082
2083 L<http://www.unicode.org/Public/UCA/latest/CollationTest.html>
2084
2085 L<http://www.unicode.org/Public/UCA/latest/CollationTest.zip>
2086
2087 =item Hangul Syllable Type
2088
2089 L<http://www.unicode.org/Public/UNIDATA/HangulSyllableType.txt>
2090
2091 =item Unicode Normalization Forms - UAX #15
2092
2093 L<http://www.unicode.org/reports/tr15/>
2094
2095 =item Unicode Locale Data Markup Language (LDML) - UTS #35
2096
2097 L<http://www.unicode.org/reports/tr35/>
2098
2099 =back
2100
2101 =cut