summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Unicode/Collate.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Unicode/Collate.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/Unicode/Collate.pm179
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>.