Upgrade Unicode-Normalize from version 1.21 to 1.23
authorSteve Hay <steve.m.hay@googlemail.com>
Tue, 27 Oct 2015 17:38:55 +0000 (17:38 +0000)
committerSteve Hay <steve.m.hay@googlemail.com>
Tue, 27 Oct 2015 17:38:55 +0000 (17:38 +0000)
17 files changed:
MANIFEST
Porting/Maintainers.pl
cpan/Unicode-Normalize/Makefile.PL
cpan/Unicode-Normalize/Normalize.pm
cpan/Unicode-Normalize/Normalize.xs [new file with mode: 0644]
cpan/Unicode-Normalize/mkheader [new file with mode: 0644]
cpan/Unicode-Normalize/t/fcdc.t
cpan/Unicode-Normalize/t/func.t
cpan/Unicode-Normalize/t/illegal.t
cpan/Unicode-Normalize/t/norm.t
cpan/Unicode-Normalize/t/null.t
cpan/Unicode-Normalize/t/partial1.t
cpan/Unicode-Normalize/t/partial2.t
cpan/Unicode-Normalize/t/proto.t
cpan/Unicode-Normalize/t/split.t
cpan/Unicode-Normalize/t/test.t
cpan/Unicode-Normalize/t/tie.t

index 60ce570..9145d92 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2908,7 +2908,9 @@ cpan/Unicode-Collate/t/variable.t         Unicode::Collate
 cpan/Unicode-Collate/t/version.t               Unicode::Collate
 cpan/Unicode-Collate/t/view.t                  Unicode::Collate
 cpan/Unicode-Normalize/Makefile.PL     Unicode::Normalize
+cpan/Unicode-Normalize/mkheader                Unicode::Normalize
 cpan/Unicode-Normalize/Normalize.pm    Unicode::Normalize
+cpan/Unicode-Normalize/Normalize.xs    Unicode::Normalize
 cpan/Unicode-Normalize/t/fcdc.t                Unicode::Normalize
 cpan/Unicode-Normalize/t/form.t                Unicode::Normalize
 cpan/Unicode-Normalize/t/func.t                Unicode::Normalize
index 7c2c06a..26dacab 100755 (executable)
@@ -1243,7 +1243,7 @@ use File::Glob qw(:case);
     },
 
     'Unicode::Normalize' => {
-        'DISTRIBUTION' => 'KHW/Unicode-Normalize-1.21.tar.gz',
+        'DISTRIBUTION' => 'KHW/Unicode-Normalize-1.23.tar.gz',
         'FILES'        => q[cpan/Unicode-Normalize],
     },
 
index a7b247b..d25e92d 100644 (file)
@@ -1,20 +1,54 @@
 require 5.006001;
 use ExtUtils::MakeMaker;
 
+my $clean = {};
+
+my $mm_ver = ExtUtils::MakeMaker->VERSION;
+
+if (-f "Normalize.xs") {
+    print STDERR "Making header files for XS...\n";
+
+    do 'mkheader' or die $@ || "mkheader: $!";
+
+    $clean = { FILES => 'unfcan.h unfcmb.h unfcmp.h unfcpt.h unfexc.h' };
+}
+
 WriteMakefile(
-    'AUTHOR'            => 'SADAHIRO Tomoyuki <SADAHIRO@cpan.org>',
+    ($mm_ver < 6.58)
+    ? ('AUTHOR' => 'SADAHIRO Tomoyuki <SADAHIRO@cpan.org>, Karl Williamson <khw@cpan.org>')
+    : ('AUTHOR' =>         [
+                           'SADAHIRO Tomoyuki <SADAHIRO@cpan.org>',
+                           'Karl Williamson <khw@cpan.org>',
+                           ]),
     'ABSTRACT'          => 'Unicode Normalization Forms',
     'INSTALLDIRS'       => ($] >= 5.007002 && $] < 5.011) ? 'perl' : 'site',
                             # see perl5110delta, @INC reorganization
     'LICENSE'           => 'perl',
     'NAME'              => 'Unicode::Normalize',
     'VERSION_FROM'      => 'Normalize.pm', # finds $VERSION
+    'clean'             => $clean,
+    'depend'            => { 'Normalize.o' => '$(H_FILES)' },
     'PREREQ_PM'         => {
         Carp            => 0,
         constant        => 0,
+        DynaLoader      => 0,
         Exporter        => 0,
         File::Spec      => 0,
         strict          => 0,
         warnings        => 0,
+        SelectSaver     => 0,
     },
+    ($mm_ver < 6.46 ? () : (META_MERGE => {
+        'meta-spec' => { version => 2 },
+        resources       => {
+            repository    => {
+                url  => 'https://github.com/khwilliamson/Unicode-Normalize.git',
+                web  => 'https://github.com/khwilliamson/Unicode-Normalize',
+                type => 'git',
+            },
+            bugtracker    => {
+                web  => 'https://rt.cpan.org/Public/Dist/Display.html?Name=Unicode-Normalize',
+            },
+        },
+    })),
 );
index b828543..62c02b1 100644 (file)
@@ -16,7 +16,7 @@ use Carp;
 
 no warnings 'utf8';
 
-our $VERSION = '1.21';
+our $VERSION = '1.23';
 our $PACKAGE = __PACKAGE__;
 
 our @EXPORT = qw( NFC NFD NFKC NFKD );
@@ -47,523 +47,20 @@ sub pack_U {
 sub unpack_U {
 
     # The empty pack returns an empty UTF-8 string, so the effect is to force
-    # the shifted parameter into being UTF-8.  This shouldn't matter; the
-    # commit messages seem to point to an attempt to get things to work in
-    # EBCDIC in 5.8.
+    # the shifted parameter into being UTF-8.  This allows this to work on
+    # Perl 5.6, where there is no utf8::upgrade().
     return unpack('U*', shift(@_).pack('U*'));
 }
 
-BEGIN {
-    # Starting in v5.20, the tables in lib/unicore are built using the
-    # platform's native character set for code points 0-255.  Things like the
-    # combining class and compositions exclusions are all above 255, so it
-    # doesn't matter for them.
-
-    *pack_unicore = ($] ge 5.020)
-                    ? sub { return pack('W*', @_); }
-                    : \&pack_U;
-
-    *unpack_unicore = ($] ge 5.020)
-                      ? sub { return unpack('W*', $_[0]); }
-                      : \&unpack_U;
-}
-
 require Exporter;
 
-our @ISA = qw(Exporter);
-use File::Spec;
-
-our %Combin;   # $codepoint => $number    : combination class
-our %Canon;    # $codepoint => \@codepoints : canonical decomp.
-our %Compat;   # $codepoint => \@codepoints : compat. decomp.
-our %Compos;   # $1st,$2nd  => $codepoint : composite
-our %Exclus;   # $codepoint => 1          : composition exclusions
-our %Single;   # $codepoint => 1          : singletons
-our %NonStD;   # $codepoint => 1          : non-starter decompositions
-our %Comp2nd;  # $codepoint => 1          : may be composed with a prev char.
-
-# from core Unicode database
-our $Combin = do "unicore/CombiningClass.pl"
-    || do "unicode/CombiningClass.pl"
-    || croak "$PACKAGE: CombiningClass.pl not found";
-our $Decomp = do "unicore/Decomposition.pl"
-    || do "unicode/Decomposition.pl"
-    || croak "$PACKAGE: Decomposition.pl not found";
-
-# CompositionExclusions.txt since Unicode 3.2.0.  Modern perl versions allow
-# one to get this table from Unicode::UCD, so if it ever changes, it might be
-# better to retrieve it from there, rather than hard-coding it here.
-our @CompEx = qw(
-    0958 0959 095A 095B 095C 095D 095E 095F 09DC 09DD 09DF 0A33 0A36
-    0A59 0A5A 0A5B 0A5E 0B5C 0B5D 0F43 0F4D 0F52 0F57 0F5C 0F69 0F76
-    0F78 0F93 0F9D 0FA2 0FA7 0FAC 0FB9 FB1D FB1F FB2A FB2B FB2C FB2D
-    FB2E FB2F FB30 FB31 FB32 FB33 FB34 FB35 FB36 FB38 FB39 FB3A FB3B
-    FB3C FB3E FB40 FB41 FB43 FB44 FB46 FB47 FB48 FB49 FB4A FB4B FB4C
-    FB4D FB4E 2ADC 1D15E 1D15F 1D160 1D161 1D162 1D163 1D164 1D1BB
-    1D1BC 1D1BD 1D1BE 1D1BF 1D1C0
-);
-
-# definition of Hangul constants
-use constant SBase  => 0xAC00;
-use constant SFinal => 0xD7A3; # SBase -1 + SCount
-use constant SCount =>  11172; # LCount * NCount
-use constant NCount =>    588; # VCount * TCount
-use constant LBase  => 0x1100;
-use constant LFinal => 0x1112;
-use constant LCount =>     19;
-use constant VBase  => 0x1161;
-use constant VFinal => 0x1175;
-use constant VCount =>     21;
-use constant TBase  => 0x11A7;
-use constant TFinal => 0x11C2;
-use constant TCount =>     28;
-
-sub decomposeHangul {
-    my $sindex = $_[0] - SBase;
-    my $lindex = int( $sindex / NCount);
-    my $vindex = int(($sindex % NCount) / TCount);
-    my $tindex =      $sindex % TCount;
-    my @ret = (
-       LBase + $lindex,
-       VBase + $vindex,
-      $tindex ? (TBase + $tindex) : (),
-    );
-    return wantarray ? @ret : pack_unicore(@ret);
-}
-
-########## getting full decomposition ##########
-
-## converts string "hhhh hhhh hhhh" to a numeric list
-## (hex digits separated by spaces)
-sub _getHexArray { map hex, $_[0] =~ /\G *([0-9A-Fa-f]+)/g }
-
-while ($Combin =~ /(.+)/g) {
-    my @tab = split /\t/, $1;
-    my $ini = hex $tab[0];
-    if ($tab[1] eq '') {
-       $Combin{$ini} = $tab[2];
-    } else {
-       $Combin{$_} = $tab[2] foreach $ini .. hex($tab[1]);
-    }
-}
-
-while ($Decomp =~ /(.+)/g) {
-    my @tab = split /\t/, $1;
-    my $compat = $tab[2] =~ s/<[^>]+>//;
-    my $dec = [ _getHexArray($tab[2]) ]; # decomposition
-    my $ini = hex($tab[0]); # initial decomposable character
-    my $end = $tab[1] eq '' ? $ini : hex($tab[1]);
-    # ($ini .. $end) is the range of decomposable characters.
-
-    foreach my $u ($ini .. $end) {
-       $Compat{$u} = $dec;
-       $Canon{$u} = $dec if ! $compat;
-    }
-}
-
-for my $s (@CompEx) {
-    my $u = hex $s;
-    next if !$Canon{$u}; # not assigned
-    next if $u == 0xFB1D && !$Canon{0x1D15E}; # 3.0.1 before Corrigendum #2
-    $Exclus{$u} = 1;
-}
-
-foreach my $u (keys %Canon) {
-    my $dec = $Canon{$u};
-
-    if (@$dec == 2) {
-       if ($Combin{ $dec->[0] }) {
-           $NonStD{$u} = 1;
-       } else {
-           $Compos{ $dec->[0] }{ $dec->[1] } = $u;
-           $Comp2nd{ $dec->[1] } = 1 if ! $Exclus{$u};
-       }
-    } elsif (@$dec == 1) {
-       $Single{$u} = 1;
-    } else {
-       my $h = sprintf '%04X', $u;
-       croak("Weird Canonical Decomposition of U+$h");
-    }
-}
-
-# modern HANGUL JUNGSEONG and HANGUL JONGSEONG jamo
-foreach my $j (0x1161..0x1175, 0x11A8..0x11C2) {
-    $Comp2nd{$j} = 1;
-}
-
-sub getCanonList {
-    my @src = @_;
-    my @dec = map {
-       (SBase <= $_ && $_ <= SFinal) ? decomposeHangul($_)
-           : $Canon{$_} ? @{ $Canon{$_} } : $_
-               } @src;
-    return join(" ",@src) eq join(" ",@dec) ? @dec : getCanonList(@dec);
-    # condition @src == @dec is not ok.
-}
+##### The above part is common to XS and PP #####
 
