3 # This script generates "unfcan.h", "unfcpt.h", "unfcmb.h",
4 # "unfcmp.h", and "unfexc.h"
5 # from CombiningClass.pl, Decomposition.pl, CompositionExclusions.txt
6 # in lib/unicore or unicode directory
7 # for Unicode::Normalize.xs. (cf. Makefile.PL)
9 # Usage: <perl mkheader> in command line
10 # or <do 'mkheader'> in perl
19 unless ("A" eq pack('U', 0x41) || "A" eq pack('U', ord("A"))) {
20 die "Unicode::Normalize cannot stringify a Unicode code point\n";
24 our $PACKAGE = 'Unicode::Normalize, mkheader';
26 our $Combin = do "unicore/CombiningClass.pl"
27 || do "unicode/CombiningClass.pl"
28 || croak "$PACKAGE: CombiningClass.pl not found";
30 our $Decomp = do "unicore/Decomposition.pl"
31 || do "unicode/Decomposition.pl"
32 || croak "$PACKAGE: Decomposition.pl not found";
34 our %Combin; # $codepoint => $number : combination class
35 our %Canon; # $codepoint => \@codepoints : canonical decomp.
36 our %Compat; # $codepoint => \@codepoints : compat. decomp.
37 # after _U_stringify(), ($codepoint => $hexstring) for %Canon and %Compat
38 our %Exclus; # $codepoint => 1 : composition exclusions
39 our %Single; # $codepoint => 1 : singletons
40 our %NonStD; # $codepoint => 1 : non-starter decompositions
42 our %Comp1st; # $codepoint => $listname : may be composed with a next char.
43 our %Comp2nd; # $codepoint => 1 : may be composed with a prev char.
44 our %CompList; # $listname,$2nd => $codepoint : composite
47 our $structname = "${prefix}complist";
49 ########## definition of Hangul constants ##########
50 use constant SBase => 0xAC00;
51 use constant SFinal => 0xD7A3; # SBase -1 + SCount
52 use constant SCount => 11172; # LCount * NCount
53 use constant NCount => 588; # VCount * TCount
54 use constant LBase => 0x1100;
55 use constant LFinal => 0x1112;
56 use constant LCount => 19;
57 use constant VBase => 0x1161;
58 use constant VFinal => 0x1175;
59 use constant VCount => 21;
60 use constant TBase => 0x11A7;
61 use constant TFinal => 0x11C2;
62 use constant TCount => 28;
65 my $SIndex = $_[0] - SBase;
66 my $LIndex = int( $SIndex / NCount);
67 my $VIndex = int(($SIndex % NCount) / TCount);
68 my $TIndex = $SIndex % TCount;
72 $TIndex ? (TBase + $TIndex) : (),
74 wantarray ? @ret : pack('U*', @ret);
75 # any element in @ret greater than 0xFF, so no need of u2n conversion.
78 ########## getting full decomposion ##########
81 foreach my $d (@INC) {
82 $f = File::Spec->catfile($d, "unicore", "CompositionExclusions.txt");
83 last if open($fh, $f);
84 $f = File::Spec->catfile($d, "unicode", "CompExcl.txt");
85 last if open($fh, $f);
88 croak "$PACKAGE: neither unicore/CompositionExclusions.txt "
89 . "nor unicode/CompExcl.txt is found in @INC" unless defined $f;
94 $Exclus{ hex($1) } = 1 if /([0-9A-Fa-f]+)/;
100 ## converts string "hhhh hhhh hhhh" to a numeric list
102 sub _getHexArray { map hex, $_[0] =~ /([0-9A-Fa-f]+)/g }
104 while ($Combin =~ /(.+)/g) {
105 my @tab = split /\t/, $1;
106 my $ini = hex $tab[0];
108 $Combin{ $ini } = $tab[2];
110 $Combin{ $_ } = $tab[2] foreach $ini .. hex($tab[1]);
114 while ($Decomp =~ /(.+)/g) {
115 my @tab = split /\t/, $1;
116 my $compat = $tab[2] =~ s/<[^>]+>//;
117 my $dec = [ _getHexArray($tab[2]) ]; # decomposition
118 my $ini = hex($tab[0]); # initial decomposable character
121 @$dec == 2 ? sprintf("${structname}_%06x", $dec->[0]) : 'USELESS';
122 # %04x is bad since it'd place _3046 after _1d157.
125 $Compat{ $ini } = $dec;
128 $Canon{ $ini } = $dec;
131 if ($Combin{ $dec->[0] }) {
134 $CompList{ $listname }{ $dec->[1] } = $ini;
135 $Comp1st{ $dec->[0] } = $listname;
136 $Comp2nd{ $dec->[1] } = 1 if ! $Exclus{$ini};
138 } elsif (@$dec == 1) {
141 croak("Weird Canonical Decomposition of U+$tab[0]");
145 foreach my $u ($ini .. hex($tab[1])) {
146 $Compat{ $u } = $dec;
152 if ($Combin{ $dec->[0] }) {
155 $CompList{ $listname }{ $dec->[1] } = $u;
156 $Comp1st{ $dec->[0] } = $listname;
157 $Comp2nd{ $dec->[1] } = 1 if ! $Exclus{$u};
159 } elsif (@$dec == 1) {
162 croak("Weird Canonical Decomposition of U+$tab[0]");
169 # modern HANGUL JUNGSEONG and HANGUL JONGSEONG jamo
170 foreach my $j (0x1161..0x1175, 0x11A8..0x11C2) {
177 (SBase <= $_ && $_ <= SFinal) ? decomposeHangul($_)
178 : $Canon{$_} ? @{ $Canon{$_} } : $_
180 return join(" ",@src) eq join(" ",@dec) ? @dec : getCanonList(@dec);
181 # condition @src == @dec is not ok.
187 (SBase <= $_ && $_ <= SFinal) ? decomposeHangul($_)
188 : $Compat{$_} ? @{ $Compat{$_} } : $_
190 return join(" ",@src) eq join(" ",@dec) ? @dec : getCompatList(@dec);
191 # condition @src == @dec is not ok.
194 # exhaustive decomposition
195 foreach my $key (keys %Canon) {
196 $Canon{$key} = [ getCanonList($key) ];
199 # exhaustive decomposition
200 foreach my $key (keys %Compat) {
201 $Compat{$key} = [ getCompatList($key) ];
205 return "A" eq pack('U', 0x41)
207 : "A" eq pack('U', ord("A"))
208 ? pack('U*', map utf8::unicode_to_native($_), @_)
209 : die "$PACKAGE, a Unicode code point cannot be stringified.\n";
213 sprintf '"%s"', join '',
214 map sprintf("\\x%02x", $_), unpack 'C*', _pack_U(@_);
217 foreach my $hash (\%Canon, \%Compat) {
218 foreach my $key (keys %$hash) {
219 $hash->{$key} = _U_stringify( @{ $hash->{$key} } );
223 ########## writing header files ##########
237 name => "NonStDecomp",
248 my $file = "unfexc.h";
249 open FH, ">$file" or croak "$PACKAGE: $file can't be made";
250 binmode FH; select FH;
254 * This file is auto-generated by mkheader.
255 * Any changes here will be lost!
259 foreach my $tbl (@boolfunc) {
260 my @temp = sort {$a <=> $b} keys %{$tbl->{hash}};
261 my $type = $tbl->{type};
262 my $name = $tbl->{name};
263 print "$type is$name (UV uv)\n{\nreturn\n\t";
266 my $cur = shift @temp;
267 if (@temp && $cur + 1 == $temp[0]) {
268 print "($cur <= uv && uv <= ";
269 while (@temp && $cur + 1 == $temp[0]) {
273 print "\n\t|| " if @temp;
276 print "\n\t|| " if @temp;
279 print "\n\t? TRUE : FALSE;\n}\n\n";
284 ####################################
287 "typedef struct { UV nextchar; UV composite; } $structname;\n\n";
289 foreach my $i (sort keys %CompList) {
290 $compinit .= "$structname $i [] = {\n";
291 $compinit .= join ",\n",
292 map sprintf("\t{ %d, %d }", $_, $CompList{$i}{$_}),
293 sort {$a <=> $b } keys %{ $CompList{$i} };
294 $compinit .= ",\n{0,0}\n};\n\n"; # with sentinel
322 type => "$structname *",
329 foreach my $tbl (@tripletable) {
330 my $file = "$tbl->{file}.h";
331 my $head = "${prefix}$tbl->{name}";
332 my $type = $tbl->{type};
333 my $hash = $tbl->{hash};
334 my $null = $tbl->{null};
335 my $init = $tbl->{init};
337 open FH, ">$file" or croak "$PACKAGE: $file can't be made";
338 binmode FH; select FH;
343 * This file is auto-generated by mkheader.
344 * Any changes here will be lost!
348 print $init if defined $init;
350 foreach my $uv (keys %$hash) {
351 croak sprintf("a Unicode code point 0x%04X over 0x10FFFF.", $uv)
352 unless $uv <= 0x10FFFF;
353 my @c = unpack 'CCCC', pack 'N', $uv;
354 $val{ $c[1] }{ $c[2] }{ $c[3] } = $hash->{$uv};
357 foreach my $p (sort { $a <=> $b } keys %val) {
358 next if ! $val{ $p };
359 for (my $r = 0; $r < 256; $r++) {
360 next if ! $val{ $p }{ $r };
361 printf "$type ${head}_%02x_%02x [256] = {\n", $p, $r;
362 for (my $c = 0; $c < 256; $c++) {
363 print "\t", defined $val{$p}{$r}{$c}
364 ? "($type)".$val{$p}{$r}{$c}
366 print ',' if $c != 255;
367 print "\n" if $c % 8 == 7;
372 foreach my $p (sort { $a <=> $b } keys %val) {
373 next if ! $val{ $p };
374 printf "$type* ${head}_%02x [256] = {\n", $p;
375 for (my $r = 0; $r < 256; $r++) {
376 print $val{ $p }{ $r }
377 ? sprintf("${head}_%02x_%02x", $p, $r)
379 print ',' if $r != 255;
380 print "\n" if $val{ $p }{ $r } || ($r+1) % 8 == 0;
384 print "$type** $head [] = {\n";
385 for (my $p = 0; $p <= 0x10; $p++) {
386 print $val{ $p } ? sprintf("${head}_%02x", $p) : "NULL";
387 print ',' if $p != 0x10;