diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Unicode/Collate.pm')
| -rw-r--r-- | Master/tlpkg/tlperl/lib/Unicode/Collate.pm | 179 |
1 files changed, 124 insertions, 55 deletions
diff --git a/Master/tlpkg/tlperl/lib/Unicode/Collate.pm b/Master/tlpkg/tlperl/lib/Unicode/Collate.pm index 4a1c837ab6e..0fd29517265 100644 --- a/Master/tlpkg/tlperl/lib/Unicode/Collate.pm +++ b/Master/tlpkg/tlperl/lib/Unicode/Collate.pm @@ -4,6 +4,9 @@ BEGIN { unless ("A" eq pack('U', 0x41)) { die "Unicode::Collate cannot stringify a Unicode code point\n"; } + unless (0x41 == unpack('U', 'A')) { + die "Unicode::Collate cannot get a Unicode code point\n"; + } } use 5.006; @@ -14,7 +17,7 @@ use File::Spec; no warnings 'utf8'; -our $VERSION = '0.97'; +our $VERSION = '1.04'; our $PACKAGE = __PACKAGE__; ### begin XS only ### @@ -86,9 +89,9 @@ my $DefaultRearrange = [ 0x0E40..0x0E44, 0x0EC0..0x0EC4 ]; my $HighestVCE = pack(VCE_TEMPLATE, 0, 0xFFFE, 0x20, 0x5, 0xFFFF); my $minimalVCE = pack(VCE_TEMPLATE, 0, 1, 0x20, 0x5, 0xFFFE); -sub UCA_Version { "26" } +sub UCA_Version { "28" } -sub Base_Unicode_Version { "6.2.0" } +sub Base_Unicode_Version { "6.3.0" } ###### @@ -96,6 +99,12 @@ sub pack_U { return pack('U*', @_); } +### begin XS only ### +*unpack_U = exists &Unicode::Collate::bootstrap && + $] < 5.008 && \&unpackUfor56 && 0x41 == unpackUfor56('A') + ? \&unpackUfor56 : sub { return unpack('U*', shift(@_).pack('U*')) }; +### end XS only ### + ###### my (%VariableOK); @@ -106,7 +115,7 @@ my (%VariableOK); our @ChangeOK = qw/ alternate backwards level normalization rearrange katakana_before_hiragana upper_before_lower ignore_level2 - overrideHangul overrideCJK preprocess UCA_Version + overrideCJK overrideHangul overrideOut preprocess UCA_Version hangul_terminator variable identical highestFFFF minimalFFFE /; @@ -118,11 +127,11 @@ our @ChangeNG = qw/ derivCode normCode rearrangeHash backwardsFlag suppress suppressHash __useXS /; ### XS only -# The hash key 'ignored' is deleted at v 0.21. -# The hash key 'isShift' is deleted at v 0.23. -# The hash key 'combining' is deleted at v 0.24. -# The hash key 'entries' is deleted at v 0.30. -# The hash key 'L3_ignorable' is deleted at v 0.40. +# The hash key 'ignored' was deleted at v 0.21. +# The hash key 'isShift' was deleted at v 0.23. +# The hash key 'combining' was deleted at v 0.24. +# The hash key 'entries' was deleted at v 0.30. +# The hash key 'L3_ignorable' was deleted at v 0.40. sub version { my $self = shift; @@ -179,6 +188,7 @@ my %DerivCode = ( 22 => \&_derivCE_22, 24 => \&_derivCE_24, 26 => \&_derivCE_24, # 26 == 24 + 28 => \&_derivCE_24, # 28 == 24 ); sub checkCollator { @@ -311,7 +321,7 @@ sub parseAtmark { elsif ($line =~ /^backwards\s+(\S*)/) { push @{ $self->{backwardsTable} }, $1; } - elsif ($line =~ /^forwards\s+(\S*)/) { # parhaps no use + elsif ($line =~ /^forwards\s+(\S*)/) { # perhaps no use push @{ $self->{forwardsTable} }, $1; } elsif ($line =~ /^rearrange\s+(.*)/) { # (\S*) is NG @@ -397,7 +407,7 @@ sub parseEntry if (defined $self->{undefChar} || defined $self->{ignoreChar}) { my $ele = pack_U(@uv); - # regarded as if it were not entried in the table + # regarded as if it were not stored in the table return if defined $self->{undefChar} && $ele =~ /$self->{undefChar}/; @@ -497,7 +507,7 @@ sub splitEnt # remove a code point marked as a completely ignorable. for (my $i = 0; $i < @src; $i++) { - if (_isIllegal($src[$i]) || $vers <= 20 && _isNonchar($src[$i])) { + if ($vers <= 20 && _isIllegal($src[$i])) { $src[$i] = undef; } elsif ($ver9) { $src[$i] = undef if $map->{ $src[$i] } @@ -608,6 +618,7 @@ sub _pack_override ($$$) { } elsif (defined $r) { return pack(VCE_TEMPLATE, NON_VAR, $r, Min2Wt, Min3Wt, $u); } else { + $u = 0xFFFD if 0x10FFFF < $u; return $der->($u); } } @@ -621,25 +632,27 @@ sub getWt my $u = shift; my $map = $self->{mapping}; my $der = $self->{derivCode}; + my $out = $self->{overrideOut}; my $uXS = $self->{__useXS}; ### XS only return if !defined $u; return $self->varCE($HighestVCE) if $u eq 0xFFFF && $self->{highestFFFF}; return $self->varCE($minimalVCE) if $u eq 0xFFFE && $self->{minimalFFFE}; - return map($self->varCE($_), @{ $map->{$u} }) if $map->{$u}; + $u = 0xFFFD if $u !~ /;/ && 0x10FFFF < $u && !$out; + + my @ce; + if ($map->{$u}) { + @ce = @{ $map->{$u} }; # $u may be a contraction ### begin XS only ### - return map($self->varCE($_), _fetch_simple($u)) - if $uXS && _exists_simple($u); + } elsif ($uXS && _exists_simple($u)) { + @ce = _fetch_simple($u); ### end XS only ### - - # JCPS must not be a contraction, then it's a code point. - if (Hangul_SIni <= $u && $u <= Hangul_SFin) { + } elsif (Hangul_SIni <= $u && $u <= Hangul_SFin) { my $hang = $self->{overrideHangul}; - my @hangulCE; if ($hang) { - @hangulCE = map _pack_override($_, $u, $der), $hang->($u); + @ce = map _pack_override($_, $u, $der), $hang->($u); } elsif (!defined $hang) { - @hangulCE = $der->($u); + @ce = $der->($u); } else { my $max = $self->{maxlength}; my @decH = _decompHangul($u); @@ -665,25 +678,26 @@ sub getWt } } - @hangulCE = map({ + @ce = map({ $map->{$_} ? @{ $map->{$_} } : $uXS && _exists_simple($_) ? _fetch_simple($_) : ### XS only $der->($_); } @decH); } - return map $self->varCE($_), @hangulCE; + } elsif ($out && 0x10FFFF < $u) { + @ce = map _pack_override($_, $u, $der), $out->($u); } else { my $cjk = $self->{overrideCJK}; my $vers = $self->{UCA_Version}; if ($cjk && _isUIdeo($u, $vers)) { - my @cjkCE = map _pack_override($_, $u, $der), $cjk->($u); - return map $self->varCE($_), @cjkCE; - } - if ($vers == 8 && defined $cjk && _isUIdeo($u, 0)) { - return map $self->varCE($_), _uideoCE_8($u); + @ce = map _pack_override($_, $u, $der), $cjk->($u); + } elsif ($vers == 8 && defined $cjk && _isUIdeo($u, 0)) { + @ce = _uideoCE_8($u); + } else { + @ce = $der->($u); } - return map $self->varCE($_), $der->($u); } + return map $self->varCE($_), @ce; } @@ -1077,7 +1091,7 @@ If the revision (previously "tracking version") number of UCA is given, behavior of that revision is emulated on collating. If omitted, the return value of C<UCA_Version()> is used. -The following revisions are supported. The default is 26. +The following revisions are supported. The default is 28. UCA Unicode Standard DUCET (@version) ------------------------------------------------------- @@ -1091,10 +1105,14 @@ The following revisions are supported. The default is 26. 22 6.0.0 6.0.0 (6.0.0) 24 6.1.0 6.1.0 (6.1.0) 26 6.2.0 6.2.0 (6.2.0) + 28 6.3.0 6.3.0 (6.3.0) * Noncharacters (e.g. U+FFFF) are not ignored, and can be overridden since C<UCA_Version> 22. +* Out-of-range codepoints (greater than U+10FFFF) are not ignored, +and can be overridden since C<UCA_Version> 22. + * Fully ignorable characters were ignored, and would not interrupt contractions with C<UCA_Version> 9 and 11. @@ -1212,11 +1230,12 @@ C<$str> may be C<"abcd">, C<"abc012">, but should not include C<U+FFFF> such as C<"abc\x{FFFF}xyz">. C<$coll-E<gt>le($str, "abc\x{FFFF}")> works like C<$coll-E<gt>lt($str, "abd")> -almostly, but the latter has a problem that you should know which letter is +almost, but the latter has a problem that you should know which letter is next to C<c>. For a certain language where C<ch> as the next letter, -C<"abch"> is greater than C<"abc\x{FFFF}">, but lesser than C<"abd">. +C<"abch"> is greater than C<"abc\x{FFFF}">, but less than C<"abd">. -Note: This is equivalent to C<entry =E<gt> 'FFFF ; [.FFFE.0020.0005.FFFF]'>. +Note: +This is equivalent to C<(entry =E<gt> 'FFFF ; [.FFFE.0020.0005.FFFF]')>. Any other character than C<U+FFFF> can be tailored by C<entry>. =item identical @@ -1231,7 +1250,7 @@ If the parameter is made true, a final, tie-breaking level is used. If no difference of weights is found after the comparison through all the level specified by C<level>, the comparison with code points will be performed. -For the tie-breaking comparision, the sort key has code points +For the tie-breaking comparison, the sort key has code points of the original string appended. Completely ignorable characters are not ignored. @@ -1325,7 +1344,8 @@ then C<$a2> and C<$b2> at level 1, as followed. "b\x{FFFE}aaa" "bbb\x{FFFE}a" -Note: This is equivalent to C<entry =E<gt> 'FFFE ; [.0001.0020.0005.FFFE]'>. +Note: +This is equivalent to C<(entry =E<gt> 'FFFE ; [.0001.0020.0005.FFFE]')>. Any other character than C<U+FFFE> can be tailored by C<entry>. =item normalization @@ -1374,7 +1394,7 @@ B<Unicode::Normalize> is required (see also B<CAVEAT>). -- see 7.1 Derived Collation Elements, UTS #10. By default, CJK unified ideographs are ordered in Unicode codepoint -order, but those in the CJK Unified Ideographs block are lesser than +order, but those in the CJK Unified Ideographs block are less than those in the CJK Unified Ideographs Extension A etc. In the CJK Unified Ideographs block: @@ -1382,12 +1402,12 @@ those in the CJK Unified Ideographs Extension A etc. U+4E00..U+9FBB if UCA_Version is 14 or 16. U+4E00..U+9FC3 if UCA_Version is 18. U+4E00..U+9FCB if UCA_Version is 20 or 22. - U+4E00..U+9FCC if UCA_Version is 24 or 26. + U+4E00..U+9FCC if UCA_Version is 24 or later. In the CJK Unified Ideographs Extension blocks: Ext.A (U+3400..U+4DB5) and Ext.B (U+20000..U+2A6D6) in any UCA_Version. - Ext.C (U+2A700..U+2B734) if UCA_Version is 20 or greater. - Ext.D (U+2B740..U+2B81D) if UCA_Version is 22 or greater. + Ext.C (U+2A700..U+2B734) if UCA_Version is 20 or later. + Ext.D (U+2B740..U+2B81D) if UCA_Version is 22 or later. Through C<overrideCJK>, ordering of CJK unified ideographs (including extensions) can be overridden. @@ -1425,10 +1445,16 @@ ex. ignores all CJK unified ideographs. # where ->eq("Pe\x{4E00}rl", "Perl") is true # as U+4E00 is a CJK unified ideograph and to be ignorable. -If C<undef> is passed explicitly as the value for this key, -weights for CJK unified ideographs are treated as undefined. +If a false value (including C<undef>) is passed, C<overrideCJK> +has no effect. +C<$Collator-E<gt>change(overrideCJK =E<gt> 0)> resets the old one. + But assignment of weight for CJK unified ideographs in C<table> or C<entry> is still valid. +If C<undef> is passed explicitly as the value for this key, +weights for CJK unified ideographs are treated as undefined. +However when C<UCA_Version> E<gt> 8, C<(overrideCJK =E<gt> undef)> +has no special meaning. B<Note:> In addition to them, 12 CJK compatibility ideographs (C<U+FA0E>, C<U+FA0F>, C<U+FA11>, C<U+FA13>, C<U+FA14>, C<U+FA1F>, C<U+FA21>, C<U+FA23>, @@ -1452,12 +1478,56 @@ NFD and NFKD are not appropriate, since NFD and NFKD will decompose Hangul syllables before overriding. FCD may decompose Hangul syllables as the case may be. +If a false value (but not C<undef>) is passed, C<overrideHangul> +has no effect. +C<$Collator-E<gt>change(overrideHangul =E<gt> 0)> resets the old one. + If C<undef> is passed explicitly as the value for this key, weight for Hangul syllables is treated as undefined without decomposition into Hangul Jamo. But definition of weight for Hangul syllables in C<table> or C<entry> is still valid. +=item overrideOut + +-- see 7.1.1 Handling Ill-Formed Code Unit Sequences, UTS #10. + +Perl seems to allow out-of-range values (greater than 0x10FFFF). +By default, out-of-range values are replaced with C<U+FFFD> +(REPLACEMENT CHARACTER) when C<UCA_Version> E<gt>= 22, +or ignored when C<UCA_Version> E<lt>= 20. + +When C<UCA_Version> E<gt>= 22, the weights of out-of-range values +can be overridden. Though C<table> or C<entry> are available for them, +out-of-range values are too many. + +C<overrideOut> can perform it algorithmically. +This parameter works like C<overrideCJK>, so see there for examples. + +ex. ignores all out-of-range values. + + overrideOut => sub {()}, # CODEREF returning empty list + +If a false value (including C<undef>) is passed, C<overrideOut> +has no effect. +C<$Collator-E<gt>change(overrideOut =E<gt> 0)> resets the old one. + +B<NOTE ABOUT U+FFFD:> + +UCA recommends that out-of-range values should not be ignored for security +reasons. Say, C<"pe\x{110000}rl"> should not be equal to C<"perl">. +However, C<U+FFFD> is wrongly mapped to a variable collation element +in DUCET for Unicode 6.0.0 to 6.2.0, that means out-of-range values will be +ignored when C<variable> isn't C<Non-ignorable>. + +The mapping of C<U+FFFD> is corrected in Unicode 6.3.0. +see L<http://www.unicode.org/reports/tr10/tr10-28.html#Trailing_Weights> +(7.1.4 Trailing Weights). Such a correction is reproduced by this. + + overrideOut => sub { 0xFFFD }, # CODEREF returning a very large integer + +This workaround is unnecessary since Unicode 6.3.0. + =item preprocess -- see 5.4 Preprocessing, UTS #10. @@ -1492,7 +1562,7 @@ L<perluniintro>, L<perlunitut>, L<perlunifaq>, L<utf8>. -- see 3.5 Rearrangement, UTS #10. Characters that are not coded in logical order and to be rearranged. -If C<UCA_Version> is equal to or lesser than 11, default is: +If C<UCA_Version> is equal to or less than 11, default is: rearrange => [ 0x0E40..0x0E44, 0x0EC0..0x0EC4 ], @@ -1559,7 +1629,7 @@ may be better to avoid namespace conflict. B<NOTE>: When XSUB is used, the DUCET is compiled on building this module, and it may save time at the run time. -Explicit saying C<table =E<gt> 'allkeys.txt'> (or using another table), +Explicit saying C<(table =E<gt> 'allkeys.txt')>, or using another table, or using C<ignoreChar>, C<ignoreName>, C<undefChar>, C<undefName> or C<rewrite> will prevent this module from using the compiled DUCET. @@ -1661,7 +1731,7 @@ Sorts a list of strings. Returns 1 (when C<$a> is greater than C<$b>) or 0 (when C<$a> is equal to C<$b>) -or -1 (when C<$a> is lesser than C<$b>). +or -1 (when C<$a> is less than C<$b>). =item C<$result = $Collator-E<gt>eq($a, $b)> @@ -1679,8 +1749,8 @@ They works like the same name operators as theirs. eq : whether $a is equal to $b. ne : whether $a is not equal to $b. - lt : whether $a is lesser than $b. - le : whether $a is lesser than $b or equal to $b. + lt : whether $a is less than $b. + le : whether $a is less than $b or equal to $b. gt : whether $a is greater than $b. ge : whether $a is greater than $b or equal to $b. @@ -1727,7 +1797,7 @@ differ from those on the specified string. C<rearrange> and C<hangul_terminator> parameters are neglected. C<katakana_before_hiragana> and C<upper_before_lower> don't affect -matching and searching, as it doesn't matter whether greater or lesser. +matching and searching, as it doesn't matter whether greater or less. =over 4 @@ -1744,19 +1814,18 @@ If C<$substring> does not match any part of C<$string>, returns C<-1> in scalar context and an empty list in list context. -e.g. you say +e.g. when the content of C<$str> is C<"Ich mu>E<szlig>C< studieren Perl.">, +you say the following where C<$sub> is C<"M>E<uuml>C<SS">, my $Collator = Unicode::Collate->new( normalization => undef, level => 1 ); # (normalization => undef) is REQUIRED. - my $str = "Ich muß studieren Perl."; - my $sub = "MÜSS"; my $match; if (my($pos,$len) = $Collator->index($str, $sub)) { $match = substr($str, $pos, $len); } -and get C<"muß"> in C<$match> since C<"muß"> -is primary equal to C<"MÜSS">. +and get C<"mu>E<szlig>C<"> in C<$match>, since C<"mu>E<szlig>C<"> +is primary equal to C<"M>E<uuml>C<SS">. =item C<$match_ref = $Collator-E<gt>match($string, $substring)> @@ -1934,7 +2003,7 @@ module (see L<Unicode::Normalize>). If you need not it (say, in the case when you need not handle any combining characters), -assign C<normalization =E<gt> undef> explicitly. +assign C<(normalization =E<gt> undef)> explicitly. -- see 6.5 Avoiding Normalization, UTS #10. @@ -1960,14 +2029,14 @@ B<Unicode::Normalize is required to try The Conformance Test.> =head1 AUTHOR, COPYRIGHT AND LICENSE The Unicode::Collate module for perl was written by SADAHIRO Tomoyuki, -<SADAHIRO@cpan.org>. This module is Copyright(C) 2001-2012, +<SADAHIRO@cpan.org>. This module is Copyright(C) 2001-2013, SADAHIRO Tomoyuki. Japan. All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The file Unicode/Collate/allkeys.txt was copied verbatim -from L<http://www.unicode.org/Public/UCA/6.2.0/allkeys.txt>. +from L<http://www.unicode.org/Public/UCA/6.3.0/allkeys.txt>. For this file, Copyright (c) 2001-2012 Unicode, Inc. Distributed under the Terms of Use in L<http://www.unicode.org/copyright.html>. |