-sub getCompatList {
-    my @src = @_;
-    my @dec = map {
-       (SBase <= $_ && $_ <= SFinal) ? decomposeHangul($_)
-           : $Compat{$_} ? @{ $Compat{$_} } : $_
-               } @src;
-    return join(" ",@src) eq join(" ",@dec) ? @dec : getCompatList(@dec);
-    # condition @src == @dec is not ok.
-}
+our @ISA = qw(Exporter DynaLoader);
+require DynaLoader;
+bootstrap Unicode::Normalize $VERSION;
 
-# exhaustive decomposition
-foreach my $key (keys %Canon) {
-    $Canon{$key}  = [ getCanonList($key) ];
-}
-
-# exhaustive decomposition
-foreach my $key (keys %Compat) {
-    $Compat{$key} = [ getCompatList($key) ];
-}
-
-sub getHangulComposite ($$) {
-    if ((LBase <= $_[0] && $_[0] <= LFinal)
-     && (VBase <= $_[1] && $_[1] <= VFinal)) {
-       my $lindex = $_[0] - LBase;
-       my $vindex = $_[1] - VBase;
-       return (SBase + ($lindex * VCount + $vindex) * TCount);
-    }
-    if ((SBase <= $_[0] && $_[0] <= SFinal && (($_[0] - SBase ) % TCount) == 0)
-     && (TBase  < $_[1] && $_[1] <= TFinal)) {
-       return($_[0] + $_[1] - TBase);
-    }
-    return undef;
-}
-
-##########
-
-sub getCombinClass ($) {
-    my $uv = 0 + shift;
-    return $Combin{$uv} || 0;
-}
-
-sub getCanon ($) {
-    my $uv = 0 + shift;
-    return exists $Canon{$uv}
-       ? pack_unicore(@{ $Canon{$uv} })
-       : (SBase <= $uv && $uv <= SFinal)
-           ? scalar decomposeHangul($uv)
-           : undef;
-}
-
-sub getCompat ($) {
-    my $uv = 0 + shift;
-    return exists $Compat{$uv}
-       ? pack_unicore(@{ $Compat{$uv} })
-       : (SBase <= $uv && $uv <= SFinal)
-           ? scalar decomposeHangul($uv)
-           : undef;
-}
-
-sub getComposite ($$) {
-    my $uv1 = 0 + shift;
-    my $uv2 = 0 + shift;
-    my $hangul = getHangulComposite($uv1, $uv2);
-    return $hangul if $hangul;
-    return $Compos{ $uv1 } && $Compos{ $uv1 }{ $uv2 };
-}
-
-sub isExclusion  ($) {
-    my $uv = 0 + shift;
-    return exists $Exclus{$uv};
-}
-
-sub isSingleton  ($) {
-    my $uv = 0 + shift;
-    return exists $Single{$uv};
-}
-
-sub isNonStDecomp($) {
-    my $uv = 0 + shift;
-    return exists $NonStD{$uv};
-}
-
-sub isComp2nd ($) {
-    my $uv = 0 + shift;
-    return exists $Comp2nd{$uv};
-}
-
-sub isNFC_MAYBE ($) {
-    my $uv = 0 + shift;
-    return exists $Comp2nd{$uv};
-}
-
-sub isNFKC_MAYBE($) {
-    my $uv = 0 + shift;
-    return exists $Comp2nd{$uv};
-}
-
-sub isNFD_NO ($) {
-    my $uv = 0 + shift;
-    return exists $Canon {$uv} || (SBase <= $uv && $uv <= SFinal);
-}
-
-sub isNFKD_NO ($) {
-    my $uv = 0 + shift;
-    return exists $Compat{$uv} || (SBase <= $uv && $uv <= SFinal);
-}
-
-sub isComp_Ex ($) {
-    my $uv = 0 + shift;
-    return exists $Exclus{$uv} || exists $Single{$uv} || exists $NonStD{$uv};
-}
-
-sub isNFC_NO ($) {
-    my $uv = 0 + shift;
-    return exists $Exclus{$uv} || exists $Single{$uv} || exists $NonStD{$uv};
-}
-
-sub isNFKC_NO ($) {
-    my $uv = 0 + shift;
-    return 1  if $Exclus{$uv} || $Single{$uv} || $NonStD{$uv};
-    return '' if (SBase <= $uv && $uv <= SFinal) || !exists $Compat{$uv};
-    return 1  if ! exists $Canon{$uv};
-    return pack('N*', @{ $Canon{$uv} }) ne pack('N*', @{ $Compat{$uv} });
-}
-
-##
-## string decompose(string, compat?)
-##
-sub decompose ($;$)
-{
-    my $hash = $_[1] ? \%Compat : \%Canon;
-    return pack_unicore map {
-       $hash->{ $_ } ? @{ $hash->{ $_ } } :
-           (SBase <= $_ && $_ <= SFinal) ? decomposeHangul($_) : $_
-        } unpack_unicore($_[0]);
-}
-
-##
-## string reorder(string)
-##
-sub reorder ($)
-{
-    my @src = unpack_unicore($_[0]);
-
-    for (my $i=0; $i < @src;) {
-       $i++, next if ! $Combin{ $src[$i] };
-
-       my $ini = $i;
-       $i++ while $i < @src && $Combin{ $src[$i] };
-
-        my @tmp = sort {
-               $Combin{ $src[$a] } <=> $Combin{ $src[$b] } || $a <=> $b
-           } $ini .. $i - 1;
-
-       @src[ $ini .. $i - 1 ] = @src[ @tmp ];
-    }
-    return pack_unicore(@src);
-}
-
-
-##
-## string compose(string)
-##
-## S : starter; NS : not starter;
-##
-## composable sequence begins at S.
-## S + S or (S + S) + S may be composed.
-## NS + NS must not be composed.
-##
-sub compose ($)
-{
-    my @src = unpack_unicore($_[0]);
-
-    for (my $s = 0; $s+1 < @src; $s++) {
-       next unless defined $src[$s] && ! $Combin{ $src[$s] };
-        # S only; removed or combining are skipped as a starter.
-
-       my($c, $blocked, $uncomposed_cc);
-       for (my $j = $s+1; $j < @src && !$blocked; $j++) {
-           ($Combin{ $src[$j] } ? $uncomposed_cc : $blocked) = 1;
-
-           # S + C + S => S-S + C would be blocked.
-           next if $blocked && $uncomposed_cc;
-
-           # blocked by same CC (and higher CC: revised D2)
-           next if defined $src[$j-1]   && $Combin{ $src[$j-1] }
-               && $Combin{ $src[$j-1] } >= $Combin{ $src[$j] };
-
-           $c = getComposite($src[$s], $src[$j]);
-
-           # no composite or is exclusion
-           next if !$c || $Exclus{$c};
-
-           # replace by composite
-           $src[$s] = $c; $src[$j] = undef;
-           if ($blocked) { $blocked = 0 } else { -- $uncomposed_cc }
-       }
-    }
-    return pack_unicore(grep defined, @src);
-}
-
-
-##
-## string composeContiguous(string)
-##
-sub composeContiguous ($)
-{
-    my @src = unpack_unicore($_[0]);
-
-    for (my $s = 0; $s+1 < @src; $s++) {
-       next unless defined $src[$s] && ! $Combin{ $src[$s] };
-        # S only; removed or combining are skipped as a starter.
-
-       for (my $j = $s+1; $j < @src; $j++) {
-           my $c = getComposite($src[$s], $src[$j]);
-
-           # no composite or is exclusion
-           last if !$c || $Exclus{$c};
-
-           # replace by composite
-           $src[$s] = $c; $src[$j] = undef;
-       }
-    }
-    return pack_unicore(grep defined, @src);
-}
-
-
-##
-## normalization forms
-##
-
-use constant COMPAT => 1;
-
-sub NFD  ($) { reorder(decompose($_[0])) }
-sub NFKD ($) { reorder(decompose($_[0], COMPAT)) }
-sub NFC  ($) { compose(reorder(decompose($_[0]))) }
-sub NFKC ($) { compose(reorder(decompose($_[0], COMPAT))) }
-sub FCC  ($) { composeContiguous(reorder(decompose($_[0]))) }
-
-##
-## quick check
-##
-
-sub checkNFD ($)
-{
-    my $preCC = 0;
-    my $curCC;
-    for my $uv (unpack_unicore($_[0])) {
-       $curCC = $Combin{ $uv } || 0;
-       return '' if $preCC > $curCC && $curCC != 0;
-       return '' if exists $Canon{$uv} || (SBase <= $uv && $uv <= SFinal);
-       $preCC = $curCC;
-    }
-    return 1;
-}
-
-sub checkNFKD ($)
-{
-    my $preCC = 0;
-    my $curCC;
-    for my $uv (unpack_unicore($_[0])) {
-       $curCC = $Combin{ $uv } || 0;
-       return '' if $preCC > $curCC && $curCC != 0;
-       return '' if exists $Compat{$uv} || (SBase <= $uv && $uv <= SFinal);
-       $preCC = $curCC;
-    }
-    return 1;
-}
-
-sub checkNFC ($)
-{
-    my $preCC = 0;
-    my($curCC, $isMAYBE);
-    for my $uv (unpack_unicore($_[0])) {
-       $curCC = $Combin{ $uv } || 0;
-       return '' if $preCC > $curCC && $curCC != 0;
-
-       if (isNFC_MAYBE($uv)) {
-           $isMAYBE = 1;
-       } elsif (isNFC_NO($uv)) {
-           return '';
-       }
-       $preCC = $curCC;
-    }
-    return $isMAYBE ? undef : 1;
-}
-
-sub checkNFKC ($)
-{
-    my $preCC = 0;
-    my($curCC, $isMAYBE);
-    for my $uv (unpack_unicore($_[0])) {
-       $curCC = $Combin{ $uv } || 0;
-       return '' if $preCC > $curCC && $curCC != 0;
-
-       if (isNFKC_MAYBE($uv)) {
-           $isMAYBE = 1;
-       } elsif (isNFKC_NO($uv)) {
-           return '';
-       }
-       $preCC = $curCC;
-    }
-    return $isMAYBE ? undef : 1;
-}
-
-sub checkFCD ($)
-{
-    my $preCC = 0;
-    my $curCC;
-    for my $uv (unpack_unicore($_[0])) {
-       # Hangul syllable need not decomposed since cc[any Jamo] == 0;
-       my @uvCan = exists $Canon{$uv} ? @{ $Canon{$uv} } : ($uv);
-
-       $curCC = $Combin{ $uvCan[0] } || 0;
-       return '' if $curCC != 0 && $curCC < $preCC;
-       $preCC = $Combin{ $uvCan[-1] } || 0;
-    }
-    return 1;
-}
-
-sub checkFCC ($)
-{
-    my $preCC = 0;
-    my($curCC, $isMAYBE);
-    for my $uv (unpack_unicore($_[0])) {
-       # Hangul syllable need not decomposed since cc[any Jamo] == 0;
-       my @uvCan = exists $Canon{$uv} ? @{ $Canon{$uv} } : ($uv);
-
-       $curCC = $Combin{ $uvCan[0] } || 0;
-       return '' if $curCC != 0 && $curCC < $preCC;
-
-       if (isNFC_MAYBE($uv)) {
-           $isMAYBE = 1;
-       } elsif (isNFC_NO($uv)) {
-           return '';
-       }
-
-       $preCC = $Combin{ $uvCan[-1] } || 0;
-    }
-    return $isMAYBE ? undef : 1;
-}
-
-##
-## split on last starter
-##
-
-sub splitOnLastStarter
-{
-    my $str = pack_unicore(unpack_unicore(shift));
-    if ($str eq '') {
-       return ('', '');
-    }
-
-    my $ch;
-    my $unproc = "";
-    do {
-       $ch = chop($str);
-       $unproc = $ch.$unproc;
-    } # Relies on the fact that the combining class for code points < 256 is
-      # 0, so don't have to worry about EBCDIC issues
-      while (getCombinClass(unpack 'U', $ch) && $str ne "");
-    return ($str, $unproc);
-}
+##### The below part is common to XS and PP #####
 
 ##
 ## normalize
