no warnings 'utf8';
-require Exporter;
-
-our $VERSION = '0.31';
+our $VERSION = '0.52';
our $PACKAGE = __PACKAGE__;
-our @ISA = qw(Exporter);
-
-our %EXPORT_TAGS = ();
-our @EXPORT_OK = ();
-our @EXPORT = ();
-
-(our $Path = $INC{'Unicode/Collate.pm'}) =~ s/\.pm$//;
-our $KeyFile = "allkeys.txt";
+my @Path = qw(Unicode Collate);
+my $KeyFile = "allkeys.txt";
# Perl's boolean
use constant TRUE => 1;
# 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 $CVgetCombinClass;
+my $CVgetCombinClass;
# Supported Levels
use constant MinLevel => 1;
# Shifted weight at 4th level
use constant Shift4Wt => 0xFFFF;
-# Variable weight at 1st level.
-# This is a negative value but should be regarded as zero on collation.
-# This is for distinction of variable chars from level 3 ignorable chars.
-use constant Var1Wt => -1;
-
-
# A boolean for Variable and 16-bit weights at 4 levels of Collation Element
# PROBLEM: The Default Unicode Collation Element Table
# has weights over 0xFFFF at the 4th level.
use constant Hangul_LFin => 0x1159;
use constant Hangul_LFill => 0x115F;
use constant Hangul_VBase => 0x1161;
-use constant Hangul_VIni => 0x1160;
+use constant Hangul_VIni => 0x1160; # from Vowel Filler
use constant Hangul_VFin => 0x11A2;
-use constant Hangul_TBase => 0x11A7;
+use constant Hangul_TBase => 0x11A7; # from "no-final" codepoint
use constant Hangul_TIni => 0x11A8;
use constant Hangul_TFin => 0x11F9;
use constant Hangul_TCount => 28;
use constant Hangul_SFin => 0xD7A3;
use constant CJK_UidIni => 0x4E00;
use constant CJK_UidFin => 0x9FA5;
+use constant CJK_UidF41 => 0x9FBB;
use constant CJK_ExtAIni => 0x3400;
use constant CJK_ExtAFin => 0x4DB5;
use constant CJK_ExtBIni => 0x20000;
use constant BMP_Max => 0xFFFF;
# Logical_Order_Exception in PropList.txt
-# TODO: synchronization with change of PropList.txt.
-our $DefaultRearrange = [ 0x0E40..0x0E44, 0x0EC0..0x0EC4 ];
+my $DefaultRearrange = [ 0x0E40..0x0E44, 0x0EC0..0x0EC4 ];
-sub UCA_Version { "11" }
+sub UCA_Version { "14" }
-sub Base_Unicode_Version { "4.0" }
+sub Base_Unicode_Version { "4.1.0" }
######
}
sub unpack_U {
- return unpack('U*', pack('U*').shift);
+ return unpack('U*', shift(@_).pack('U*'));
}
######
entry mapping table maxlength
ignoreChar ignoreName undefChar undefName variableTable
versionTable alternateTable backwardsTable forwardsTable rearrangeTable
- derivCode normCode rearrangeHash L3_ignorable
+ derivCode normCode rearrangeHash
backwardsFlag
/;
# 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.
sub version {
my $self = shift;
}
# else => ignored
}
- $self->checkCollator;
+ $self->checkCollator();
return wantarray ? %old : $self;
}
sub _checkLevel {
my $level = shift;
- my $key = shift;
- croak sprintf "Illegal level %d (in \$self->{%s}) lower than %d.",
- $level, $key, MinLevel if MinLevel > $level;
- croak sprintf "Unsupported level %d (in \$self->{%s}) higher than %d ",
- $level, $key, MaxLevel if MaxLevel < $level;
+ my $key = shift; # 'level' or 'backwards'
+ MinLevel <= $level or croak sprintf
+ "Illegal level %d (in value for key '%s') lower than %d.",
+ $level, $key, MinLevel;
+ $level <= MaxLevel or croak sprintf
+ "Unsupported level %d (in value for key '%s') higher than %d.",
+ $level, $key, MaxLevel;
}
my %DerivCode = (
8 => \&_derivCE_8,
9 => \&_derivCE_9,
11 => \&_derivCE_9, # 11 == 9
+ 14 => \&_derivCE_14,
);
sub checkCollator {
$self->{alternateTable} || 'shifted';
$self->{variable} = $self->{alternate} = lc($self->{variable});
exists $VariableOK{ $self->{variable} }
- or croak "$PACKAGE unknown variable tag name: $self->{variable}";
+ or croak "$PACKAGE unknown variable parameter name: $self->{variable}";
if (! defined $self->{backwards}) {
$self->{backwardsFlag} = 0;
# If undef is passed explicitly, no file is read.
$self->{table} = $KeyFile if ! exists $self->{table};
- $self->read_table if defined $self->{table};
+ $self->read_table() if defined $self->{table};
if ($self->{entry}) {
- $self->parseEntry($_) foreach split /\n/, $self->{entry};
+ while ($self->{entry} =~ /([^\n]+)/g) {
+ $self->parseEntry($1);
+ }
}
$self->{level} ||= MaxLevel;
$self->{UCA_Version} ||= UCA_Version();
- $self->{overrideHangul} = ''
+ $self->{overrideHangul} = FALSE
if ! exists $self->{overrideHangul};
- $self->{overrideCJK} = ''
+ $self->{overrideCJK} = FALSE
if ! exists $self->{overrideCJK};
$self->{normalization} = 'NFD'
if ! exists $self->{normalization};
- $self->{rearrange} = $self->{rearrangeTable} || $DefaultRearrange
+ $self->{rearrange} = $self->{rearrangeTable} ||
+ ($self->{UCA_Version} <= 11 ? $DefaultRearrange : [])
if ! exists $self->{rearrange};
$self->{backwards} = $self->{backwardsTable}
if ! exists $self->{backwards};
- $self->checkCollator;
+ $self->checkCollator();
return $self;
}
sub read_table {
my $self = shift;
- my $file = $self->{table} ne '' ? $self->{table} : $KeyFile;
- my $filepath = File::Spec->catfile($Path, $file);
- open my $fk, "<$filepath"
- or croak "File does not exist at $filepath";
+ my($f, $fh);
+ foreach my $d (@INC) {
+ $f = File::Spec->catfile($d, @Path, $self->{table});
+ last if open($fh, $f);
+ $f = undef;
+ }
+ if (!defined $f) {
+ $f = File::Spec->catfile(@Path, $self->{table});
+ croak("$PACKAGE: Can't locate $f in \@INC (\@INC contains: @INC)");
+ }
- while (<$fk>) {
- next if /^\s*#/;
- if (/^\s*\@/) {
- if (/^\s*\@version\s*(\S*)/) {
- $self->{versionTable} ||= $1;
- }
- elsif (/^\s*\@variable\s+(\S*)/) { # since UTS #10-9
- $self->{variableTable} ||= $1;
- }
- elsif (/^\s*\@alternate\s+(\S*)/) { # till UTS #10-8
- $self->{alternateTable} ||= $1;
- }
- elsif (/^\s*\@backwards\s+(\S*)/) {
- push @{ $self->{backwardsTable} }, $1;
- }
- elsif (/^\s*\@forwards\s+(\S*)/) { # parhaps no use
- push @{ $self->{forwardsTable} }, $1;
- }
- elsif (/^\s*\@rearrange\s+(.*)/) { # (\S*) is NG
- push @{ $self->{rearrangeTable} }, _getHexArray($1);
- }
+ while (my $line = <$fh>) {
+ next if $line =~ /^\s*#/;
+ unless ($line =~ s/^\s*\@//) {
+ $self->parseEntry($line);
next;
}
- $self->parseEntry($_);
+
+ # matched ^\s*\@
+ if ($line =~ /^version\s*(\S*)/) {
+ $self->{versionTable} ||= $1;
+ }
+ elsif ($line =~ /^variable\s+(\S*)/) { # since UTS #10-9
+ $self->{variableTable} ||= $1;
+ }
+ elsif ($line =~ /^alternate\s+(\S*)/) { # till UTS #10-8
+ $self->{alternateTable} ||= $1;
+ }
+ elsif ($line =~ /^backwards\s+(\S*)/) {
+ push @{ $self->{backwardsTable} }, $1;
+ }
+ elsif ($line =~ /^forwards\s+(\S*)/) { # parhaps no use
+ push @{ $self->{forwardsTable} }, $1;
+ }
+ elsif ($line =~ /^rearrange\s+(.*)/) { # (\S*) is NG
+ push @{ $self->{rearrangeTable} }, _getHexArray($1);
+ }
}
- close $fk;
+ close $fh;
}
my @wt = _getHexArray($arr);
push @key, pack(VCE_TEMPLATE, $var, @wt);
$is_L3_ignorable = FALSE
- if $wt[0] + $wt[1] + $wt[2] != 0;
- # if $arr !~ /[1-9A-Fa-f]/; NG
- # Conformance Test shows L3-ignorable is completely ignorable.
+ if $wt[0] || $wt[1] || $wt[2];
+ # Conformance Test for 3.1.1 and 4.0.0 shows Level 3 ignorable
+ # is completely ignorable.
# For expansion, an entry $is_L3_ignorable
# if and only if "all" CEs are [.0000.0000.0000].
}
- $self->{mapping}{$entry} = \@key;
+ $self->{mapping}{$entry} = $is_L3_ignorable ? [] : \@key;
if (@uv > 1) {
(!$self->{maxlength}{$uv[0]} || $self->{maxlength}{$uv[0]} < @uv)
and $self->{maxlength}{$uv[0]} = @uv;
}
- else {
- $is_L3_ignorable
- ? ($self->{L3_ignorable}{$uv[0]} = TRUE)
- : ($self->{L3_ignorable}{$uv[0]} and
- $self->{L3_ignorable}{$uv[0]} = FALSE); # &&= stores key.
- }
}
##
-## arrayref[weights] = varCE(VCE)
+## VCE = _varCE(variable term, VCE)
##
-sub varCE
+sub _varCE
{
- my $self = shift;
- my($var, @wt) = unpack(VCE_TEMPLATE, shift);
-
- $self->{variable} eq 'blanked' ?
- $var ? [Var1Wt, 0, 0, $wt[3]] : \@wt :
- $self->{variable} eq 'non-ignorable' ?
- \@wt :
- $self->{variable} eq 'shifted' ?
- $var ? [Var1Wt, 0, 0, $wt[0] ]
- : [ @wt[0..2], $wt[0]+$wt[1]+$wt[2] ? Shift4Wt : 0 ] :
- $self->{variable} eq 'shift-trimmed' ?
- $var ? [Var1Wt, 0, 0, $wt[0] ] : [ @wt[0..2], 0 ] :
- croak "$PACKAGE unknown variable name: $self->{variable}";
+ my $vbl = shift;
+ my $vce = shift;
+ if ($vbl eq 'non-ignorable') {
+ return $vce;
+ }
+ my ($var, @wt) = unpack VCE_TEMPLATE, $vce;
+
+ if ($var) {
+ return pack(VCE_TEMPLATE, $var, 0, 0, 0,
+ $vbl eq 'blanked' ? $wt[3] : $wt[0]);
+ }
+ elsif ($vbl eq 'blanked') {
+ return $vce;
+ }
+ else {
+ return pack(VCE_TEMPLATE, $var, @wt[0..2],
+ $vbl eq 'shifted' && $wt[0]+$wt[1]+$wt[2] ? Shift4Wt : 0);
+ }
}
sub viewSortKey
my $map = $self->{mapping};
my $max = $self->{maxlength};
my $reH = $self->{rearrangeHash};
- my $ign = $self->{L3_ignorable};
- my $ver9 = $self->{UCA_Version} >= 9;
+ my $ver9 = $self->{UCA_Version} >= 9 && $self->{UCA_Version} <= 11;
my ($str, @buf);
}
}
- if ($ver9) {
- # To remove a character marked as a completely ignorable.
- for (my $i = 0; $i < @src; $i++) {
- $src[$i] = undef if $ign->{ $src[$i] };
- }
+ # remove a code point marked as a completely ignorable.
+ for (my $i = 0; $i < @src; $i++) {
+ $src[$i] = undef
+ if _isIllegal($src[$i]) || ($ver9 &&
+ $map->{ $src[$i] } && @{ $map->{ $src[$i] } } == 0);
}
for (my $i = 0; $i < @src; $i++) {
- next if _isIllegal($src[$i]);
+ my $jcps = $src[$i];
+
+ # skip removed code point
+ if (! defined $jcps) {
+ if ($wLen && @buf) {
+ $buf[-1][2] = $i + 1;
+ }
+ next;
+ }
my $i_orig = $i;
- my $jcps = $src[$i];
- if ($max->{$jcps}) { # contract
+ # find contraction
+ if ($max->{$jcps}) {
my $temp_jcps = $jcps;
my $jcpsLen = 1;
my $maxLen = $max->{$jcps};
}
}
- if ($wLen) {
- for (my $p = $i + 1; $p < @src; $p++) {
- last if defined $src[$p];
- $i = $p;
+ # skip completely ignorable
+ if ($map->{$jcps} && @{ $map->{$jcps} } == 0) {
+ if ($wLen && @buf) {
+ $buf[-1][2] = $i + 1;
}
+ next;
}
push @buf, $wLen ? [$jcps, $i_orig, $i + 1] : $jcps;
##
-## list of arrayrefs of weights = getWt(JCPS)
+## list of VCE = getWt(JCPS)
##
sub getWt
{
my $self = shift;
my $u = shift;
+ my $vbl = $self->{variable};
my $map = $self->{mapping};
my $der = $self->{derivCode};
return if !defined $u;
- return map($self->varCE($_), @{ $map->{$u} })
+ return map(_varCE($vbl, $_), @{ $map->{$u} })
if $map->{$u};
# JCPS must not be a contraction, then it's a code point.
$map->{$_} ? @{ $map->{$_} } : $der->($_);
} @decH);
}
- return map $self->varCE($_), @hangulCE;
+ return map _varCE($vbl, $_), @hangulCE;
}
- elsif (CJK_UidIni <= $u && $u <= CJK_UidFin ||
- CJK_ExtAIni <= $u && $u <= CJK_ExtAFin ||
- CJK_ExtBIni <= $u && $u <= CJK_ExtBFin) {
+ elsif (_isUIdeo($u, $self->{UCA_Version})) {
my $cjk = $self->{overrideCJK};
- return map $self->varCE($_),
+ return map _varCE($vbl, $_),
$cjk
? map(pack(VCE_TEMPLATE, NON_VAR, @$_), &$cjk($u))
- : defined $cjk && $self->{UCA_Version} <= 8 && $u <= BMP_Max
- ? pack(VCE_TEMPLATE, NON_VAR, $u, Min2Wt, Min3Wt, $u)
+ : defined $cjk && $self->{UCA_Version} <= 8 && $u < 0x10000
+ ? _uideoCE_8($u)
: $der->($u);
}
else {
- return map $self->varCE($_), $der->($u);
+ return map _varCE($vbl, $_), $der->($u);
}
}
my $self = shift;
my $lev = $self->{level};
my $rEnt = $self->splitEnt(shift); # get an arrayref of JCPS
- my $ver9 = $self->{UCA_Version} >= 9;
- my $v2i = $self->{variable} ne 'non-ignorable';
-
- # weight arrays
- my (@wts, @buf, $last_is_variable);
+ my $v2i = $self->{UCA_Version} >= 9 &&
+ $self->{variable} ne 'non-ignorable';
+ my @buf; # weight arrays
if ($self->{hangul_terminator}) {
my $preHST = '';
foreach my $jcps (@$rEnt) {
$preHST =~ /V\z/ && $curHST =~ /^L/ ||
$preHST =~ /T\z/ && $curHST =~ /^[LV]/) {
- push @wts, $self->varCE_HangulTerm;
+ push @buf, $self->getWtHangulTerm();
}
$preHST = $curHST;
- push @wts, $self->getWt($jcps);
+ push @buf, $self->getWt($jcps);
}
$preHST # end at hangul
- and push @wts, $self->varCE_HangulTerm;
+ and push @buf, $self->getWtHangulTerm();
}
else {
foreach my $jcps (@$rEnt) {
- push @wts, $self->getWt($jcps);
+ push @buf, $self->getWt($jcps);
}
}
- foreach my $wt (@wts) {
- if ($v2i && $ver9) {
- if ($wt->[0] == 0) { # ignorable
+ # make sort key
+ my @ret = ([],[],[],[]);
+ my $last_is_variable;
+
+ foreach my $vwt (@buf) {
+ my($var, @wt) = unpack(VCE_TEMPLATE, $vwt);
+
+ # "Ignorable (L1, L2) after Variable" since track. v. 9
+ if ($v2i) {
+ if ($var) {
+ $last_is_variable = TRUE;
+ }
+ elsif (!$wt[0]) { # ignorable
next if $last_is_variable;
- } else {
- $last_is_variable = ($wt->[0] == Var1Wt);
+ }
+ else {
+ $last_is_variable = FALSE;
}
}
- push @buf, $wt;
- }
-
- # make sort key
- my @ret = ([],[],[],[]);
- foreach my $v (0..$lev-1) {
- foreach my $b (@buf) {
- push @{ $ret[$v] }, $b->[$v]
- if 0 < $b->[$v];
+ foreach my $v (0..$lev-1) {
+ 0 < $wt[$v] and push @{ $ret[$v] }, $wt[$v];
}
}
# modification of tertiary weights
if ($self->{upper_before_lower}) {
- foreach (@{ $ret[2] }) {
- if (0x8 <= $_ && $_ <= 0xC) { $_ -= 6 } # lower
- elsif (0x2 <= $_ && $_ <= 0x6) { $_ += 6 } # upper
- elsif ($_ == 0x1C) { $_ += 1 } # square upper
- elsif ($_ == 0x1D) { $_ -= 1 } # square lower
+ foreach my $w (@{ $ret[2] }) {
+ if (0x8 <= $w && $w <= 0xC) { $w -= 6 } # lower
+ elsif (0x2 <= $w && $w <= 0x6) { $w += 6 } # upper
+ elsif ($w == 0x1C) { $w += 1 } # square upper
+ elsif ($w == 0x1D) { $w -= 1 } # square lower
}
}
if ($self->{katakana_before_hiragana}) {
- foreach (@{ $ret[2] }) {
- if (0x0F <= $_ && $_ <= 0x13) { $_ -= 2 } # katakana
- elsif (0x0D <= $_ && $_ <= 0x0E) { $_ += 5 } # hiragana
+ foreach my $w (@{ $ret[2] }) {
+ if (0x0F <= $w && $w <= 0x13) { $w -= 2 } # katakana
+ elsif (0x0D <= $w && $w <= 0x0E) { $w += 5 } # hiragana
}
}
}
+sub _derivCE_14 {
+ my $u = shift;
+ my $base =
+ (CJK_UidIni <= $u && $u <= CJK_UidF41)
+ ? 0xFB40 : # CJK
+ (CJK_ExtAIni <= $u && $u <= CJK_ExtAFin ||
+ CJK_ExtBIni <= $u && $u <= CJK_ExtBFin)
+ ? 0xFB80 # CJK ext.
+ : 0xFBC0; # others
+
+ my $aaaa = $base + ($u >> 15);
+ my $bbbb = ($u & 0x7FFF) | 0x8000;
+ return
+ pack(VCE_TEMPLATE, NON_VAR, $aaaa, Min2Wt, Min3Wt, $u),
+ pack(VCE_TEMPLATE, NON_VAR, $bbbb, 0, 0, $u);
+}
+
sub _derivCE_9 {
my $u = shift;
my $base =
pack(VCE_TEMPLATE, NON_VAR, $bbbb, 0, 0, $code);
}
+sub _uideoCE_8 {
+ my $u = shift;
+ return pack(VCE_TEMPLATE, NON_VAR, $u, Min2Wt, Min3Wt, $u);
+}
-sub varCE_HangulTerm {
+sub _isUIdeo {
+ my ($u, $uca_vers) = @_;
+ return(
+ (CJK_UidIni <= $u &&
+ ($uca_vers >= 14 ? ( $u <= CJK_UidF41) : ($u <= CJK_UidFin)))
+ ||
+ (CJK_ExtAIni <= $u && $u <= CJK_ExtAFin)
+ ||
+ (CJK_ExtBIni <= $u && $u <= CJK_ExtBFin)
+ );
+}
+
+
+sub getWtHangulTerm {
my $self = shift;
- return $self->varCE(pack(VCE_TEMPLATE,
- NON_VAR, $self->{hangul_terminator}, 0,0,0));
+ return _varCE($self->{variable},
+ pack(VCE_TEMPLATE, NON_VAR, $self->{hangul_terminator}, 0,0,0));
}
#
sub _decompHangul {
my $code = shift;
- my $SIndex = $code - Hangul_SBase;
- my $LIndex = int( $SIndex / Hangul_NCount);
- my $VIndex = int(($SIndex % Hangul_NCount) / Hangul_TCount);
- my $TIndex = $SIndex % Hangul_TCount;
+ my $si = $code - Hangul_SBase;
+ my $li = int( $si / Hangul_NCount);
+ my $vi = int(($si % Hangul_NCount) / Hangul_TCount);
+ my $ti = $si % Hangul_TCount;
return (
- Hangul_LBase + $LIndex,
- Hangul_VBase + $VIndex,
- $TIndex ? (Hangul_TBase + $TIndex) : (),
+ Hangul_LBase + $li,
+ Hangul_VBase + $vi,
+ $ti ? (Hangul_TBase + $ti) : (),
);
}
my $grob = shift;
my $lev = $self->{level};
- my $ver9 = $self->{UCA_Version} >= 9;
- my $v2i = $self->{variable} ne 'non-ignorable';
+ my $v2i = $self->{UCA_Version} >= 9 &&
+ $self->{variable} ne 'non-ignorable';
if (! @$subE) {
my $temp = $pos <= 0 ? 0 : $len <= $pos ? $len : $pos;
? map([$_, 0], $temp..$len)
: wantarray ? ($temp,0) : $temp;
}
- if ($len < $pos) {
- return wantarray ? () : NOMATCHPOS;
- }
+ $len < $pos
+ and return wantarray ? () : NOMATCHPOS;
my $strE = $self->splitEnt($pos ? substr($str, $pos) : $str, TRUE);
- if (! @$strE) {
- return wantarray ? () : NOMATCHPOS;
- }
- my $last_is_variable;
- my(@strWt, @iniPos, @finPos, @subWt, @g_ret);
+ @$strE
+ or return wantarray ? () : NOMATCHPOS;
- $last_is_variable = FALSE;
- for my $wt (map $self->getWt($_), @$subE) {
- my $to_be_pushed = _nonIgnorAtLevel($wt,$lev);
+ my(@strWt, @iniPos, @finPos, @subWt, @g_ret);
- if ($v2i && $ver9) {
- if ($wt->[0] == 0) {
+ my $last_is_variable;
+ for my $vwt (map $self->getWt($_), @$subE) {
+ my($var, @wt) = unpack(VCE_TEMPLATE, $vwt);
+ my $to_be_pushed = _nonIgnorAtLevel(\@wt,$lev);
+
+ # "Ignorable (L1, L2) after Variable" since track. v. 9
+ if ($v2i) {
+ if ($var) {
+ $last_is_variable = TRUE;
+ }
+ elsif (!$wt[0]) { # ignorable
$to_be_pushed = FALSE if $last_is_variable;
- } else {
- $last_is_variable = ($wt->[0] == Var1Wt);
+ }
+ else {
+ $last_is_variable = FALSE;
}
}
- if (@subWt && $wt->[0] == 0) {
- push @{ $subWt[-1] }, $wt if $to_be_pushed;
+ if (@subWt && !$var && !$wt[0]) {
+ push @{ $subWt[-1] }, \@wt if $to_be_pushed;
} else {
- $wt->[0] = 0 if $wt->[0] == Var1Wt;
- push @subWt, [ $wt ];
+ push @subWt, [ \@wt ];
}
}
my $count = 0;
my $end = @$strE - 1;
- $last_is_variable = FALSE;
-
+ $last_is_variable = FALSE; # reuse
for (my $i = 0; $i <= $end; ) { # no $i++
my $found_base = 0;
# fetch a grapheme
while ($i <= $end && $found_base == 0) {
- for my $wt ($self->getWt($strE->[$i][0])) {
- my $to_be_pushed = _nonIgnorAtLevel($wt,$lev);
-
- if ($v2i && $ver9) {
- if ($wt->[0] == 0) {
+ for my $vwt ($self->getWt($strE->[$i][0])) {
+ my($var, @wt) = unpack(VCE_TEMPLATE, $vwt);
+ my $to_be_pushed = _nonIgnorAtLevel(\@wt,$lev);
+
+ # "Ignorable (L1, L2) after Variable" since track. v. 9
+ if ($v2i) {
+ if ($var) {
+ $last_is_variable = TRUE;
+ }
+ elsif (!$wt[0]) { # ignorable
$to_be_pushed = FALSE if $last_is_variable;
- } else {
- $last_is_variable = ($wt->[0] == Var1Wt);
+ }
+ else {
+ $last_is_variable = FALSE;
}
}
- if (@strWt && $wt->[0] == 0) {
- push @{ $strWt[-1] }, $wt if $to_be_pushed;
+ if (@strWt && !$var && !$wt[0]) {
+ push @{ $strWt[-1] }, \@wt if $to_be_pushed;
$finPos[-1] = $strE->[$i][2];
} elsif ($to_be_pushed) {
- $wt->[0] = 0 if $wt->[0] == Var1Wt;
- push @strWt, [ $wt ];
+ push @strWt, [ \@wt ];
push @iniPos, $found_base ? NOMATCHPOS : $strE->[$i][1];
$finPos[-1] = NOMATCHPOS if $found_base;
push @finPos, $strE->[$i][2];
=head1 DESCRIPTION
-This module is an implementation
-of Unicode Technical Standard #10 (UTS #10)
-"Unicode Collation Algorithm."
+This module is an implementation of Unicode Technical Standard #10
+(a.k.a. UTS #10) - Unicode Collation Algorithm (a.k.a. UCA).
=head2 Constructor and Tailoring
=item UCA_Version
-If the tracking version number of the older UCA is given,
-the older behavior of that tracking version is emulated on collating.
+If the tracking version number of UCA is given,
+behavior of that tracking version is emulated on collating.
If omitted, the return value of C<UCA_Version()> is used.
+C<UCA_Version()> should return the latest tracking version supported.
+
+The supported tracking version: 8, 9, 11, or 14.
+
+ UCA Unicode Standard DUCET (@version)
+ ---------------------------------------------------
+ 8 3.1 3.0.1 (3.0.1d9)
+ 9 3.1 with Corrigendum 3 3.1.1 (3.1.1)
+ 11 4.0 4.0.0 (4.0.0)
+ 14 4.1.0 4.1.0 (4.1.0)
+
+Note: Recent UTS #10 renames "Tracking Version" to "Revision."
+
+=item alternate
-The supported tracking version: 8, 9, or 11.
+-- see 3.2.2 Alternate Weighting, version 8 of UTS #10
-B<This parameter may be removed in the future version,
-as switching the algorithm would affect the performance.>
+For backward compatibility, C<alternate> (old name) can be used
+as an alias for C<variable>.
=item backwards
mapping to collation elements is overrided.
If it does not exist, the mapping is defined additionally.
- entry => <<'ENTRIES', # use the UCA file format
-00E6 ; [.0861.0020.0002.00E6] [.08B1.0020.0002.00E6] # ligature <ae> as <a><e>
-0063 0068 ; [.0893.0020.0002.0063] # "ch" in traditional Spanish
-0043 0068 ; [.0893.0020.0008.0043] # "Ch" in traditional Spanish
-ENTRIES
+ entry => <<'ENTRY', # for DUCET v4.0.0 (allkeys-4.0.0.txt)
+0063 0068 ; [.0E6A.0020.0002.0063] # ch
+0043 0068 ; [.0E6A.0020.0007.0043] # Ch
+0043 0048 ; [.0E6A.0020.0008.0043] # CH
+006C 006C ; [.0F4C.0020.0002.006C] # ll
+004C 006C ; [.0F4C.0020.0007.004C] # Ll
+004C 004C ; [.0F4C.0020.0008.004C] # LL
+00F1 ; [.0F7B.0020.0002.00F1] # n-tilde
+006E 0303 ; [.0F7B.0020.0002.00F1] # n-tilde
+00D1 ; [.0F7B.0020.0008.00D1] # N-tilde
+004E 0303 ; [.0F7B.0020.0008.00D1] # N-tilde
+ENTRY
+
+ entry => <<'ENTRY', # for DUCET v4.0.0 (allkeys-4.0.0.txt)
+00E6 ; [.0E33.0020.0002.00E6][.0E8B.0020.0002.00E6] # ae ligature as <a><e>
+00C6 ; [.0E33.0020.0008.00C6][.0E8B.0020.0008.00C6] # AE ligature as <A><E>
+ENTRY
B<NOTE:> The code point in the UCA file format (before C<';'>)
-B<must> be a Unicode code point, but not a native code point.
+B<must> be a Unicode code point (defined as hexadecimal),
+but not a native code point.
So C<0063> must always denote C<U+0063>,
but not a character of C<"\x63">.
+Weighting may vary depending on collation element table.
+So ensure the weights defined in C<entry> will be consistent with
+those in the collation element table loaded via C<table>.
+
+In DUCET v4.0.0, primary weight of C<C> is C<0E60>
+and that of C<D> is C<0E6D>. So setting primary weight of C<CH> to C<0E6A>
+(as a value between C<0E60> and C<0E6D>)
+makes ordering as C<C E<lt> CH E<lt> D>.
+Exactly speaking DUCET already has some characters between C<C> and C<D>:
+C<small capital C> (C<U+1D04>) with primary weight C<0E64>,
+C<c-hook/C-hook> (C<U+0188/U+0187>) with C<0E65>,
+and C<c-curl> (C<U+0255>) with C<0E69>.
+Then primary weight C<0E6A> for C<CH> makes C<CH>
+ordered between C<c-curl> and C<D>.
+
=item hangul_terminator
--- see Condition B.2. in 7.1.4 Trailing Weights, UTS #10.
+-- see 7.1.4 Trailing Weights, UTS #10.
If a true value is given (non-zero but should be positive),
it will be added as a terminator primary weight to the end of
These characters may need terminator included in a collation element
table beforehand.
-=item ignoreName
-
=item ignoreChar
--- see Completely Ignorable, 3.2.2 Variable Weighting, UTS #10.
+=item ignoreName
+
+-- see 3.2.2 Variable Weighting, UTS #10.
Makes the entry in the table completely ignorable;
i.e. as if the weights were zero at all level.
+Through C<ignoreChar>, any character matching C<qr/$ignoreChar/>
+will be ignored. Through C<ignoreName>, any character whose name
+(given in the C<table> file as a comment) matches C<qr/$ignoreName/>
+will be ignored.
+
E.g. when 'a' and 'e' are ignorable,
'element' is equal to 'lament' (or 'lmnt').
+=item katakana_before_hiragana
+
+-- see 7.3.1 Tertiary Weight Table, UTS #10.
+
+By default, hiragana is before katakana.
+If the parameter is made true, this is reversed.
+
+B<NOTE>: This parameter simplemindedly assumes that any hiragana/katakana
+distinctions must occur in level 3, and their weights at level 3 must be
+same as those mentioned in 7.3.1, UTS #10.
+If you define your collation elements which violate this requirement,
+this parameter does not work validly.
+
=item level
--- see 4.3 Form a sort key for each string, UTS #10.
+-- see 4.3 Form Sort Key, UTS #10.
Set the maximum level.
Any higher levels than the specified one are ignored.
=item normalization
--- see 4.1 Normalize each input string, UTS #10.
+-- see 4.1 Normalize, UTS #10.
If specified, strings are normalized before preparation of sort keys
(the normalization is executed after preprocess).
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).
-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>.
+if any normalization is not desired). Under C<(normalization =E<gt> undef)>,
+only contiguous contractions are resolved;
+e.g. even if C<A-ring> (and C<A-ring-cedilla>) is ordered after C<Z>,
+C<A-cedilla-ring> would be primary equal to C<A>.
In this point,
C<(normalization =E<gt> undef, preprocess =E<gt> sub { NFD(shift) })>
B<is not> equivalent to C<(normalization =E<gt> 'NFD')>.
-- see 7.1 Derived Collation Elements, UTS #10.
By default, CJK Unified Ideographs are ordered in Unicode codepoint order
-(but C<CJK Unified Ideographs> [C<U+4E00> to C<U+9FA5>] are lesser than
-C<CJK Unified Ideographs Extension> [C<U+3400> to C<U+4DB5> and
-C<U+20000> to C<U+2A6D6>].
+but C<CJK Unified Ideographs> (if C<UCA_Version> is 8 to 11, its range is
+C<U+4E00..U+9FA5>; if C<UCA_Version> is 14, its range is C<U+4E00..U+9FBB>)
+are lesser than C<CJK Unified Ideographs Extension> (its range is
+C<U+3400..U+4DB5> and C<U+20000..U+2A6D6>).
Through C<overrideCJK>, ordering of CJK Unified Ideographs can be overrided.
-- see 7.1 Derived Collation Elements, UTS #10.
-By default, Hangul Syllables are decomposed into Hangul Jamo.
+By default, Hangul Syllables are decomposed into Hangul Jamo,
+even if C<(normalization =E<gt> undef)>.
But the mapping of Hangul Syllables may be overrided.
-This tag works like C<overrideCJK>, so see there for examples.
+This parameter works like C<overrideCJK>, so see there for examples.
If you want to override the mapping of Hangul Syllables,
-the Normalization Forms D and KD are not appropriate
-(they will be decomposed before overriding).
+NFD, NFKD, and FCD are not appropriate,
+since they will decompose Hangul Syllables before overriding.
If C<undef> is passed explicitly as the value for this key,
weight for Hangul Syllables is treated as undefined
-- see 3.1.3 Rearrangement, UTS #10.
Characters that are not coded in logical order and to be rearranged.
-By default,
+If C<UCA_Version> is equal to or lesser than 11, default is:
rearrange => [ 0x0E40..0x0E44, 0x0EC0..0x0EC4 ],
-If you want to disallow any rearrangement,
-pass C<undef> or C<[]> (a reference to an empty list)
-as the value for this key.
+If you want to disallow any rearrangement, pass C<undef> or C<[]>
+(a reference to empty list) as the value for this key.
+
+If C<UCA_Version> is equal to 14, default is C<[]> (i.e. no rearrangement).
B<According to the version 9 of UCA, this parameter shall not be used;
but it is not warned at present.>
-- see 3.2 Default Unicode Collation Element Table, UTS #10.
You can use another collation element table if desired.
-The table file must be put into a directory
-where F<Unicode/Collate.pm> is installed; e.g. into
-F<perl/lib/Unicode/Collate/> if you have F<perl/lib/Unicode/Collate.pm>.
-By default, the filename F<allkeys.txt> is used.
+The table file should locate in the F<Unicode/Collate> directory
+on C<@INC>. Say, if the filename is F<Foo.txt>,
+the table file is searched as F<Unicode/Collate/Foo.txt> in C<@INC>.
+
+By default, F<allkeys.txt> (as the filename of DUCET) is used.
+If you will prepare your own table file, any name other than F<allkeys.txt>
+may be better to avoid namespace conflict.
If C<undef> is passed explicitly as the value for this key,
no file is read (but you can define collation elements via C<entry>).
ENTRIES
);
-=item undefName
+If C<ignoreName> or C<undefName> is used, character names should be
+specified as a comment (following C<#>) on each line.
=item undefChar
+=item undefName
+
-- see 6.3.4 Reducing the Repertoire, UTS #10.
Undefines the collation element as if it were unassigned in the table.
But, it'd be better to ignore characters
unfamiliar to you and maybe never used.
-=item katakana_before_hiragana
+Through C<undefChar>, any character matching C<qr/$undefChar/>
+will be undefined. Through C<undefName>, any character whose name
+(given in the C<table> file as a comment) matches C<qr/$undefName/>
+will be undefined.
-=item upper_before_lower
+ex. Collation weights for beyond-BMP characters are not stored in object:
--- see 6.6 Case Comparisons; 7.3.1 Tertiary Weight Table, UTS #10.
+ undefChar => qr/[^\0-\x{fffd}]/,
-By default, lowercase is before uppercase
-and hiragana is before katakana.
+=item upper_before_lower
-If the tag is made true, this is reversed.
+-- see 6.6 Case Comparisons, UTS #10.
-B<NOTE>: These tags simplemindedly assume
-any lowercase/uppercase or hiragana/katakana distinctions
-must occur in level 3, and their weights at level 3
-must be same as those mentioned in 7.3.1, UTS #10.
-If you define your collation elements which violate this requirement,
-these tags don't work validly.
+By default, lowercase is before uppercase.
+If the parameter is made true, this is reversed.
-=item variable
+B<NOTE>: This parameter simplemindedly assumes that any lowercase/uppercase
+distinctions must occur in level 3, and their weights at level 3 must be
+same as those mentioned in 7.3.1, UTS #10.
+If you define your collation elements which differs from this requirement,
+this parameter doesn't work validly.
-=item alternate
+=item variable
-- see 3.2.2 Variable Weighting, UTS #10.
-(the title in UCA version 8: Alternate Weighting)
-
This key allows to variable weighting for variable collation elements,
which are marked with an ASTERISK in the table
(NOTE: Many punction marks and symbols are variable in F<allkeys.txt>).
'Blanked' Variable elements are made ignorable at levels 1 through 3;
considered at the 4th level.
- 'Non-ignorable' Variable elements are not reset to ignorable.
+ 'Non-Ignorable' Variable elements are not reset to ignorable.
'Shifted' Variable elements are made ignorable at levels 1 through 3
their level 4 weight is replaced by the old level 1 weight.
'Shift-Trimmed' Same as 'shifted', but all FFFF's at the 4th level
are trimmed.
-For backward compatibility, C<alternate> can be used as an alias
-for C<variable>.
-
=back
=head2 Methods for Collation
=item C<$sortKey = $Collator-E<gt>getSortKey($string)>
--- see 4.3 Form a sort key for each string, UTS #10.
+-- see 4.3 Form Sort Key, UTS #10.
Returns a sort key.
=item C<$sortKeyForm = $Collator-E<gt>viewSortKey($string)>
+Converts a sorting key into its representation form.
+If C<UCA_Version> is 8, the output is slightly different.
+
use Unicode::Collate;
my $c = Unicode::Collate->new();
print $c->viewSortKey("Perl"),"\n";
# [0B67 0A65 0B7F 0B03 | 0020 0020 0020 0020 | 0008 0002 0002 0002 | FFFF FFFF FFFF FFFF]
# Level 1 Level 2 Level 3 Level 4
- (If C<UCA_Version> is 8, the output is slightly different.)
-
=back
=head2 Methods for Searching
-B<DISCLAIMER:> If C<preprocess> or C<normalization> tag is true
+B<DISCLAIMER:> If C<preprocess> or C<normalization> parameter is true
for C<$Collator>, calling these methods (C<index>, C<match>, C<gmatch>,
C<subst>, C<gsubst>) is croaked,
as the position and the length might differ
from those on the specified string.
-(And C<rearrange> and C<hangul_terminator> tags are neglected.)
+(And C<rearrange> and C<hangul_terminator> parameters are neglected.)
The C<match>, C<gmatch>, C<subst>, C<gsubst> methods work
like C<m//>, C<m//g>, C<s///>, C<s///g>, respectively,
}
and get C<"muß"> in C<$match> since C<"muß">
-is primary equal to C<"MÜSS">.
+is primary equal to C<"MÜSS">.
=item C<$match_ref = $Collator-E<gt>match($string, $substring)>
print "doesn't match.\n";
}
- or
+ or
if (($match) = $Collator->match($str, $sub)) { # list context
print "matches [$match].\n";
my $Collator = Unicode::Collate->new( normalization => undef, level => 1 );
# (normalization => undef) is REQUIRED.
- my $str = "Camel ass came\x{301}l CAMEL horse cAm\0E\0L...";
+ my $str = "Camel donkey zebra came\x{301}l CAMEL horse cAm\0E\0L...";
$Collator->gsubst($str, "camel", sub { "<b>$_[0]</b>" });
- # now $str is "<b>Camel</b> ass <b>came\x{301}l</b> <b>CAMEL</b> horse <b>cAm\0E\0L</b>...";
+ # now $str is "<b>Camel</b> donkey zebra <b>came\x{301}l</b> <b>CAMEL</b> horse <b>cAm\0E\0L</b>...";
# i.e., all the camels are made bold-faced.
=back
=back
-=head2 EXPORT
+=head1 EXPORT
+
+No method will be exported.
+
+=head1 INSTALL
+
+Though this module can be used without any C<table> file,
+to use this module easily, it is recommended to install a table file
+in the UCA format, by copying it under the directory
+<a place in @INC>/Unicode/Collate.
-None by default.
+The most preferable one is "The Default Unicode Collation Element Table"
+(aka DUCET), available from the Unicode Consortium's website:
-=head2 CAVEAT
+ http://www.unicode.org/Public/UCA/
-Use of the C<normalization> parameter requires
-the B<Unicode::Normalize> module.
+ http://www.unicode.org/Public/UCA/latest/allkeys.txt (latest version)
+
+If DUCET is not installed, it is recommended to copy the file
+from http://www.unicode.org/Public/UCA/latest/allkeys.txt
+to <a place in @INC>/Unicode/Collate/allkeys.txt
+manually.
+
+=head1 CAVEATS
+
+=over 4
+
+=item Normalization
+
+Use of the C<normalization> parameter requires the B<Unicode::Normalize>
+module (see L<Unicode::Normalize>).
If you need not it (say, in the case when you need not
handle any combining characters),
-- see 6.5 Avoiding Normalization, UTS #10.
-=head2 Conformance Test
+=item Conformance Test
The Conformance Test for the UCA is available
under L<http://www.unicode.org/Public/UCA/>.
B<Unicode::Normalize is required to try The Conformance Test.>
-=head1 AUTHOR
+=back
-SADAHIRO Tomoyuki <SADAHIRO@cpan.org>
+=head1 AUTHOR, COPYRIGHT AND LICENSE
- http://homepage1.nifty.com/nomenclator/perl/
+The Unicode::Collate module for perl was written by SADAHIRO Tomoyuki,
+<SADAHIRO@cpan.org>. This module is Copyright(C) 2001-2005,
+SADAHIRO Tomoyuki. Japan. All rights reserved.
- Copyright(C) 2001-2003, 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.
- This library 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 directly
+from L<http://www.unicode.org/Public/UCA/4.1.0/allkeys.txt>.
+This file is Copyright (c) 1991-2005 Unicode, Inc. All rights reserved.
+Distributed under the Terms of Use in L<http://www.unicode.org/copyright.html>.
=head1 SEE ALSO
L<http://www.unicode.org/reports/tr15/>
-=item L<Unicode::Normalize>
-
=back
=cut
projects / p5sagit/p5-mst-13.2.git / blobdiff