require Exporter;
-our $VERSION = '0.26';
+our $VERSION = '0.27';
our $PACKAGE = __PACKAGE__;
our @ISA = qw(Exporter);
croak "Unicode/Normalize.pm is required to normalize strings: $@"
if $@;
- Unicode::Normalize->import();
$getCombinClass = \&Unicode::Normalize::getCombinClass
if ! $getCombinClass;
- $self->{normCode} =
- $self->{normalization} =~ /^(?:NF)?C$/ ? \&NFC :
- $self->{normalization} =~ /^(?:NF)?D$/ ? \&NFD :
- $self->{normalization} =~ /^(?:NF)?KC$/ ? \&NFKC :
- $self->{normalization} =~ /^(?:NF)?KD$/ ? \&NFKD :
- croak "$PACKAGE unknown normalization form name: "
- . $self->{normalization};
+ my $norm = $self->{normalization};
+ $self->{normCode} = sub {
+ Unicode::Normalize::normalize($norm, shift);
+ };
+
+ eval { $self->{normCode}->("") }; # try
+ if ($@) {
+ croak "$PACKAGE unknown normalization form name: $norm";
+ }
}
return;
}
if ($max->{$ce}) { # contract
my $temp_ce = $ce;
+ my $ceLen = 1;
+ my $maxLen = $max->{$ce};
- for (my $p = $i + 1; $p < @src; $p++) {
+ for (my $p = $i + 1; $ceLen < $maxLen && $p < @src; $p++) {
next if ! defined $src[$p];
$temp_ce .= CODE_SEP . $src[$p];
+ $ceLen++;
if ($ent->{$temp_ce}) {
$ce = $temp_ce;
$i = $p;
my $self = shift;
my $ce = shift;
my $ent = $self->{entries};
- my $cjk = $self->{overrideCJK};
- my $hang = $self->{overrideHangul};
my $der = $self->{derivCode};
return if !defined $ce;
my $u = $ce;
if (0xAC00 <= $u && $u <= 0xD7A3) { # is Hangul Syllale
- return map $self->altCE($_),
- $hang
- ? map(pack(VCE_TEMPLATE, NON_VAR, @$_), &$hang($u))
- : defined $hang
- ? map({
- $ent->{$_} ? @{ $ent->{$_} } : $der->($_);
- } _decompHangul($u))
- : $der->($u);
+ my $hang = $self->{overrideHangul};
+ my @hangulCE;
+ if ($hang) {
+ @hangulCE = map(pack(VCE_TEMPLATE, NON_VAR, @$_), &$hang($u));
+ }
+ elsif (!defined $hang) {
+ @hangulCE = $der->($u);
+ }
+ else {
+ my $max = $self->{maxlength};
+ my @decH = _decompHangul($u);
+
+ if (@decH == 2) {
+ my $contract = join(CODE_SEP, @decH);
+ @decH = ($contract) if $ent->{$contract};
+ } else { # must be <@decH == 3>
+ if ($max->{$decH[0]}) {
+ my $contract = join(CODE_SEP, @decH);
+ if ($ent->{$contract}) {
+ @decH = ($contract);
+ } else {
+ $contract = join(CODE_SEP, @decH[0,1]);
+ $ent->{$contract} and @decH = ($contract, $decH[2]);
+ }
+ # even if V's ignorable, LT contraction is not supported.
+ # If such a situatution were required, NFD should be used.
+ }
+ if (@decH == 3 && $max->{$decH[1]}) {
+ my $contract = join(CODE_SEP, @decH[1,2]);
+ $ent->{$contract} and @decH = ($decH[0], $contract);
+ }
+ }
+
+ @hangulCE = map({
+ $ent->{$_} ? @{ $ent->{$_} } : $der->($_);
+ } @decH);
+ }
+ return map $self->altCE($_), @hangulCE;
}
elsif (0x3400 <= $u && $u <= 0x4DB5 ||
0x4E00 <= $u && $u <= 0x9FA5 ||
- 0x20000 <= $u && $u <= 0x2A6D6) { # CJK Ideograph
+ 0x20000 <= $u && $u <= 0x2A6D6) # CJK Ideograph
+ {
+ my $cjk = $self->{overrideCJK};
return map $self->altCE($_),
$cjk
? map(pack(VCE_TEMPLATE, NON_VAR, @$_), &$cjk($u))
If specified, strings are normalized before preparation of sort keys
(the normalization is executed after preprocess).
-As a form name, one of the following names must be used.
+A form name C<Unicode::Normalize::normalize()> accepts will be applied
+as C<$normalization_form>.
+See C<Unicode::Normalize::normalize()> for detail.
+If omitted, C<'NFD'> is used.
- 'C' or 'NFC' for Normalization Form C
- 'D' or 'NFD' for Normalization Form D
- 'KC' or 'NFKC' for Normalization Form KC
- 'KD' or 'NFKD' for Normalization Form KD
-
-If omitted, the string is put into Normalization Form D.
+L<normalization> is performed after L<preprocess> (if defined).
If C<undef> is passed explicitly as the value for this key,
any normalization is not carried out (this may make tailoring easier
preprocess => sub {
my $str = shift;
$str =~ s/\b(?:an?|the)\s+//gi;
- $str;
+ return $str;
},
+L<preprocess> is performed before L<normalization> (if defined).
+
=item rearrange
-- see 3.1.3 Rearrangement, UTS #10.
=head1 AUTHOR
-SADAHIRO Tomoyuki, E<lt>SADAHIRO@cpan.orgE<gt>
+SADAHIRO Tomoyuki, <SADAHIRO@cpan.org>
http://homepage1.nifty.com/nomenclator/perl/
--- /dev/null
+BEGIN {
+ unless ("A" eq pack('U', 0x41)) {
+ print "1..0 # Unicode::Collate " .
+ "cannot stringify a Unicode code point\n";
+ exit 0;
+ }
+}
+
+BEGIN {
+ if ($ENV{PERL_CORE}) {
+ chdir('t') if -d 't';
+ @INC = $^O eq 'MacOS' ? qw(::lib) : qw(../lib);
+ }
+}
+
+use Test;
+BEGIN { plan tests => 52 };
+
+use strict;
+use warnings;
+use Unicode::Collate;
+
+use vars qw($IsEBCDIC);
+$IsEBCDIC = ord("A") != 0x41;
+
+#########################
+
+ok(1); # If we made it this far, we're ok.
+
+# a standard collator (3.1.1)
+my $Collator = Unicode::Collate->new(
+ table => 'keys.txt',
+ normalization => undef,
+);
+
+
+# a collator for hangul sorting,
+# cf. http://std.dkuug.dk/JTC1/SC22/WG20/docs/documents.html
+# http://std.dkuug.dk/JTC1/SC22/WG20/docs/n1051-hangulsort.pdf
+my $hangul = Unicode::Collate->new(
+ level => 3,
+ table => undef,
+ normalization => undef,
+ entry => <<'ENTRIES',
+0061 ; [.0A15.0020.0002] # LATIN SMALL LETTER A
+0041 ; [.0A15.0020.0008] # LATIN CAPITAL LETTER A
+#1161 ; [.1800.0020.0002] # <comment> initial jungseong A
+#1163 ; [.1801.0020.0002] # <comment> initial jungseong YA
+1100 ; [.1831.0020.0002] # choseong KIYEOK
+1100 1161 ; [.1831.0020.0002][.1800.0020.0002] # G-A
+1100 1163 ; [.1831.0020.0002][.1801.0020.0002] # G-YA
+1101 ; [.1831.0020.0002][.1831.0020.0002] # choseong SSANGKIYEOK
+1101 1161 ; [.1831.0020.0002][.1831.0020.0002][.1800.0020.0002] # GG-A
+1101 1163 ; [.1831.0020.0002][.1831.0020.0002][.1801.0020.0002] # GG-YA
+1102 ; [.1833.0020.0002] # choseong NIEUN
+1102 1161 ; [.1833.0020.0002][.1800.0020.0002] # N-A
+1102 1163 ; [.1833.0020.0002][.1801.0020.0002] # N-YA
+3042 ; [.1921.0020.000E] # HIRAGANA LETTER A
+11A8 ; [.FE10.0020.0002] # jongseong KIYEOK
+11A9 ; [.FE10.0020.0002][.FE10.0020.0002] # jongseong SSANGKIYEOK
+1161 ; [.FE20.0020.0002] # jungseong A <non-initial>
+1163 ; [.FE21.0020.0002] # jungseong YA <non-initial>
+ENTRIES
+);
+
+ok(ref $hangul, "Unicode::Collate");
+
+#########################
+
+# L(simp)L(simp) vs L(comp): /GGA/
+ok($Collator->lt("\x{1100}\x{1100}\x{1161}", "\x{1101}\x{1161}"));
+ok($hangul ->eq("\x{1100}\x{1100}\x{1161}", "\x{1101}\x{1161}"));
+
+# L(simp) vs L(simp)L(simp): /GA/ vs /GGA/
+ok($Collator->gt("\x{1100}\x{1161}", "\x{1100}\x{1100}\x{1161}"));
+ok($hangul ->lt("\x{1100}\x{1161}", "\x{1100}\x{1100}\x{1161}"));
+
+# T(simp)T(simp) vs T(comp): /AGG/
+ok($Collator->lt("\x{1161}\x{11A8}\x{11A8}", "\x{1161}\x{11A9}"));
+ok($hangul ->eq("\x{1161}\x{11A8}\x{11A8}", "\x{1161}\x{11A9}"));
+
+# T(simp) vs T(simp)T(simp): /AG/ vs /AGG/
+ok($Collator->lt("\x{1161}\x{11A8}", "\x{1161}\x{11A8}\x{11A8}"));
+ok($hangul ->lt("\x{1161}\x{11A8}", "\x{1161}\x{11A8}\x{11A8}"));
+
+# LV vs LLV: /GA/ vs /GNA/
+ok($Collator->gt("\x{1100}\x{1161}", "\x{1100}\x{1102}\x{1161}"));
+ok($hangul ->lt("\x{1100}\x{1161}", "\x{1100}\x{1102}\x{1161}"));
+
+# LVX vs LVV: /GAA/ vs /GA/.latinA
+ok($Collator->gt("\x{1100}\x{1161}\x{1161}", "\x{1100}\x{1161}A"));
+ok($hangul ->gt("\x{1100}\x{1161}\x{1161}", "\x{1100}\x{1161}A"));
+
+# LVX vs LVV: /GAA/ vs /GA/.hiraganaA
+ok($Collator->lt("\x{1100}\x{1161}\x{1161}", "\x{1100}\x{1161}\x{3042}"));
+ok($hangul ->gt("\x{1100}\x{1161}\x{1161}", "\x{1100}\x{1161}\x{3042}"));
+
+# LVX vs LVV: /GAA/ vs /GA/.hanja
+ok($Collator->lt("\x{1100}\x{1161}\x{1161}", "\x{1100}\x{1161}\x{4E00}"));
+ok($hangul ->gt("\x{1100}\x{1161}\x{1161}", "\x{1100}\x{1161}\x{4E00}"));
+
+# LVL vs LVT: /GA/./G/ vs /GAG/
+ok($Collator->lt("\x{1100}\x{1161}\x{1100}", "\x{1100}\x{1161}\x{11A8}"));
+ok($hangul ->lt("\x{1100}\x{1161}\x{1100}", "\x{1100}\x{1161}\x{11A8}"));
+
+# LVT vs LVX: /GAG/ vs /GA/.latinA
+ok($Collator->gt("\x{1100}\x{1161}\x{11A8}", "\x{1100}\x{1161}A"));
+ok($hangul ->gt("\x{1100}\x{1161}\x{11A8}", "\x{1100}\x{1161}A"));
+
+# LVT vs LVX: /GAG/ vs /GA/.hiraganaA
+ok($Collator->lt("\x{1100}\x{1161}\x{11A8}", "\x{1100}\x{1161}\x{3042}"));
+ok($hangul ->gt("\x{1100}\x{1161}\x{11A8}", "\x{1100}\x{1161}\x{3042}"));
+
+# LVT vs LVX: /GAG/ vs /GA/.hanja
+ok($Collator->lt("\x{1100}\x{1161}\x{11A8}", "\x{1100}\x{1161}\x{4E00}"));
+ok($hangul ->gt("\x{1100}\x{1161}\x{11A8}", "\x{1100}\x{1161}\x{4E00}"));
+
+# LVT vs LVV: /GAG/ vs /GAA/
+ok($Collator->gt("\x{1100}\x{1161}\x{11A8}", "\x{1100}\x{1161}\x{1161}"));
+ok($hangul ->lt("\x{1100}\x{1161}\x{11A8}", "\x{1100}\x{1161}\x{1161}"));
+
+# LVL vs LVV: /GA/./G/ vs /GAA/
+ok($Collator->lt("\x{1100}\x{1161}\x{1100}", "\x{1100}\x{1161}\x{1161}"));
+ok($hangul ->lt("\x{1100}\x{1161}\x{1100}", "\x{1100}\x{1161}\x{1161}"));
+
+# LV vs Syl(LV): /GA/ vs /[GA]/
+ok($Collator->eq("\x{1100}\x{1161}", "\x{AC00}"));
+ok($hangul ->eq("\x{1100}\x{1161}", "\x{AC00}"));
+
+# LVT vs Syl(LV)T: /GAG/ vs /[GA]G/
+ok($Collator->eq("\x{1100}\x{1161}\x{11A8}", "\x{AC00}\x{11A8}"));
+ok($hangul ->eq("\x{1100}\x{1161}\x{11A8}", "\x{AC00}\x{11A8}"));
+
+# LVT vs Syl(LVT): /GAG/ vs /[GAG]/
+ok($Collator->eq("\x{1100}\x{1161}\x{11A8}", "\x{AC01}"));
+ok($hangul ->eq("\x{1100}\x{1161}\x{11A8}", "\x{AC01}"));
+
+# LVTT vs Syl(LVTT): /GAGG/ vs /[GAGG]/
+ok($Collator->eq("\x{1100}\x{1161}\x{11A9}", "\x{AC02}"));
+ok($hangul ->eq("\x{1100}\x{1161}\x{11A9}", "\x{AC02}"));
+
+# LVTT vs Syl(LVT).T: /GAGG/ vs /[GAG]G/
+ok($Collator->gt("\x{1100}\x{1161}\x{11A9}", "\x{AC01}\x{11A8}"));
+ok($hangul ->eq("\x{1100}\x{1161}\x{11A9}", "\x{AC01}\x{11A8}"));
+
+# LLVT vs L.Syl(LVT): /GGAG/ vs /G[GAG]/
+ok($Collator->gt("\x{1101}\x{1161}\x{11A8}", "\x{1100}\x{AC01}"));
+ok($hangul ->eq("\x{1101}\x{1161}\x{11A8}", "\x{1100}\x{AC01}"));
+
+#########################
+
+# checks contraction in LVT:
+# weights of these contractions may be non-sense.
+
+my $hangcont = Unicode::Collate->new(
+ level => 3,
+ table => undef,
+ normalization => undef,
+ entry => <<'ENTRIES',
+1100 ; [.1831.0020.0002] # HANGUL CHOSEONG KIYEOK
+1101 ; [.1832.0020.0002] # HANGUL CHOSEONG SSANGKIYEOK
+1161 ; [.188D.0020.0002] # HANGUL JUNGSEONG A
+1162 ; [.188E.0020.0002] # HANGUL JUNGSEONG AE
+1163 ; [.188F.0020.0002] # HANGUL JUNGSEONG YA
+11A8 ; [.18CF.0020.0002] # HANGUL JONGSEONG KIYEOK
+11A9 ; [.18D0.0020.0002] # HANGUL JONGSEONG SSANGKIYEOK
+1161 11A9 ; [.0000.0000.0000] # A-GG <contraction>
+1100 1163 11A8 ; [.1000.0020.0002] # G-YA-G <contraction> eq. U+AC39
+ENTRIES
+);
+
+# contracted into VT
+ok($Collator->lt("\x{1101}", "\x{1101}\x{1161}\x{11A9}"));
+ok($hangcont->eq("\x{1101}", "\x{1101}\x{1161}\x{11A9}"));
+
+# not contracted into LVT but into VT
+ok($Collator->lt("\x{1100}", "\x{1100}\x{1161}\x{11A9}"));
+ok($hangcont->eq("\x{1100}", "\x{1100}\x{1161}\x{11A9}"));
+
+# contracted into LVT
+ok($Collator->gt("\x{1100}\x{1163}\x{11A8}", "\x{1100}"));
+ok($hangcont->lt("\x{1100}\x{1163}\x{11A8}", "\x{1100}"));
+
+# LVTT vs Syl(LVTT): /GAGG/ vs /[GAGG]/
+ok($Collator->eq("\x{1100}\x{1161}\x{11A9}", "\x{AC02}"));
+ok($hangcont->eq("\x{1100}\x{1161}\x{11A9}", "\x{AC02}"));
+
+# LVT vs Syl(LVT): /GYAG/ vs /[GYAG]/
+ok($Collator->eq("\x{1100}\x{1163}\x{11A8}", "\x{AC39}"));
+ok($hangcont->eq("\x{1100}\x{1163}\x{11A8}", "\x{AC39}"));
+
+1;
+__END__
projects / p5sagit/p5-mst-13.2.git / commitdiff