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