3 # This script generates "unfcan.h", "unfcpt.h", "unfcmb.h",
4 # "unfcmp.h", and "unfexc.h"
5 # from CombiningClass.pl, Decomposition.pl, CompExcl.txt
6 # in lib/unicore or unicode directory
7 # for Unicode::Normalize.xs. (cf. Makefile.PL)
14 our $PACKAGE = 'Unicode::Normalize, mkheader';
16 our $Combin = do "unicore/CombiningClass.pl"
17 || do "unicode/CombiningClass.pl"
18 || croak "$PACKAGE: CombiningClass.pl not found";
20 our $Decomp = do "unicore/Decomposition.pl"
21 || do "unicode/Decomposition.pl"
22 || croak "$PACKAGE: Decomposition.pl not found";
24 our %Combin; # $codepoint => $number : combination class
25 our %Canon; # $codepoint => $hexstring : canonical decomp.
26 our %Compat; # $codepoint => $hexstring : compat. decomp.
27 our %Compos; # $string => $codepoint : composite
28 our %Exclus; # $codepoint => 1 : composition exclusions
29 our %Single; # $codepoint => 1 : singletons
30 our %NonStD; # $codepoint => 1 : non-starter decompositions
34 foreach my $d (@INC) {
36 $f = File::Spec->catfile($d, "unicore", "CompositionExclusions.txt");
37 last if open($fh, $f);
38 $f = File::Spec->catfile($d, "unicode", "CompExcl.txt");
39 last if open($fh, $f);
42 croak "$PACKAGE: CompExcl.txt not found in @INC" unless defined $f;
46 $Exclus{ hex($1) } =1 if /([0-9A-Fa-f]+)/;
51 while ($Combin =~ /(.+)/g) {
52 my @tab = split /\t/, $1;
53 my $ini = hex $tab[0];
55 $Combin{ $ini } = $tab[2];
57 $Combin{ $_ } = $tab[2] foreach $ini .. hex($tab[1]);
61 while ($Decomp =~ /(.+)/g) {
62 my @tab = split /\t/, $1;
63 my $compat = $tab[2] =~ s/<[^>]+>//;
64 my $dec = [ _getHexArray($tab[2]) ]; # decomposition
65 my $com = pack('U*', @$dec); # composable sequence
66 my $ini = hex($tab[0]); # initial decomposable character
68 $Compat{ $ini } = $dec;
71 $Canon{ $ini } = $dec;
74 if ($Combin{ $dec->[0] }) {
77 $Compos{ $com } = $ini;
84 foreach my $u ($ini .. hex($tab[1])){
90 if ($Combin{ $dec->[0] }) {
103 # exhaustive decomposition
104 foreach my $key (keys %Canon) {
105 $Canon{$key} = [ getCanonList($key) ];
108 # exhaustive decomposition
109 foreach my $key (keys %Compat) {
110 $Compat{$key} = [ getCompatList($key) ];
115 my @dec = map $Canon{$_} ? @{ $Canon{$_} } : $_, @src;
116 return join(" ",@src) eq join(" ",@dec) ? @dec : getCanonList(@dec);
117 # condition @src == @dec is not ok.
122 my @dec = map $Compat{$_} ? @{ $Compat{$_} } : $_, @src;
123 return join(" ",@src) eq join(" ",@dec) ? @dec : getCompatList(@dec);
124 # condition @src == @dec is not ok.
127 sub _getHexArray { map hex, $_[0] =~ /([0-9A-Fa-f]+)/g }
130 sprintf '"%s"', join '',
131 map sprintf("\\x%02x", $_), unpack 'C*', pack 'U*', @_;
134 foreach my $hash (\%Canon, \%Compat) {
135 foreach my $key (keys %$hash) {
136 $hash->{$key} = _U_stringify( @{ $hash->{$key} } );
141 my $structname = "${prefix}complist";
143 our (%Comp1st, %Comp2nd, %CompList);
145 foreach (sort keys %Compos) {
146 my @a = unpack('U*', $_);
147 my $val = $Compos{$_};
148 my $name = sprintf "${structname}_%06x", $a[0];
149 $Comp1st{$a[0]} = $name;
150 $Comp2nd{$a[1]} = 1 if ! $Exclus{$Compos{$_}} && ! $Combin{$a[0]};
151 $CompList{$name}{$a[1]} = $val;
154 # modern HANGUL JUNGSEONG and HANGUL JONGSEONG jamo
155 foreach (0x1161..0x1175, 0x11A8..0x11C2) {
160 "typedef struct { UV nextchar; UV composite; } $structname;\n\n";
162 foreach my $i (sort keys %CompList) {
163 $compinit .= "$structname $i [] = {\n";
164 $compinit .= join ",\n",
165 map sprintf("\t{ %d, %d }", $_, $CompList{$i}{$_}),
166 sort {$a <=> $b } keys %{ $CompList{$i} };
167 $compinit .= ",\n{0,0}\n};\n\n"; # with sentinel
170 ####################################
184 name => "NonStDecomp",
195 my $file = "unfexc.h";
196 open FH, ">$file" or croak "$PACKAGE: $file can't be made";
197 binmode FH; select FH;
201 * This file is auto-generated by mkheader.
202 * Any changes here will be lost!
206 foreach my $tbl (@boolfunc) {
207 my @temp = sort {$a <=> $b} keys %{$tbl->{hash}};
208 my $type = $tbl->{type};
209 my $name = $tbl->{name};
210 print "$type is$name (UV uv)\n{\nreturn\n\t";
213 my $cur = shift @temp;
214 if (@temp && $cur + 1 == $temp[0]) {
215 print "($cur <= uv && uv <= ";
216 while (@temp && $cur + 1 == $temp[0]) {
220 print "\n\t|| " if @temp;
223 print "\n\t|| " if @temp;
226 print "\n\t? TRUE : FALSE;\n}\n\n";
232 ####################################
259 type => "$structname *",
266 foreach my $tbl (@tripletable) {
267 my $file = "$tbl->{file}.h";
268 my $head = "${prefix}$tbl->{name}";
269 my $type = $tbl->{type};
270 my $hash = $tbl->{hash};
271 my $null = $tbl->{null};
272 my $init = $tbl->{init};
274 open FH, ">$file" or croak "$PACKAGE: $file can't be made";
275 binmode FH; select FH;
280 * This file is auto-generated by mkheader.
281 * Any changes here will be lost!
285 print $init if defined $init;
287 foreach my $uv (keys %$hash) {
288 my @c = unpack 'CCCC', pack 'N', $uv;
289 $val{ $c[1] }{ $c[2] }{ $c[3] } = $hash->{$uv};
292 foreach my $p (sort { $a <=> $b } keys %val) {
293 next if ! $val{ $p };
294 for (my $r = 0; $r < 256; $r++) {
295 next if ! $val{ $p }{ $r };
296 printf "$type ${head}_%02x_%02x [256] = {\n", $p, $r;
297 for (my $c = 0; $c < 256; $c++) {
298 print "\t", defined $val{$p}{$r}{$c}
299 ? "($type)".$val{$p}{$r}{$c}
301 print ',' if $c != 255;
302 print "\n" if $c % 8 == 7;
307 foreach my $p (sort { $a <=> $b } keys %val) {
308 next if ! $val{ $p };
309 printf "$type* ${head}_%02x [256] = {\n", $p;
310 for (my $r = 0; $r < 256; $r++) {
311 print $val{ $p }{ $r }
312 ? sprintf("${head}_%02x_%02x", $p, $r)
314 print ',' if $r != 255;
315 print "\n" if $val{ $p }{ $r } || ($r+1) % 8 == 0;
319 print "$type** $head [] = {\n";
320 for (my $p = 0; $p <= 0x10; $p++) {
321 print $val{ $p } ? sprintf("${head}_%02x", $p) : "NULL";
322 print ',' if $p != 0x10;