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
29 our %Exclus; # $codepoint => 1 : composition exclusions
33 foreach my $d (@INC) {
35 $f = File::Spec->catfile($d, "unicore", "CompExcl.txt");
36 last if open($fh, $f);
37 $f = File::Spec->catfile($d, "unicode", "CompExcl.txt");
38 last if open($fh, $f);
41 croak "$PACKAGE: CompExcl.txt not found in @INC" unless defined $f;
45 $Exclus{ hex($1) } =1 if /([0-9A-Fa-f]+)/;
50 while($Combin =~ /(.+)/g) {
51 my @tab = split /\t/, $1;
52 my $ini = hex $tab[0];
54 $Combin{ $ini } = $tab[2];
56 $Combin{ $_ } = $tab[2] foreach $ini .. hex($tab[1]);
60 while($Decomp =~ /(.+)/g) {
61 my @tab = split /\t/, $1;
62 my $compat = $tab[2] =~ s/<[^>]+>//;
63 my $dec = [ _getHexArray($tab[2]) ]; # decomposition
64 my $com = pack('U*', @$dec); # composable sequence
65 my $ini = hex($tab[0]);
67 $Compat{ $ini } = $dec;
69 $Canon{ $ini } = $dec;
70 $Compos{ $com } = $ini if @$dec > 1;
73 foreach my $u ($ini .. hex($tab[1])){
77 $Compos{ $com } = $ini if @$dec > 1;
83 # exhaustive decomposition
84 foreach my $key (keys %Canon) {
85 $Canon{$key} = [ getCanonList($key) ];
88 # exhaustive decomposition
89 foreach my $key (keys %Compat) {
90 $Compat{$key} = [ getCompatList($key) ];
95 my @dec = map $Canon{$_} ? @{ $Canon{$_} } : $_, @src;
96 join(" ",@src) eq join(" ",@dec) ? @dec : getCanonList(@dec);
97 # condition @src == @dec is not ok.
102 my @dec = map $Compat{$_} ? @{ $Compat{$_} } : $_, @src;
103 join(" ",@src) eq join(" ",@dec) ? @dec : getCompatList(@dec);
104 # condition @src == @dec is not ok.
109 map hex(), $str =~ /([0-9A-Fa-f]+)/g;
113 sprintf '"%s"', join '',
114 map sprintf("\\x%2x", $_), unpack 'C*', pack 'U*', @_;
117 foreach my $hash (\%Canon, \%Compat) {
118 foreach my $key (keys %$hash) {
119 $hash->{$key} = _U_stringify( @{ $hash->{$key} } );
125 return $uv < 0x80 ? 1 :
129 croak "$PACKAGE: illegal char in the composite. utf-8 max is 0x10ffff.";
134 return $uv < 0xA0 ? 1 :
139 croak "$PACKAGE: illegal char in the composite. utf-8 max is 0x10ffff.";
144 my $structname = "${prefix}complist";
146 our (%Comp1st, %CompList);
148 my $errExpand = "$PACKAGE: A composable pair in %s "
149 . "is longer than the composite in bytes!\n"
150 . "%d + %d => %d\nQuit. Please inform the author...";
152 foreach(sort keys %Compos) {
153 my @a = unpack('U*', $_);
154 my $val = $Compos{$_};
155 my $name = sprintf "${structname}_%06x", $a[0];
156 $Comp1st{ $a[0] } = $name;
157 $CompList{ $name }{ $a[1] } = $val;
159 if( utf8len($a[0]) + utf8len($a[1]) < utf8len($val) ) {
160 croak sprintf($errExpand, "utf-8", $a[0], $a[1], $val);
162 if( utfebcdiclen($a[0]) + utfebcdiclen($a[1]) < utfebcdiclen($val)) {
163 croak sprintf($errExpand, "utf-ebcdic", $a[0], $a[1], $val);
168 "typedef struct { UV nextchar; UV composite; } $structname;\n\n";
170 foreach my $i (sort keys %CompList) {
171 $compinit .= "$structname $i [] = {\n";
172 $compinit .= join ",\n",
173 map sprintf("\t{ %d, %d }", $_, $CompList{$i}{$_}),
174 sort {$a <=> $b } keys %{ $CompList{$i} };
175 $compinit .= ",\n{0,0}\n};\n\n"; # with sentinel
178 ####################################
180 my @Exclus = sort {$a <=> $b} keys %Exclus;
182 my $file = "unfexc.h";
183 open FH, ">$file" or croak "$PACKAGE: $file can't be made";
184 binmode FH; select FH;
186 print "bool isExclusion (UV uv) \n{\nreturn\n\t";
189 my $cur = shift @Exclus;
190 if(@Exclus && $cur + 1 == $Exclus[0]) {
191 print "($cur <= uv && uv <= ";
192 while(@Exclus && $cur + 1 == $Exclus[0]) {
193 $cur = shift @Exclus;
196 print "\n\t|| " if @Exclus;
199 print "\n\t|| " if @Exclus;
203 print "\n\t? TRUE : FALSE;\n}\n\n";
206 ####################################
233 type => "$structname *",
240 foreach my $tbl (@tripletable) {
241 my $file = "$tbl->{file}.h";
242 my $head = "${prefix}$tbl->{name}";
243 my $type = $tbl->{type};
244 my $hash = $tbl->{hash};
245 my $null = $tbl->{null};
246 my $init = $tbl->{init};
248 open FH, ">$file" or croak "$PACKAGE: $file can't be made";
249 binmode FH; select FH;
254 * This file is auto-generated by mkheader.
255 * Any changes here will be lost!
259 print $init if defined $init;
261 foreach my $uv (keys %$hash) {
262 my @c = unpack 'CCCC', pack 'N', $uv;
263 $val{ $c[1] }{ $c[2] }{ $c[3] } = $hash->{$uv};
266 foreach my $p (sort { $a <=> $b } keys %val) {
267 next if ! $val{ $p };
268 for(my $r = 0; $r < 256; $r++){
269 next if ! $val{ $p }{ $r };
270 printf "$type ${head}_%02x_%02x [256] = {\n", $p, $r;
271 for(my $c = 0; $c < 256; $c++){
272 print "\t", defined $val{$p}{$r}{$c} ? $val{$p}{$r}{$c} : $null;
273 print ',' if $c != 255;
274 print "\n" if $c % 8 == 7;
279 foreach my $p (sort { $a <=> $b } keys %val) {
280 next if ! $val{ $p };
281 printf "$type* ${head}_%02x [256] = {\n", $p;
282 for(my $r = 0; $r < 256; $r++){
283 print $val{ $p }{ $r } ? sprintf("${head}_%02x_%02x", $p, $r) : "NULL";
284 print ',' if $r != 255;
285 print "\n" if $val{ $p }{ $r } || ($r+1) % 8 == 0;
289 print "$type** $head [] = {\n";
290 for(my $p = 0; $p <= 0x10; $p++){
291 print $val{ $p } ? sprintf("${head}_%02x", $p) : "NULL";
292 print ',' if $p != 0x10;