@@ -668,7 +165,10 @@ C<$string> is used as a string under character semantics (see F<perlunicode>).
 
 C<$code_point> should be an unsigned integer representing a Unicode code point.
 
-Note: Do not use a floating point nor a negative sign in C<$code_point>.
+Note: Between XSUB and pure Perl, there is an incompatibility
+about the interpretation of C<$code_point> as a decimal number.
+XSUB converts C<$code_point> to an unsigned integer, but pure Perl does not.
+Do not use a floating point nor a negative sign in C<$code_point>.
 
 =head2 Normalization Forms
 
@@ -1093,6 +593,8 @@ lower than 4.1.0.
 
 SADAHIRO Tomoyuki <SADAHIRO@cpan.org>
 
+Currently maintained by <perl5-porters@perl.org> 
+
 Copyright(C) 2001-2012, SADAHIRO Tomoyuki. Japan. All rights reserved.
 
 This module is free software; you can redistribute it
diff --git a/cpan/Unicode-Normalize/Normalize.xs b/cpan/Unicode-Normalize/Normalize.xs
new file mode 100644 (file)
index 0000000..36e20b0
--- /dev/null
@@ -0,0 +1,921 @@
+
+#define PERL_NO_GET_CONTEXT /* we want efficiency */
+
+/* private functions which need pTHX_ and aTHX_
+    pv_cat_decompHangul
+    sv_2pvunicode
+    pv_utf8_decompose
+    pv_utf8_reorder
+    pv_utf8_compose
+*/
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+/* These 5 files are prepared by mkheader */
+#include "unfcmb.h"
+#include "unfcan.h"
+#include "unfcpt.h"
+#include "unfcmp.h"
+#include "unfexc.h"
+
+/* The generated normalization tables since v5.20 are in native character set
+ * terms.  Prior to that, they were in Unicode terms.  So we use 'uvchr' for
+ * later perls, and redefine that to be 'uvuni' for earlier ones */
+#if PERL_VERSION < 20
+#   undef uvchr_to_utf8
+#   ifdef uvuni_to_utf8
+#       define uvchr_to_utf8   uvuni_to_utf8
+#   else /* Perl 5.6.1 */
+#       define uvchr_to_utf8   uv_to_utf8
+#   endif
+
+#   undef utf8n_to_uvchr
+#   ifdef utf8n_to_uvuni
+#       define utf8n_to_uvchr   utf8n_to_uvuni
+#   else /* Perl 5.6.1 */
+#       define utf8n_to_uvchr   utf8_to_uv
+#   endif
+#endif
+
+/* UTF8_ALLOW_BOM is used before Perl 5.8.0 */
+#ifndef UTF8_ALLOW_BOM
+#define UTF8_ALLOW_BOM  (0)
+#endif /* UTF8_ALLOW_BOM */
+
+#ifndef UTF8_ALLOW_SURROGATE
+#define UTF8_ALLOW_SURROGATE  (0)
+#endif /* UTF8_ALLOW_SURROGATE */
+
+#ifndef UTF8_ALLOW_FE_FF
+#define UTF8_ALLOW_FE_FF  (0)
+#endif /* UTF8_ALLOW_FE_FF */
+
+#ifndef UTF8_ALLOW_FFFF
+#define UTF8_ALLOW_FFFF  (0)
+#endif /* UTF8_ALLOW_FFFF */
+
+#define AllowAnyUTF (UTF8_ALLOW_SURROGATE|UTF8_ALLOW_BOM|UTF8_ALLOW_FE_FF|UTF8_ALLOW_FFFF)
+
+/* check if the string buffer is enough before uvchr_to_utf8(). */
+/* dstart, d, and dlen should be defined outside before. */
+#define Renew_d_if_not_enough_to(need) STRLEN curlen = d - dstart;     \
+               if (dlen < curlen + (need)) {   \
+                   dlen += (need);             \
+                   Renew(dstart, dlen+1, U8);  \
+                   d = dstart + curlen;        \
+               }
+
+/* if utf8n_to_uvchr() sets retlen to 0 (if broken?) */
+#define ErrRetlenIsZero "panic (Unicode::Normalize %s): zero-length character"
+
+/* utf8_hop() hops back before start. Maybe broken UTF-8 */
+#define ErrHopBeforeStart "panic (Unicode::Normalize): hopping before start"
+
+/* At present, char > 0x10ffff are unaffected without complaint, right? */
+#define VALID_UTF_MAX    (0x10ffff)
+#define OVER_UTF_MAX(uv) (VALID_UTF_MAX < (uv))
+
+/* size of array for combining characters */
+/* enough as an initial value? */
+#define CC_SEQ_SIZE (10)
+#define CC_SEQ_STEP  (5)
+
+/* HANGUL begin */
+#define Hangul_SBase  0xAC00
+#define Hangul_SFinal 0xD7A3
+#define Hangul_SCount  11172
+
+#define Hangul_NCount    588
+
+#define Hangul_LBase  0x1100
+#define Hangul_LFinal 0x1112
+#define Hangul_LCount     19
+
+#define Hangul_VBase  0x1161
+#define Hangul_VFinal 0x1175
+#define Hangul_VCount     21
+
+#define Hangul_TBase  0x11A7
+#define Hangul_TFinal 0x11C2
+#define Hangul_TCount     28
+
+#define Hangul_IsS(u)  ((Hangul_SBase <= (u)) && ((u) <= Hangul_SFinal))
+#define Hangul_IsN(u)  (((u) - Hangul_SBase) % Hangul_TCount == 0)
+#define Hangul_IsLV(u) (Hangul_IsS(u) && Hangul_IsN(u))
+#define Hangul_IsL(u)  ((Hangul_LBase <= (u)) && ((u) <= Hangul_LFinal))
+#define Hangul_IsV(u)  ((Hangul_VBase <= (u)) && ((u) <= Hangul_VFinal))
+#define Hangul_IsT(u)  ((Hangul_TBase  < (u)) && ((u) <= Hangul_TFinal))
+/* HANGUL end */
+
+/* this is used for canonical ordering of combining characters (c.c.). */
+typedef struct {
+    U8 cc;     /* combining class */
+    UV uv;     /* codepoint */
+    STRLEN pos; /* position */
+} UNF_cc;
+
+static int compare_cc(const void *a, const void *b)
+{
+    int ret_cc;
+    ret_cc = ((UNF_cc*) a)->cc - ((UNF_cc*) b)->cc;
+    if (ret_cc)
+       return ret_cc;
+
+    return ( ((UNF_cc*) a)->pos > ((UNF_cc*) b)->pos )
+        - ( ((UNF_cc*) a)->pos < ((UNF_cc*) b)->pos );
+}
+
+static U8* dec_canonical(UV uv)
+{
+    U8 ***plane, **row;
+    if (OVER_UTF_MAX(uv))
+       return NULL;
+    plane = (U8***)UNF_canon[uv >> 16];
+    if (! plane)
+       return NULL;
+    row = plane[(uv >> 8) & 0xff];
+    return row ? row[uv & 0xff] : NULL;
+}
+
+static U8* dec_compat(UV uv)
+{
+    U8 ***plane, **row;
+    if (OVER_UTF_MAX(uv))
+       return NULL;
+    plane = (U8***)UNF_compat[uv >> 16];
+    if (! plane)
+       return NULL;
+    row = plane[(uv >> 8) & 0xff];
+    return row ? row[uv & 0xff] : NULL;
+}
+
+static UV composite_uv(UV uv, UV uv2)
+{
+    UNF_complist ***plane, **row, *cell, *i;
+
+    if (!uv2 || OVER_UTF_MAX(uv) || OVER_UTF_MAX(uv2))
+       return 0;
+
+    if (Hangul_IsL(uv) && Hangul_IsV(uv2)) {
+       UV lindex = uv  - Hangul_LBase;
+       UV vindex = uv2 - Hangul_VBase;
+       return(Hangul_SBase + (lindex * Hangul_VCount + vindex) *
+              Hangul_TCount);
+    }
+    if (Hangul_IsLV(uv) && Hangul_IsT(uv2)) {
+       UV tindex = uv2 - Hangul_TBase;
+       return(uv + tindex);
+    }
+    plane = UNF_compos[uv >> 16];
+    if (! plane)
+       return 0;
+    row = plane[(uv >> 8) & 0xff];
+    if (! row)
+       return 0;
+    cell = row[uv & 0xff];
+    if (! cell)
+       return 0;
+    for (i = cell; i->nextchar; i++) {
+       if (uv2 == i->nextchar)
+           return i->composite;
+    }
+    return 0;
+}
+
+static U8 getCombinClass(UV uv)
+{
+    U8 **plane, *row;
+    if (OVER_UTF_MAX(uv))
+       return 0;
+    plane = (U8**)UNF_combin[uv >> 16];
+    if (! plane)
+       return 0;
+    row = plane[(uv >> 8) & 0xff];
+    return row ? row[uv & 0xff] : 0;
+}
+
+static U8* pv_cat_decompHangul(pTHX_ U8* d, UV uv)
+{
+    UV sindex =  uv - Hangul_SBase;
+    UV lindex =  sindex / Hangul_NCount;
+    UV vindex = (sindex % Hangul_NCount) / Hangul_TCount;
+    UV tindex =  sindex % Hangul_TCount;
+
+    if (! Hangul_IsS(uv))
+       return d;
+
+    d = uvchr_to_utf8(d, (lindex + Hangul_LBase));
+    d = uvchr_to_utf8(d, (vindex + Hangul_VBase));
+    if (tindex)
+       d = uvchr_to_utf8(d, (tindex + Hangul_TBase));
+    return d;
+}
+
+static char* sv_2pvunicode(pTHX_ SV *sv, STRLEN *lp)
+{
+    char *s;
+    STRLEN len;
+    s = SvPV(sv,len);
+    if (!SvUTF8(sv)) {
+       SV* tmpsv = sv_2mortal(newSVpvn(s, len));
+       if (!SvPOK(tmpsv))
+           s = SvPV_force(tmpsv,len);
+       sv_utf8_upgrade(tmpsv);
+       s = SvPV(tmpsv,len);
+    }
+    if (lp)
+       *lp = len;
+    return s;
+}
+
+static
+U8* pv_utf8_decompose(pTHX_ U8* s, STRLEN slen, U8** dp, STRLEN dlen, bool iscompat)
+{
+    U8* p = s;
+    U8* e = s + slen;
+    U8* dstart = *dp;
+    U8* d = dstart;
+
+    while (p < e) {
+       STRLEN retlen;
+       UV uv = utf8n_to_uvchr(p, e - p, &retlen, AllowAnyUTF);
+       if (!retlen)
+           croak(ErrRetlenIsZero, "decompose");
+       p += retlen;
+
+       if (Hangul_IsS(uv)) {
+           Renew_d_if_not_enough_to(UTF8_MAXLEN * 3)
+           d = pv_cat_decompHangul(aTHX_ d, uv);
+       }
+       else {
+           U8* r = iscompat ? dec_compat(uv) : dec_canonical(uv);
+
+           if (r) {
+               STRLEN len = (STRLEN)strlen((char *)r);
+               Renew_d_if_not_enough_to(len)
+               while (len--)
+                   *d++ = *r++;
+           }
+           else {
+               Renew_d_if_not_enough_to(UTF8_MAXLEN)
+               d = uvchr_to_utf8(d, uv);
+           }
+       }
+    }
+    *dp = dstart;
+    return d;
+}
+
+static
+U8* pv_utf8_reorder(pTHX_ U8* s, STRLEN slen, U8** dp, STRLEN dlen)
+{
+    U8* p = s;
+    U8* e = s + slen;
+    U8* dstart = *dp;
+    U8* d = dstart;
+
+    UNF_cc  seq_ary[CC_SEQ_SIZE];
+    UNF_cc* seq_ptr = seq_ary; /* use array at the beginning */
+    UNF_cc* seq_ext = NULL; /* extend if need */
+    STRLEN seq_max = CC_SEQ_SIZE;
+    STRLEN cc_pos = 0;
+
+    while (p < e) {
+       U8 curCC;
+       STRLEN retlen;
+       UV uv = utf8n_to_uvchr(p, e - p, &retlen, AllowAnyUTF);
+       if (!retlen)
+           croak(ErrRetlenIsZero, "reorder");
+       p += retlen;
+
+       curCC = getCombinClass(uv);
+
+       if (curCC != 0) {
+           if (seq_max < cc_pos + 1) { /* extend if need */
+               seq_max = cc_pos + CC_SEQ_STEP; /* new size */
+               if (CC_SEQ_SIZE == cc_pos) { /* seq_ary full */
+                   STRLEN i;
+                   New(0, seq_ext, seq_max, UNF_cc);
+                   for (i = 0; i < cc_pos; i++)
+                       seq_ext[i] = seq_ary[i];
+               }
+               else {
+                   Renew(seq_ext, seq_max, UNF_cc);
+               }
+               seq_ptr = seq_ext; /* use seq_ext from now */
+           }
+
+           seq_ptr[cc_pos].cc  = curCC;
+           seq_ptr[cc_pos].uv  = uv;
+           seq_ptr[cc_pos].pos = cc_pos;
+           ++cc_pos;
+
+           if (p < e)
+               continue;
+       }
+
+       /* output */
+       if (cc_pos) {
+           STRLEN i;
+
+           if (cc_pos > 1) /* reordered if there are two c.c.'s */
+               qsort((void*)seq_ptr, cc_pos, sizeof(UNF_cc), compare_cc);
+
+           for (i = 0; i < cc_pos; i++) {
+               Renew_d_if_not_enough_to(UTF8_MAXLEN)
+               d = uvchr_to_utf8(d, seq_ptr[i].uv);
+           }
+           cc_pos = 0;
+       }
+
+       if (curCC == 0) {
+           Renew_d_if_not_enough_to(UTF8_MAXLEN)
+           d = uvchr_to_utf8(d, uv);
+       }
+    }
+    if (seq_ext)
+       Safefree(seq_ext);
+    *dp = dstart;
+    return d;
+}
+
+static
+U8* pv_utf8_compose(pTHX_ U8* s, STRLEN slen, U8** dp, STRLEN dlen, bool iscontig)
+{
+    U8* p = s;
+    U8* e = s + slen;
+    U8* dstart = *dp;
+    U8* d = dstart;
+
+    UV uvS = 0; /* code point of the starter */
+    bool valid_uvS = FALSE; /* if FALSE, uvS isn't initialized yet */
+    U8 preCC = 0;
+
+    UV  seq_ary[CC_SEQ_SIZE];
+    UV* seq_ptr = seq_ary; /* use array at the beginning */
+    UV* seq_ext = NULL; /* extend if need */
+    STRLEN seq_max = CC_SEQ_SIZE;
+    STRLEN cc_pos = 0;
+
+    while (p < e) {
+       U8 curCC;
+       STRLEN retlen;
+       UV uv = utf8n_to_uvchr(p, e - p, &retlen, AllowAnyUTF);
+       if (!retlen)
+           croak(ErrRetlenIsZero, "compose");
+       p += retlen;
+
+       curCC = getCombinClass(uv);
+
+       if (!valid_uvS) {
+           if (curCC == 0) {
+               uvS = uv; /* the first Starter is found */
+               valid_uvS = TRUE;
+               if (p < e)
+                   continue;
+           }
+           else {
+               Renew_d_if_not_enough_to(UTF8_MAXLEN)
+               d = uvchr_to_utf8(d, uv);
+               continue;
+           }
+       }
+       else {
+           bool composed;
+
+           /* blocked */
+           if ((iscontig && cc_pos) || /* discontiguous combination */
+                (curCC != 0 && preCC == curCC) || /* blocked by same CC */
+                (preCC > curCC)) /* blocked by higher CC: revised D2 */
+               composed = FALSE;
+
+           /* not blocked:
+                iscontig && cc_pos == 0      -- contiguous combination
+                curCC == 0 && preCC == 0     -- starter + starter
+                curCC != 0 && preCC < curCC  -- lower CC */
+           else {
+               /* try composition */
+               UV uvComp = composite_uv(uvS, uv);
+
+               if (uvComp && !isExclusion(uvComp))  {
+                   uvS = uvComp;
+                   composed = TRUE;
+
+                   /* preCC should not be changed to curCC */
+                   /* e.g. 1E14 = 0045 0304 0300 where CC(0304) == CC(0300) */
+                   if (p < e)
+                       continue;
+               }
+               else
+                   composed = FALSE;
+           }
+
+           if (!composed) {
+               preCC = curCC;
+               if (curCC != 0 || !(p < e)) {
+                   if (seq_max < cc_pos + 1) { /* extend if need */
+                       seq_max = cc_pos + CC_SEQ_STEP; /* new size */
+                       if (CC_SEQ_SIZE == cc_pos) { /* seq_ary full */
+                           New(0, seq_ext, seq_max, UV);
+                           Copy(seq_ary, seq_ext, cc_pos, UV);
+                       }
+                       else {
+                           Renew(seq_ext, seq_max, UV);
+                       }
+                       seq_ptr = seq_ext; /* use seq_ext from now */
+                   }
+                   seq_ptr[cc_pos] = uv;
+                   ++cc_pos;
+               }
+               if (curCC != 0 && p < e)
+                   continue;
+           }
+       }
+
+       /* output */
+       {
+           Renew_d_if_not_enough_to(UTF8_MAXLEN)
+           d = uvchr_to_utf8(d, uvS); /* starter (composed or not) */
+       }
+
+       if (cc_pos) {
+           STRLEN i;
+
+           for (i = 0; i < cc_pos; i++) {
+               Renew_d_if_not_enough_to(UTF8_MAXLEN)
+               d = uvchr_to_utf8(d, seq_ptr[i]);
+           }
+           cc_pos = 0;
+       }
+
+       uvS = uv;
+    }
+    if (seq_ext)
+       Safefree(seq_ext);
+    *dp = dstart;
+    return d;
+}
+
+MODULE = Unicode::Normalize    PACKAGE = Unicode::Normalize
+
+SV*
+decompose(src, compat = &PL_sv_no)
+    SV * src
+    SV * compat
+  PROTOTYPE: $;$
+  PREINIT:
+    SV* dst;
+    U8 *s, *d, *dend;
+    STRLEN slen, dlen;
+  CODE:
+    s = (U8*)sv_2pvunicode(aTHX_ src,&slen);
+    dst = newSVpvn("", 0);
+    dlen = slen;
+    New(0, d, dlen+1, U8);
+    dend = pv_utf8_decompose(aTHX_ s, slen, &d, dlen, (bool)SvTRUE(compat));
+    sv_setpvn(dst, (char *)d, dend - d);
+    SvUTF8_on(dst);
+    Safefree(d);
+    RETVAL = dst;
+  OUTPUT:
+    RETVAL
+
+
+SV*
+reorder(src)
+    SV * src
+  PROTOTYPE: $
+  PREINIT:
+    SV* dst;
+    U8 *s, *d, *dend;
+    STRLEN slen, dlen;
+  CODE:
+    s = (U8*)sv_2pvunicode(aTHX_ src,&slen);
+    dst = newSVpvn("", 0);
+    dlen = slen;
+    New(0, d, dlen+1, U8);
+    dend = pv_utf8_reorder(aTHX_ s, slen, &d, dlen);
+    sv_setpvn(dst, (char *)d, dend - d);
+    SvUTF8_on(dst);
+    Safefree(d);
+    RETVAL = dst;
+  OUTPUT:
+    RETVAL
+
+
+SV*
+compose(src)
+    SV * src
+  PROTOTYPE: $
+  ALIAS:
+    composeContiguous = 1
+  PREINIT:
+    SV* dst;
+    U8 *s, *d, *dend;
+    STRLEN slen, dlen;
+  CODE:
+    s = (U8*)sv_2pvunicode(aTHX_ src,&slen);
+    dst = newSVpvn("", 0);
+    dlen = slen;
+    New(0, d, dlen+1, U8);
+    dend = pv_utf8_compose(aTHX_ s, slen, &d, dlen, (bool)ix);
+    sv_setpvn(dst, (char *)d, dend - d);
+    SvUTF8_on(dst);
+    Safefree(d);
+    RETVAL = dst;
+  OUTPUT:
+    RETVAL
+
+
+SV*
+NFD(src)
+    SV * src
+  PROTOTYPE: $
+  ALIAS:
+    NFKD = 1
+  PREINIT:
+    SV *dst;
+    U8 *s, *t, *tend, *d, *dend;
+    STRLEN slen, tlen, dlen;
+  CODE:
+    s = (U8*)sv_2pvunicode(aTHX_ src,&slen);
+
+    /* decompose */
+    tlen = slen;
+    New(0, t, tlen+1, U8);
+    tend = pv_utf8_decompose(aTHX_ s, slen, &t, tlen, (bool)(ix==1));
+    *tend = '\0';
+    tlen = tend - t; /* no longer know real size of t */
+
+    /* reorder */
+    dlen = tlen;
+    New(0, d, dlen+1, U8);
+    dend = pv_utf8_reorder(aTHX_ t, tlen, &d, dlen);
+    *dend = '\0';
+    dlen = dend - d; /* no longer know real size of d */
+
+    /* return */
+    dst = newSVpvn("", 0);
+    sv_setpvn(dst, (char *)d, dlen);
+    SvUTF8_on(dst);
+
+    Safefree(t);
+    Safefree(d);
+    RETVAL = dst;
+  OUTPUT:
+    RETVAL
+
+
+SV*
+NFC(src)
+    SV * src
+  PROTOTYPE: $
+  ALIAS:
+    NFKC = 1
+    FCC  = 2
+  PREINIT:
+    SV *dst;
+    U8 *s, *t, *tend, *u, *uend, *d, *dend;
+    STRLEN slen, tlen, ulen, dlen;
+  CODE:
+    s = (U8*)sv_2pvunicode(aTHX_ src,&slen);
+
+    /* decompose */
+    tlen = slen;
+    New(0, t, tlen+1, U8);
+    tend = pv_utf8_decompose(aTHX_ s, slen, &t, tlen, (bool)(ix==1));
+    *tend = '\0';
+    tlen = tend - t; /* no longer know real size of t */
+
+    /* reorder */
+    ulen = tlen;
+    New(0, u, ulen+1, U8);
+    uend = pv_utf8_reorder(aTHX_ t, tlen, &u, ulen);
+    *uend = '\0';
+    ulen = uend - u; /* no longer know real size of u */
+
+    /* compose */
+    dlen = ulen;
+    New(0, d, dlen+1, U8);
+    dend = pv_utf8_compose(aTHX_ u, ulen, &d, dlen, (bool)(ix==2));
+    *dend = '\0';
+    dlen = dend - d; /* no longer know real size of d */
+
+    /* return */
+    dst = newSVpvn("", 0);
+    sv_setpvn(dst, (char *)d, dlen);
+    SvUTF8_on(dst);
+
+    Safefree(t);
+    Safefree(u);
+    Safefree(d);
+    RETVAL = dst;
+  OUTPUT:
+    RETVAL
+
+
+SV*
+checkNFD(src)
+    SV * src
+  PROTOTYPE: $
+  ALIAS:
+    checkNFKD = 1
+  PREINIT:
+    STRLEN srclen, retlen;
+    U8 *s, *e, *p, curCC, preCC;
+    bool result = TRUE;
+  CODE:
+    s = (U8*)sv_2pvunicode(aTHX_ src,&srclen);
+    e = s + srclen;
+
+    preCC = 0;
+    for (p = s; p < e; p += retlen) {
+       UV uv = utf8n_to_uvchr(p, e - p, &retlen, AllowAnyUTF);
+       if (!retlen)
+           croak(ErrRetlenIsZero, "checkNFD or -NFKD");
+
+       curCC = getCombinClass(uv);
+       if (preCC > curCC && curCC != 0) { /* canonical ordering violated */
+           result = FALSE;
+           break;
+       }
+       if (Hangul_IsS(uv) || (ix ? dec_compat(uv) : dec_canonical(uv))) {
+           result = FALSE;
+           break;
+       }
+       preCC = curCC;
+    }
+    RETVAL = boolSV(result);
+  OUTPUT:
+    RETVAL
+
+
+SV*
+checkNFC(src)
+    SV * src
+  PROTOTYPE: $
+  ALIAS:
+    checkNFKC = 1
+  PREINIT:
+    STRLEN srclen, retlen;
+    U8 *s, *e, *p, curCC, preCC;
+    bool result = TRUE;
+    bool isMAYBE = FALSE;
+  CODE:
+    s = (U8*)sv_2pvunicode(aTHX_ src,&srclen);
+    e = s + srclen;
+
+    preCC = 0;
+    for (p = s; p < e; p += retlen) {
+       UV uv = utf8n_to_uvchr(p, e - p, &retlen, AllowAnyUTF);
+       if (!retlen)
+           croak(ErrRetlenIsZero, "checkNFC or -NFKC");
+
+       curCC = getCombinClass(uv);
+       if (preCC > curCC && curCC != 0) { /* canonical ordering violated */
+           result = FALSE;
+           break;
+       }
+
+       /* get NFC/NFKC property */
+       if (Hangul_IsS(uv)) /* Hangul syllables are canonical composites */
+           ; /* YES */
+       else if (isExclusion(uv) || isSingleton(uv) || isNonStDecomp(uv)) {
+           result = FALSE;
+           break;
+       }
+       else if (isComp2nd(uv))
+           isMAYBE = TRUE;
+       else if (ix) {
+           char *canon, *compat;
+         /* NFKC_NO when having compatibility mapping. */
+           canon  = (char *) dec_canonical(uv);
+           compat = (char *) dec_compat(uv);
+           if (compat && !(canon && strEQ(canon, compat))) {
+               result = FALSE;
+               break;
+           }
+       } /* end of get NFC/NFKC property */
+
+       preCC = curCC;
+    }
+    if (isMAYBE && result) /* NO precedes MAYBE */
+       XSRETURN_UNDEF;
+    RETVAL = boolSV(result);
+  OUTPUT:
+    RETVAL
+
+
+SV*
+checkFCD(src)
+    SV * src
+  PROTOTYPE: $
+  ALIAS:
+    checkFCC = 1
+  PREINIT:
+    STRLEN srclen, retlen;
+    U8 *s, *e, *p, curCC, preCC;
+    bool result = TRUE;
+    bool isMAYBE = FALSE;
+  CODE:
+    s = (U8*)sv_2pvunicode(aTHX_ src,&srclen);
+    e = s + srclen;
+    preCC = 0;
+    for (p = s; p < e; p += retlen) {
+       U8 *sCan;
+       UV uvLead;
+       STRLEN canlen = 0;
+       UV uv = utf8n_to_uvchr(p, e - p, &retlen, AllowAnyUTF);
+       if (!retlen)
+           croak(ErrRetlenIsZero, "checkFCD or -FCC");
+
+       sCan = (U8*) dec_canonical(uv);
+
+       if (sCan) {
+           STRLEN canret;
+           canlen = (STRLEN)strlen((char *) sCan);
+           uvLead = utf8n_to_uvchr(sCan, canlen, &canret, AllowAnyUTF);
+           if (!canret)
+               croak(ErrRetlenIsZero, "checkFCD or -FCC");
+       }
+       else {
+           uvLead = uv;
+       }
+
+       curCC = getCombinClass(uvLead);
+
+       if (curCC != 0 && curCC < preCC) { /* canonical ordering violated */
+           result = FALSE;
+           break;
+       }
+
+       if (ix) {
+           if (isExclusion(uv) || isSingleton(uv) || isNonStDecomp(uv)) {
+               result = FALSE;
+               break;
+           }
+           else if (isComp2nd(uv))
+               isMAYBE = TRUE;
+       }
+
+       if (sCan) {
+           STRLEN canret;
+           UV uvTrail;
+           U8* eCan = sCan + canlen;
+           U8* pCan = utf8_hop(eCan, -1);
+           if (pCan < sCan)
+               croak(ErrHopBeforeStart);
+           uvTrail = utf8n_to_uvchr(pCan, eCan - pCan, &canret, AllowAnyUTF);
+           if (!canret)
+               croak(ErrRetlenIsZero, "checkFCD or -FCC");
+           preCC = getCombinClass(uvTrail);
+       }
+       else {
+           preCC = curCC;
+       }
+    }
+    if (isMAYBE && result) /* NO precedes MAYBE */
+       XSRETURN_UNDEF;
+    RETVAL = boolSV(result);
+  OUTPUT:
+    RETVAL
+
+
+U8
+getCombinClass(uv)
+    UV uv
+  PROTOTYPE: $
+
+bool
+isExclusion(uv)
+    UV uv
+  PROTOTYPE: $
+
+bool
+isSingleton(uv)
+    UV uv
+  PROTOTYPE: $
+
+bool
+isNonStDecomp(uv)
+    UV uv
+  PROTOTYPE: $
+
+bool
+isComp2nd(uv)
+    UV uv
+  PROTOTYPE: $
+  ALIAS:
+    isNFC_MAYBE  = 1
+    isNFKC_MAYBE = 2
+
+
+
+SV*
+isNFD_NO(uv)
+    UV uv
+  PROTOTYPE: $
+  ALIAS:
+    isNFKD_NO = 1
+  PREINIT:
+    bool result = FALSE;
+  CODE:
+    if (Hangul_IsS(uv) || (ix ? dec_compat(uv) : dec_canonical(uv)))
+       result = TRUE; /* NFD_NO or NFKD_NO */
+    RETVAL = boolSV(result);
+  OUTPUT:
+    RETVAL
+
+
+SV*
+isComp_Ex(uv)
+    UV uv
+  PROTOTYPE: $
+  ALIAS:
+    isNFC_NO  = 0
+    isNFKC_NO = 1
+  PREINIT:
+    bool result = FALSE;
+  CODE:
+    if (isExclusion(uv) || isSingleton(uv) || isNonStDecomp(uv))
+       result = TRUE; /* NFC_NO or NFKC_NO */
+    else if (ix) {
+       char *canon, *compat;
+       canon  = (char *) dec_canonical(uv);
+       compat = (char *) dec_compat(uv);
+       if (compat && (!canon || strNE(canon, compat)))
+           result = TRUE; /* NFC_NO or NFKC_NO */
+    }
+    RETVAL = boolSV(result);
+  OUTPUT:
+    RETVAL
+
+SV*
+getComposite(uv, uv2)
+    UV uv
+    UV uv2
+  PROTOTYPE: $$
+  PREINIT:
+    UV composite;
+  CODE:
+    composite = composite_uv(uv, uv2);
+    RETVAL = composite ? newSVuv(composite) : &PL_sv_undef;
+  OUTPUT:
+    RETVAL
+
+
+
+SV*
+getCanon(uv)
+    UV uv
+  PROTOTYPE: $
+  ALIAS:
+    getCompat = 1
+  CODE:
+    if (Hangul_IsS(uv)) {
+       U8 tmp[3 * UTF8_MAXLEN + 1];
+       U8 *t = tmp;
+       U8 *e = pv_cat_decompHangul(aTHX_ t, uv);
+       RETVAL = newSVpvn((char *)t, e - t);
+    } else {
+       U8* rstr = ix ? dec_compat(uv) : dec_canonical(uv);
+       if (!rstr)
+           XSRETURN_UNDEF;
+       RETVAL = newSVpvn((char *)rstr, strlen((char *)rstr));
+    }
+    SvUTF8_on(RETVAL);
+  OUTPUT:
+    RETVAL
+
+
+void
+splitOnLastStarter(src)
+    SV * src
+  PREINIT:
+    SV *svp;
+    STRLEN srclen;
+    U8 *s, *e, *p;
+  PPCODE:
+    s = (U8*)sv_2pvunicode(aTHX_ src,&srclen);
+    e = s + srclen;
+    p = e;
+    while (s < p) {
+       UV uv;
+       p = utf8_hop(p, -1);
+       if (p < s)
+           croak(ErrHopBeforeStart);
+       uv = utf8n_to_uvchr(p, e - p, NULL, AllowAnyUTF);
+       if (getCombinClass(uv) == 0) /* Last Starter found */
+           break;
+    }
+
+    svp = sv_2mortal(newSVpvn((char*)s, p - s));
+    SvUTF8_on(svp);
+    XPUSHs(svp);
+
+    svp = sv_2mortal(newSVpvn((char*)p, e - p));
+    SvUTF8_on(svp);
+    XPUSHs(svp);
+
diff --git a/cpan/Unicode-Normalize/mkheader b/cpan/Unicode-Normalize/mkheader
new file mode 100644 (file)
index 0000000..8d4c1b8
--- /dev/null
@@ -0,0 +1,419 @@
+#!perl
+#
+# This auxiliary script makes five header files
+# used for building XSUB of Unicode::Normalize.
+#
+# Usage:
+#    <do 'mkheader'> in perl, or <perl mkheader> in command line
+#
+# Input files:
+#    unicore/CombiningClass.pl (or unicode/CombiningClass.pl)
+#    unicore/Decomposition.pl (or unicode/Decomposition.pl)
+#
+# Output files:
+#    unfcan.h
+#    unfcpt.h
+#    unfcmb.h
+#    unfcmp.h
+#    unfexc.h
+#
+use 5.006;
+use strict;
+use warnings;
+use Carp;
+use File::Spec;
+use SelectSaver;
+
+BEGIN {
+    unless ('A' eq pack('U', 0x41)) {
+       die "Unicode::Normalize cannot stringify a Unicode code point\n";
+    }
+    unless (0x41 == unpack('U', 'A')) {
+       die "Unicode::Normalize cannot get Unicode code point\n";
+    }
+}
+
+our $PACKAGE = 'Unicode::Normalize, mkheader';
+
+our $prefix = "UNF_";
+our $structname = "${prefix}complist";
+
+# Starting in v5.20, the tables in lib/unicore are built using the platform's
+# native character set for code points 0-255.
+*pack_U = ($] ge 5.020)
+          ? sub { return pack('W*', @_).pack('U*'); } # The empty pack returns
+                                                      # an empty UTF-8 string,
+                                                      # so the effect is to
+                                                      # force the return into
+                                                      # being UTF-8.
+          : sub { return pack('U*', @_); };
+
+# %Canon and %Compat will be ($codepoint => $hexstring) after _U_stringify()
+our %Comp1st;  # $codepoint => $listname  : may be composed with a next char.
+our %CompList; # $listname,$2nd  => $codepoint : composite
+
+##### The below part is common to mkheader and PP #####
+
+our %Combin;   # $codepoint => $number    : combination class
+our %Canon;    # $codepoint => \@codepoints : canonical decomp.
+our %Compat;   # $codepoint => \@codepoints : compat. decomp.
+our %Compos;   # $1st,$2nd  => $codepoint : composite
+our %Exclus;   # $codepoint => 1          : composition exclusions
+our %Single;   # $codepoint => 1          : singletons
+our %NonStD;   # $codepoint => 1          : non-starter decompositions
+our %Comp2nd;  # $codepoint => 1          : may be composed with a prev char.
+
+# from core Unicode database
+our $Combin = do "unicore/CombiningClass.pl"
+    || do "unicode/CombiningClass.pl"
+    || croak "$PACKAGE: CombiningClass.pl not found";
+our $Decomp = do "unicore/Decomposition.pl"
+    || do "unicode/Decomposition.pl"
+    || croak "$PACKAGE: Decomposition.pl not found";
+
+# CompositionExclusions.txt since Unicode 3.2.0.  If this ever changes, it
+# would be better to get the values from Unicode::UCD rather than hard-code
+# them here, as that will protect from having to make fixes for future
+# changes.
+our @CompEx = qw(
+    0958 0959 095A 095B 095C 095D 095E 095F 09DC 09DD 09DF 0A33 0A36
+    0A59 0A5A 0A5B 0A5E 0B5C 0B5D 0F43 0F4D 0F52 0F57 0F5C 0F69 0F76
+    0F78 0F93 0F9D 0FA2 0FA7 0FAC 0FB9 FB1D FB1F FB2A FB2B FB2C FB2D
+    FB2E FB2F FB30 FB31 FB32 FB33 FB34 FB35 FB36 FB38 FB39 FB3A FB3B
+    FB3C FB3E FB40 FB41 FB43 FB44 FB46 FB47 FB48 FB49 FB4A FB4B FB4C
+    FB4D FB4E 2ADC 1D15E 1D15F 1D160 1D161 1D162 1D163 1D164 1D1BB
+    1D1BC 1D1BD 1D1BE 1D1BF 1D1C0
+);
+
+# definition of Hangul constants
+use constant SBase  => 0xAC00;
+use constant SFinal => 0xD7A3; # SBase -1 + SCount
+use constant SCount =>  11172; # LCount * NCount
+use constant NCount =>    588; # VCount * TCount
+use constant LBase  => 0x1100;
+use constant LFinal => 0x1112;
+use constant LCount =>     19;
+use constant VBase  => 0x1161;
+use constant VFinal => 0x1175;
+use constant VCount =>     21;
+use constant TBase  => 0x11A7;
+use constant TFinal => 0x11C2;
+use constant TCount =>     28;
+
+sub decomposeHangul {
+    my $sindex = $_[0] - SBase;
+    my $lindex = int( $sindex / NCount);
+    my $vindex = int(($sindex % NCount) / TCount);
+    my $tindex =      $sindex % TCount;
+    my @ret = (
+       LBase + $lindex,
+       VBase + $vindex,
+      $tindex ? (TBase + $tindex) : (),
+    );
+    return wantarray ? @ret : pack_U(@ret);
+}
+
+########## getting full decomposition ##########
+
+## converts string "hhhh hhhh hhhh" to a numeric list
+## (hex digits separated by spaces)
+sub _getHexArray { map hex, $_[0] =~ /\G *([0-9A-Fa-f]+)/g }
+
+while ($Combin =~ /(.+)/g) {
+    my @tab = split /\t/, $1;
+    my $ini = hex $tab[0];
+    if ($tab[1] eq '') {
+       $Combin{$ini} = $tab[2];
+    } else {
+       $Combin{$_} = $tab[2] foreach $ini .. hex($tab[1]);
+    }
+}
+
+while ($Decomp =~ /(.+)/g) {
+    my @tab = split /\t/, $1;
+    my $compat = $tab[2] =~ s/<[^>]+>//;
+    my $dec = [ _getHexArray($tab[2]) ]; # decomposition
+    my $ini = hex($tab[0]); # initial decomposable character
+    my $end = $tab[1] eq '' ? $ini : hex($tab[1]);
+    # ($ini .. $end) is the range of decomposable characters.
+
+    foreach my $u ($ini .. $end) {
+       $Compat{$u} = $dec;
+       $Canon{$u} = $dec if ! $compat;
+    }
+}
+
+for my $s (@CompEx) {
+    my $u = hex $s;
+    next if !$Canon{$u}; # not assigned
+    next if $u == 0xFB1D && !$Canon{0x1D15E}; # 3.0.1 before Corrigendum #2
+    $Exclus{$u} = 1;
+}
+
+foreach my $u (keys %Canon) {
+    my $dec = $Canon{$u};
+
+    if (@$dec == 2) {
+       if ($Combin{ $dec->[0] }) {
+           $NonStD{$u} = 1;
+       } else {
+           $Compos{ $dec->[0] }{ $dec->[1] } = $u;
+           $Comp2nd{ $dec->[1] } = 1 if ! $Exclus{$u};
+       }
+    } elsif (@$dec == 1) {
+       $Single{$u} = 1;
+    } else {
+       my $h = sprintf '%04X', $u;
+       croak("Weird Canonical Decomposition of U+$h");
+    }
+}
+
+# modern HANGUL JUNGSEONG and HANGUL JONGSEONG jamo
+foreach my $j (0x1161..0x1175, 0x11A8..0x11C2) {
+    $Comp2nd{$j} = 1;
+}
+
+sub getCanonList {
+    my @src = @_;
+    my @dec = map {
+       (SBase <= $_ && $_ <= SFinal) ? decomposeHangul($_)
+           : $Canon{$_} ? @{ $Canon{$_} } : $_
+               } @src;
+    return join(" ",@src) eq join(" ",@dec) ? @dec : getCanonList(@dec);
+    # condition @src == @dec is not ok.
+}
+
+sub getCompatList {
+    my @src = @_;
+    my @dec = map {
+       (SBase <= $_ && $_ <= SFinal) ? decomposeHangul($_)
+           : $Compat{$_} ? @{ $Compat{$_} } : $_
+               } @src;
+    return join(" ",@src) eq join(" ",@dec) ? @dec : getCompatList(@dec);
+    # condition @src == @dec is not ok.
+}
+
+# exhaustive decomposition
+foreach my $key (keys %Canon) {
+    $Canon{$key}  = [ getCanonList($key) ];
+}
+
+# exhaustive decomposition
+foreach my $key (keys %Compat) {
+    $Compat{$key} = [ getCompatList($key) ];
+}
+
+##### The above part is common to mkheader and PP #####
+
+foreach my $comp1st (keys %Compos) {
+    my $listname = sprintf("${structname}_%06x", $comp1st);
+               # %04x is bad since it'd place _3046 after _1d157.
+    $Comp1st{$comp1st} = $listname;
+    my $rh1st = $Compos{$comp1st};
+
+    foreach my $comp2nd (keys %$rh1st) {
+       my $uc = $rh1st->{$comp2nd};
+       $CompList{$listname}{$comp2nd} = $uc;
+    }
+}
+
+sub split_into_char {
+    use bytes;
+    my $uni = shift;
+    my $len = length($uni);
+    my @ary;
+    for(my $i = 0; $i < $len; ++$i) {
+       push @ary, ord(substr($uni,$i,1));
+    }
+    return @ary;
+}
+
+sub _U_stringify {
+    sprintf '"%s"', join '',
+       map sprintf("\\x%02x", $_), split_into_char(pack_U(@_));
+}
+
+foreach my $hash (\%Canon, \%Compat) {
+    foreach my $key (keys %$hash) {
+       $hash->{$key} = _U_stringify( @{ $hash->{$key} } );
+    }
+}
+
+########## writing header files ##########
+
+my @boolfunc = (
+    {
+       name => "Exclusion",
+       type => "bool",
+       hash => \%Exclus,
+    },
+    {
+       name => "Singleton",
+       type => "bool",
+       hash => \%Single,
+    },
+    {
+       name => "NonStDecomp",
+       type => "bool",
+       hash => \%NonStD,
+    },
+    {
+       name => "Comp2nd",
+       type => "bool",
+       hash => \%Comp2nd,
+    },
+);
+
+my $orig_fh = SelectSaver->new;
+{
+
+my $file = "unfexc.h";
+open FH, ">$file" or croak "$PACKAGE: $file can't be made";
+binmode FH; select FH;
+
+    print << 'EOF';
+/*
+ * This file is auto-generated by mkheader.
+ * Any changes here will be lost!
+ */
+EOF
+
+foreach my $tbl (@boolfunc) {
+    my @temp = sort {$a <=> $b} keys %{$tbl->{hash}};
+    my $type = $tbl->{type};
+    my $name = $tbl->{name};
+    print "$type is$name (UV uv)\n{\nreturn\n\t";
+
+    while (@temp) {
+       my $cur = shift @temp;
+       if (@temp && $cur + 1 == $temp[0]) {
+           print "($cur <= uv && uv <= ";
+           while (@temp && $cur + 1 == $temp[0]) {
+               $cur = shift @temp;
+           }
+           print "$cur)";
+           print "\n\t|| " if @temp;
+       } else {
+           print "uv == $cur";
+           print "\n\t|| " if @temp;
+       }
+    }
+    print "\n\t? TRUE : FALSE;\n}\n\n";
+}
+
+close FH;
+
+####################################
+
+my $compinit =
+    "typedef struct { UV nextchar; UV composite; } $structname;\n\n";
+
+foreach my $i (sort keys %CompList) {
+    $compinit .= "$structname $i [] = {\n";
+    $compinit .= join ",\n",
+       map sprintf("\t{ %d, %d }", $_, $CompList{$i}{$_}),
+           sort {$a <=> $b } keys %{ $CompList{$i} };
+    $compinit .= ",\n{0,0}\n};\n\n"; # with sentinel
+}
+
+my @tripletable = (
+    {
+       file => "unfcmb",
+       name => "combin",
+       type => "STDCHAR",
+       hash => \%Combin,
+       null =>  0,
+    },
+    {
+       file => "unfcan",
+       name => "canon",
+       type => "char*",
+       hash => \%Canon,
+       null => "NULL",
+    },
+    {
+       file => "unfcpt",
+       name => "compat",
+       type => "char*",
+       hash => \%Compat,
+       null => "NULL",
+    },
+    {
+       file => "unfcmp",
+       name => "compos",
+       type => "$structname *",
+       hash => \%Comp1st,
+       null => "NULL",
+       init => $compinit,
+    },
+);
+
+foreach my $tbl (@tripletable) {
+    my $file = "$tbl->{file}.h";
+    my $head = "${prefix}$tbl->{name}";
+    my $type = $tbl->{type};
+    my $hash = $tbl->{hash};
+    my $null = $tbl->{null};
+    my $init = $tbl->{init};
+
+    open FH, ">$file" or croak "$PACKAGE: $file can't be made";
+    binmode FH; select FH;
+    my %val;
+
+    print FH << 'EOF';
+/*
+ * This file is auto-generated by mkheader.
+ * Any changes here will be lost!
+ */
+EOF
+
+    print $init if defined $init;
+
+    foreach my $uv (keys %$hash) {
+       croak sprintf("a Unicode code point 0x%04X over 0x10FFFF.", $uv)
+           unless $uv <= 0x10FFFF;
+       my @c = unpack 'CCCC', pack 'N', $uv;
+       $val{ $c[1] }{ $c[2] }{ $c[3] } = $hash->{$uv};
+    }
+
+    foreach my $p (sort { $a <=> $b } keys %val) {
+       next if ! $val{ $p };
+       for (my $r = 0; $r < 256; $r++) {
+           next if ! $val{ $p }{ $r };
+           printf "static $type ${head}_%02x_%02x [256] = {\n", $p, $r;
+           for (my $c = 0; $c < 256; $c++) {
+               print "\t", defined $val{$p}{$r}{$c}
+                   ? "($type)".$val{$p}{$r}{$c}
+                   : $null;
+               print ','  if $c != 255;
+               print "\n" if $c % 8 == 7;
+           }
+           print "};\n\n";
+       }
+    }
+    foreach my $p (sort { $a <=> $b } keys %val) {
+       next if ! $val{ $p };
+       printf "static $type* ${head}_%02x [256] = {\n", $p;
+       for (my $r = 0; $r < 256; $r++) {
+           print $val{ $p }{ $r }
+               ? sprintf("${head}_%02x_%02x", $p, $r)
+               : "NULL";
+           print ','  if $r != 255;
+           print "\n" if $val{ $p }{ $r } || ($r+1) % 8 == 0;
+       }
+       print "};\n\n";
+    }
+    print "static $type** $head [] = {\n";
+    for (my $p = 0; $p <= 0x10; $p++) {
+       print $val{ $p } ? sprintf("${head}_%02x", $p) : "NULL";
+       print ','  if $p != 0x10;
+       print "\n";
+    }
+    print "};\n\n";
+    close FH;
+}
+
+}   # End of block for SelectSaver
+
+1;
+__END__
index 1b0ec3e..d2ef28b 100644 (file)
@@ -12,8 +12,8 @@ BEGIN {
 
 BEGIN {
     if ($ENV{PERL_CORE}) {
-       chdir('t') if -d 't';
-       @INC = $^O eq 'MacOS' ? qw(::lib) : qw(../lib);
+        chdir('t') if -d 't';
+        @INC = $^O eq 'MacOS' ? qw(::lib) : qw(../lib);
     }
 }
 
index 7295b47..2bd6e50 100644 (file)
@@ -12,8 +12,8 @@ BEGIN {
 
 BEGIN {
     if ($ENV{PERL_CORE}) {
-       chdir('t') if -d 't';
-       @INC = $^O eq 'MacOS' ? qw(::lib) : qw(../lib);
+        chdir('t') if -d 't';
+        @INC = $^O eq 'MacOS' ? qw(::lib) : qw(../lib);
     }
 }
 
index bf2c960..ccf2b4a 100644 (file)
@@ -12,8 +12,8 @@ BEGIN {
 
 BEGIN {
     if ($ENV{PERL_CORE}) {
-       chdir('t') if -d 't';
-       @INC = $^O eq 'MacOS' ? qw(::lib) : qw(../lib);
+        chdir('t') if -d 't';
+        @INC = $^O eq 'MacOS' ? qw(::lib) : qw(../lib);
     }
 }
 
@@ -59,7 +59,7 @@ ok(1);
 no warnings qw(utf8);
 
 for my $u (0xD800, 0xDFFF, 0xFDD0, 0xFDEF, 0xFEFF, 0xFFFE, 0xFFFF,
-          0x1FFFF, 0x10FFFF, 0x110000, 0x7FFFFFFF)
+          0x1FFFF, 0x10FFFF, 0x110000, 0x3FFFFFFF)
 {
     my $c = chr $u;
     ok($c eq NFD($c));  # 1
index 1db70f0..d3cec3a 100644 (file)
@@ -12,8 +12,8 @@ BEGIN {
 
 BEGIN {
     if ($ENV{PERL_CORE}) {
-       chdir('t') if -d 't';
-       @INC = $^O eq 'MacOS' ? qw(::lib) : qw(../lib);
+        chdir('t') if -d 't';
+        @INC = $^O eq 'MacOS' ? qw(::lib) : qw(../lib);
     }
 }
 
index 32e295a..9a00087 100644 (file)
@@ -12,8 +12,8 @@ BEGIN {
 
 BEGIN {
     if ($ENV{PERL_CORE}) {
-       chdir('t') if -d 't';
-       @INC = $^O eq 'MacOS' ? qw(::lib) : qw(../lib);
+        chdir('t') if -d 't';
+        @INC = $^O eq 'MacOS' ? qw(::lib) : qw(../lib);
     }
 }
 
index 7fa9a8e..3e44a63 100644 (file)
@@ -12,8 +12,8 @@ BEGIN {
 
 BEGIN {
     if ($ENV{PERL_CORE}) {
-       chdir('t') if -d 't';
-       @INC = $^O eq 'MacOS' ? qw(::lib) : qw(../lib);
+        chdir('t') if -d 't';
+        @INC = $^O eq 'MacOS' ? qw(::lib) : qw(../lib);
     }
 }
 
@@ -55,8 +55,8 @@ sub arraynorm {
     my $result = "";
     my $unproc = "";
     foreach my $str (@string) {
-       $unproc .= $str;
-       $result .= $form eq 'NFC'  ? NFC_partial ($unproc) :
+        $unproc .= $str;
+        $result .= $form eq 'NFC'  ? NFC_partial ($unproc) :
                   $form eq 'NFD'  ? NFD_partial ($unproc) :
                   $form eq 'NFKC' ? NFKC_partial($unproc) :
                   $form eq 'NFKD' ? NFKD_partial($unproc) :
index 4e40a49..7f19e93 100644 (file)
@@ -12,8 +12,8 @@ BEGIN {
 
 BEGIN {
     if ($ENV{PERL_CORE}) {
-       chdir('t') if -d 't';
-       @INC = $^O eq 'MacOS' ? qw(::lib) : qw(../lib);
+        chdir('t') if -d 't';
+        @INC = $^O eq 'MacOS' ? qw(::lib) : qw(../lib);
     }
 }
 
@@ -55,8 +55,8 @@ sub arraynorm {
     my $result = "";
     my $unproc = "";
     foreach my $str (@string) {
-       $unproc .= $str;
-       $result .= normalize_partial($form, $unproc);
+        $unproc .= $str;
+        $result .= normalize_partial($form, $unproc);
     }
     $result .= $unproc;
     return $result;
index a0a7caa..38c6985 100644 (file)
@@ -12,8 +12,8 @@ BEGIN {
 
 BEGIN {
     if ($ENV{PERL_CORE}) {
-       chdir('t') if -d 't';
-       @INC = $^O eq 'MacOS' ? qw(::lib) : qw(../lib);
+        chdir('t') if -d 't';
+        @INC = $^O eq 'MacOS' ? qw(::lib) : qw(../lib);
     }
 }
 
index 560d846..a92957c 100644 (file)
@@ -12,8 +12,8 @@ BEGIN {
 
 BEGIN {
     if ($ENV{PERL_CORE}) {
-       chdir('t') if -d 't';
-       @INC = $^O eq 'MacOS' ? qw(::lib) : qw(../lib);
+        chdir('t') if -d 't';
+        @INC = $^O eq 'MacOS' ? qw(::lib) : qw(../lib);
     }
 }
 
@@ -92,11 +92,11 @@ sub arraynorm {
     my $result = "";
     my $unproc = "";
     foreach my $str (@string) {
-       $unproc .= $str;
-       my $n = normalize($form, $unproc);
-       my($p, $u) = splitOnLastStarter($n);
-       $result .= $p;
-       $unproc  = $u;
+        $unproc .= $str;
+        my $n = normalize($form, $unproc);
+        my($p, $u) = splitOnLastStarter($n);
+        $result .= $p;
+        $unproc  = $u;
     }
     $result .= $unproc;
     return $result;
index 442de8b..cb4b6ea 100644 (file)
@@ -12,8 +12,8 @@ BEGIN {
 
 BEGIN {
     if ($ENV{PERL_CORE}) {
-       chdir('t') if -d 't';
-       @INC = $^O eq 'MacOS' ? qw(::lib) : qw(../lib);
+        chdir('t') if -d 't';
+        @INC = $^O eq 'MacOS' ? qw(::lib) : qw(../lib);
     }
 }
 
index e1dcc87..4fdd121 100644 (file)
@@ -12,8 +12,8 @@ BEGIN {
 
 BEGIN {
     if ($ENV{PERL_CORE}) {
-       chdir('t') if -d 't';
-       @INC = $^O eq 'MacOS' ? qw(::lib) : qw(../lib);
+        chdir('t') if -d 't';
+        @INC = $^O eq 'MacOS' ? qw(::lib) : qw(../lib);
     }
 }