view release on metacpan or  search on metacpan

dist/Unicode-Normalize/mkheader  view on Meta::CPAN

#!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;

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.  But in v5.35, pack U stopped
# trying to compensate
*pack_U = ($] ge 5.020 && $] lt 5.035)
          ? sub { return pack('U*', map { utf8::unicode_to_native($_) } @_); }
          : 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;