lib/Unicode/Collate/keys.txt Unicode::Collate
lib/Unicode/Collate.pm Unicode::Collate
lib/Unicode/Collate/README Unicode::Collate
+lib/Unicode/Collate/t/contract.t Unicode::Collate
lib/Unicode/Collate/t/hangul.t Unicode::Collate
lib/Unicode/Collate/t/index.t Unicode::Collate
lib/Unicode/Collate/t/test.t Unicode::Collate
require Exporter;
-our $VERSION = '0.27';
+our $VERSION = '0.28';
our $PACKAGE = __PACKAGE__;
our @ISA = qw(Exporter);
# A coderef to get combining class imported from Unicode::Normalize
# (i.e. \&Unicode::Normalize::getCombinClass).
# This is also used as a HAS_UNICODE_NORMALIZE flag.
-our $getCombinClass;
+our $CVgetCombinClass;
# Supported Levels
use constant MinLevel => 1;
croak "Unicode/Normalize.pm is required to normalize strings: $@"
if $@;
- $getCombinClass = \&Unicode::Normalize::getCombinClass
- if ! $getCombinClass;
+ $CVgetCombinClass = \&Unicode::Normalize::getCombinClass
+ if ! $CVgetCombinClass;
- my $norm = $self->{normalization};
- $self->{normCode} = sub {
+ if ($self->{normalization} ne 'prenormalized') {
+ my $norm = $self->{normalization};
+ $self->{normCode} = sub {
Unicode::Normalize::normalize($norm, shift);
};
-
- eval { $self->{normCode}->("") }; # try
- if ($@) {
- croak "$PACKAGE unknown normalization form name: $norm";
+ eval { $self->{normCode}->("") }; # try
+ $@ and croak "$PACKAGE unknown normalization form name: $norm";
}
}
return;
if ! exists $self->{overrideHangul};
$self->{overrideCJK} = ''
if ! exists $self->{overrideCJK};
- $self->{normalization} = 'D'
+ $self->{normalization} = 'NFD'
if ! exists $self->{normalization};
$self->{alternate} = $self->{alternateTable} || 'shifted'
if ! exists $self->{alternate};
$i = $p;
}
}
- }
- # with Combining Char (UTS#10, 4.2.1).
- # requires Unicode::Normalize.
- # Not be $wLen, as not croaked due to $norm.
- if ($getCombinClass) {
- for (my $p = $i + 1; $p < @src; $p++) {
- next if ! defined $src[$p];
- last unless $getCombinClass->($src[$p]);
- my $tail = CODE_SEP . $src[$p];
- if ($ent->{$ce.$tail}) {
- $ce .= $tail;
- $src[$p] = undef;
+ # not-contiguous contraction with Combining Char (cf. UTS#10, S2.1).
+ # This process requires Unicode::Normalize.
+ # If "normalize" is undef, here should be skipped *always*
+ # (in spite of bool value of $CVgetCombinClass),
+ # since canonical ordering cannot be expected.
+ # Blocked combining character should not be contracted.
+
+ if ($self->{normalization})
+ # $self->{normCode} is false in the case of "prenormalized".
+ {
+ my $preCC = 0;
+ my $curCC = 0;
+
+ for (my $p = $i + 1; $p < @src; $p++) {
+ next if ! defined $src[$p];
+ $curCC = $CVgetCombinClass->($src[$p]);
+ last unless $curCC;
+ my $tail = CODE_SEP . $src[$p];
+ if ($preCC != $curCC && $ent->{$ce.$tail}) {
+ $ce .= $tail;
+ $src[$p] = undef;
+ } else {
+ $preCC = $curCC;
+ }
}
}
}
A form name C<Unicode::Normalize::normalize()> accepts will be applied
as C<$normalization_form>.
+Acceptable names include C<'NFD'>, C<'NFC'>, C<'NFKD'>, and C<'NFKC'>.
See C<Unicode::Normalize::normalize()> for detail.
If omitted, C<'NFD'> is used.
L<normalization> is performed after L<preprocess> (if defined).
-If C<undef> is passed explicitly as the value for this key,
+Furthermore, special values, C<undef> and C<"prenormalized">, can be used,
+though they are not concerned with C<Unicode::Normalize::normalize()>.
+
+If C<undef> (not a string C<"undef">) is passed explicitly
+as the value for this key,
any normalization is not carried out (this may make tailoring easier
if any normalization is not desired).
-
-see B<CAVEAT>.
+Under C<(normalization =E<gt> undef)>, only contiguous contractions
+are resolved; e.g. C<A-cedilla-ring> would be primary equal to C<A>,
+even if C<A-ring> (and C<A-ring-cedilla>) is ordered after C<Z>.
+In this point,
+C<(normalization =E<gt> undef, preprocess =E<gt> sub { NFD(shift) })>
+B<is not> equivalent to C<(normalization =E<gt> 'NFD')>.
+
+In the case of C<(normalization =E<gt> "prenormalized")>,
+any normalization is not performed, but
+non-contiguous contractions with combining characters are performed.
+Therefore
+C<(normalization =E<gt> 'prenormalized', preprocess =E<gt> sub { NFD(shift) })>
+B<is> equivalent to C<(normalization =E<gt> 'NFD')>.
+If source strings are finely prenormalized,
+C<(normalization =E<gt> 'prenormalized')> may save time for normalization.
+
+Except C<(normalization =E<gt> undef)>,
+B<Unicode::Normalize> is required (see also B<CAVEAT>).
=item overrideCJK
Revision history for Perl module Unicode::Collate.
+0.28 Sat Sep 06 20:16:01 2003
+ - Fixed another inconsistency under (normalization => undef):
+ Non-contiguous contraction is always neglected.
+ - Fixed: according to S2.1 in UTS #10, a blocked combining character
+ should not be contracted. One test in test.t was wrong, then removed.
+ - Added contract.t.
+ - (normalization => "prenormalized") is able to be used.
+
0.27 Sun Aug 31 22:23:17 2003
some improvements:
- - The maximum length of contracted CE was not checked.
+ - The maximum length of contracted CE was not checked (v0.22 to v0.26).
Collation of a large string including a first letter of a contraction
that is not a part of that contraction (say, 'c' of 'ca'
where 'ch' is defined) was too slow, inefficient.
-Unicode/Collate version 0.27
+Unicode/Collate version 0.28
===============================
NAME
--- /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 => 40 };
+
+use strict;
+use warnings;
+use Unicode::Collate;
+
+use vars qw($IsEBCDIC);
+$IsEBCDIC = ord("A") != 0x41;
+
+our $kjeEntry = <<'ENTRIES';
+0301 ; [.0000.0032.0002.0301] # COMBINING ACUTE ACCENT
+0334 ; [.0000.008B.0002.0334] # COMBINING TILDE OVERLAY
+043A ; [.0D31.0020.0002.043A] # CYRILLIC SMALL LETTER KA
+041A ; [.0D31.0020.0008.041A] # CYRILLIC CAPITAL LETTER KA
+045C ; [.0DA1.0020.0002.045C] # CYRILLIC SMALL LETTER KJE
+043A 0301 ; [.0DA1.0020.0002.045C] # CYRILLIC SMALL LETTER KJE
+040C ; [.0DA1.0020.0008.040C] # CYRILLIC CAPITAL LETTER KJE
+041A 0301 ; [.0DA1.0020.0008.040C] # CYRILLIC CAPITAL LETTER KJE
+ENTRIES
+
+our $aaEntry = <<'ENTRIES';
+0304 ; [.0000.005A.0002.0304] # COMBINING MACRON (cc = 230)
+030A ; [.0000.0043.0002.030A] # COMBINING RING ABOVE (cc = 230)
+0327 ; [.0000.0055.0002.0327] # COMBINING CEDILLA (cc = 202)
+031A ; [.0000.006B.0002.031A] # COMBINING LEFT ANGLE ABOVE (cc = 232)
+0061 ; [.0A15.0020.0002.0061] # LATIN SMALL LETTER A
+0041 ; [.0A15.0020.0008.0041] # LATIN CAPITAL LETTER A
+007A ; [.0C13.0020.0002.007A] # LATIN SMALL LETTER Z
+005A ; [.0C13.0020.0008.005A] # LATIN CAPITAL LETTER Z
+00E5 ; [.0C25.0020.0002.00E5] # LATIN SMALL LETTER A WITH RING ABOVE; QQCM
+00C5 ; [.0C25.0020.0008.00C5] # LATIN CAPITAL LETTER A WITH RING ABOVE; QQCM
+0061 030A ; [.0C25.0020.0002.0061] # LATIN SMALL LETTER A WITH RING ABOVE
+0041 030A ; [.0C25.0020.0008.0041] # LATIN CAPITAL LETTER A WITH RING ABOVE
+ENTRIES
+
+#########################
+
+ok(1); # If we made it this far, we're ok.
+
+my $kjeNoN = Unicode::Collate->new(
+ level => 1,
+ table => undef,
+ normalization => undef,
+ entry => $kjeEntry,
+);
+
+ok($kjeNoN->lt("\x{043A}", "\x{043A}\x{0301}"));
+ok($kjeNoN->gt("\x{045C}", "\x{043A}\x{0334}\x{0301}"));
+ok($kjeNoN->eq("\x{043A}", "\x{043A}\x{0334}\x{0301}"));
+ok($kjeNoN->eq("\x{045C}", "\x{043A}\x{0301}\x{0334}"));
+
+our %sortkeys;
+
+$sortkeys{'KAac'} = $kjeNoN->viewSortKey("\x{043A}\x{0301}");
+$sortkeys{'KAta'} = $kjeNoN->viewSortKey("\x{043A}\x{0334}\x{0301}");
+$sortkeys{'KAat'} = $kjeNoN->viewSortKey("\x{043A}\x{0301}\x{0334}");
+
+eval { require Unicode::Normalize };
+if (!$@ && !$IsEBCDIC) {
+ my $kjeNFD = Unicode::Collate->new(
+ level => 1,
+ table => undef,
+ entry => $kjeEntry,
+ );
+ok($kjeNFD->lt("\x{043A}", "\x{043A}\x{0301}"));
+ok($kjeNFD->eq("\x{045C}", "\x{043A}\x{0334}\x{0301}"));
+ok($kjeNFD->lt("\x{043A}", "\x{043A}\x{0334}\x{0301}"));
+ok($kjeNFD->eq("\x{045C}", "\x{043A}\x{0301}\x{0334}"));
+
+ my $aaNFD = Unicode::Collate->new(
+ level => 1,
+ table => undef,
+ entry => $aaEntry,
+ );
+
+ok($aaNFD->lt("Z", "A\x{30A}\x{304}"));
+ok($aaNFD->eq("A", "A\x{304}\x{30A}"));
+ok($aaNFD->eq(pack('U', 0xE5), "A\x{30A}\x{304}"));
+ok($aaNFD->eq("A\x{304}", "A\x{304}\x{30A}"));
+ok($aaNFD->lt("Z", "A\x{327}\x{30A}"));
+ok($aaNFD->lt("Z", "A\x{30A}\x{327}"));
+ok($aaNFD->lt("Z", "A\x{31A}\x{30A}"));
+ok($aaNFD->lt("Z", "A\x{30A}\x{31A}"));
+
+ my $aaPre = Unicode::Collate->new(
+ level => 1,
+ normalization => "prenormalized",
+ table => undef,
+ entry => $aaEntry,
+ );
+
+ok($aaPre->lt("Z", "A\x{30A}\x{304}"));
+ok($aaPre->eq("A", "A\x{304}\x{30A}"));
+ok($aaPre->eq(pack('U', 0xE5), "A\x{30A}\x{304}"));
+ok($aaPre->eq("A\x{304}", "A\x{304}\x{30A}"));
+ok($aaPre->lt("Z", "A\x{327}\x{30A}"));
+ok($aaPre->lt("Z", "A\x{30A}\x{327}"));
+ok($aaPre->lt("Z", "A\x{31A}\x{30A}"));
+ok($aaPre->lt("Z", "A\x{30A}\x{31A}"));
+}
+else {
+ ok(1) for 1..20;
+}
+
+# again: loading Unicode::Normalize should not affect $kjeNoN.
+ok($kjeNoN->lt("\x{043A}", "\x{043A}\x{0301}"));
+ok($kjeNoN->gt("\x{045C}", "\x{043A}\x{0334}\x{0301}"));
+ok($kjeNoN->eq("\x{043A}", "\x{043A}\x{0334}\x{0301}"));
+ok($kjeNoN->eq("\x{045C}", "\x{043A}\x{0301}\x{0334}"));
+
+ok($sortkeys{'KAac'}, $kjeNoN->viewSortKey("\x{043A}\x{0301}"));
+ok($sortkeys{'KAta'}, $kjeNoN->viewSortKey("\x{043A}\x{0334}\x{0301}"));
+ok($sortkeys{'KAat'}, $kjeNoN->viewSortKey("\x{043A}\x{0301}\x{0334}"));
+
+my $aaNoN = Unicode::Collate->new(
+ level => 1,
+ table => undef,
+ entry => $aaEntry,
+ normalization => undef,
+);
+
+ok($aaNoN->lt("Z", "A\x{30A}\x{304}"));
+ok($aaNoN->eq("A", "A\x{304}\x{30A}"));
+ok($aaNoN->eq(pack('U', 0xE5), "A\x{30A}\x{304}"));
+ok($aaNoN->eq("A\x{304}", "A\x{304}\x{30A}"));
+ok($aaNoN->eq("A", "A\x{327}\x{30A}"));
+ok($aaNoN->lt("Z", "A\x{30A}\x{327}"));
+ok($aaNoN->eq("A", "A\x{31A}\x{30A}"));
+ok($aaNoN->lt("Z", "A\x{30A}\x{31A}"));
+
}
use Test;
-BEGIN { plan tests => 199 };
+BEGIN { plan tests => 200 };
use strict;
use warnings;
if (!$@ && !$IsEBCDIC) {
my $NFD = Unicode::Collate->new(
- table => undef,
+ table => 'keys.txt',
+ level => 1,
entry => <<'ENTRIES',
0430 ; [.0CB5.0020.0002.0430] # CYRILLIC SMALL LETTER A
0410 ; [.0CB5.0020.0008.0410] # CYRILLIC CAPITAL LETTER A
ok($NFD->eq("\x{4D3}\x{325}", "\x{430}\x{308}\x{325}"));
ok($NFD->lt("\x{430}\x{308}A", "\x{430}\x{308}B"));
ok($NFD->lt("\x{430}\x{3099}B", "\x{430}\x{308}\x{3099}A"));
- ok($NFD->eq("\x{0430}\x{3099}\x{309A}\x{0308}",
- "\x{0430}\x{309A}\x{3099}\x{0308}") );
}
else {
ok(1);
ok(1);
ok(1);
- ok(1);
}
##############
table => 'keys.txt',
normalization => undef,
ignoreName => qr/HANGUL|HIRAGANA|KATAKANA|BOPOMOFO/,
- level => 4,
+ level => 3,
entry => << 'ENTRIES',
0063 0068 ; [.0A3F.0020.0002.0063] % "ch" in traditional Spanish
0043 0068 ; [.0A3F.0020.0008.0043] # "Ch" in traditional Spanish
);
ok($trad->eq("ocho", "oc\cAho")); # UCA v9
ok($trad->eq("ocho", "oc\0\cA\0\cBho")); # UCA v9
+ok($trad->eq("-", "")); # also UCA v8
+ok($trad->lt("oc-ho", "ocho")); # also UCA v8
my $hiragana = "\x{3042}\x{3044}";
my $katakana = "\x{30A2}\x{30A4}";
https://perl5.git.perl.org / perl5.git / commitdiff