1 |
#!/usr/bin/perl |
#!/usr/bin/perl |
2 |
|
# unicode-muncher -- Script to generate Unicode data for java.lang.Character |
3 |
|
# Copyright (C) 1998, 2002 Free Software Foundation, Inc. |
4 |
|
# |
5 |
|
# This file is part of GNU Classpath. |
6 |
|
# |
7 |
|
# GNU Classpath is free software; you can redistribute it and/or modify |
8 |
|
# it under the terms of the GNU General Public License as published by |
9 |
|
# the Free Software Foundation; either version 2, or (at your option) |
10 |
|
# any later version. |
11 |
|
# |
12 |
|
# GNU Classpath is distributed in the hope that it will be useful, but |
13 |
|
# WITHOUT ANY WARRANTY; without even the implied warranty of |
14 |
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
15 |
|
# General Public License for more details. |
16 |
|
# |
17 |
|
# You should have received a copy of the GNU General Public License |
18 |
|
# along with GNU Classpath; see the file COPYING. If not, write to the |
19 |
|
# Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA |
20 |
|
# 02111-1307 USA. |
21 |
|
# |
22 |
|
# Linking this library statically or dynamically with other modules is |
23 |
|
# making a combined work based on this library. Thus, the terms and |
24 |
|
# conditions of the GNU General Public License cover the whole |
25 |
|
# combination. |
26 |
|
# |
27 |
|
# As a special exception, the copyright holders of this library give you |
28 |
|
# permission to link this library with independent modules to produce an |
29 |
|
# executable, regardless of the license terms of these independent |
30 |
|
# modules, and to copy and distribute the resulting executable under |
31 |
|
# terms of your choice, provided that you also meet, for each linked |
32 |
|
# independent module, the terms and conditions of the license of that |
33 |
|
# module. An independent module is a module which is not derived from |
34 |
|
# or based on this library. If you modify this library, you may extend |
35 |
|
# this exception to your version of the library, but you are not |
36 |
|
# obligated to do so. If you do not wish to do so, delete this |
37 |
|
# exception statement from your version. |
38 |
|
|
39 |
|
|
40 |
# This is lots of really ugly hacked up Perl code. |
# This is lots of really ugly hacked up Perl code. |
41 |
# It works. Don't touch it, or it'll break. |
# It works. Don't touch it, or it'll break. |
42 |
# I'm far from proud of it. If you want to fix it so it |
# I'm far from proud of it. If you want to fix it so it |
44 |
# See unicode.database.format for information on the files |
# See unicode.database.format for information on the files |
45 |
# this program generates. |
# this program generates. |
46 |
|
|
47 |
# usage: unicode-muncher.pl UnicodeData-2.1.2.txt |
# usage: unicode-muncher.pl UnicodeData-3.0.0.txt |
|
|
|
|
# Code for reading BLOCKS.TXT and generating stubs for Character.Subset |
|
|
# |
|
|
# open (BLOCKS, $ARGV[1]) || die "Can't open Unicode block file: $!\n"; |
|
|
# &read_block; |
|
|
# |
|
|
# sub read_block { |
|
|
# ($start, $end, $block) = split(/; /, <BLOCKS>); |
|
|
# chop $block; chop $block; |
|
|
# if ($start =~ /#./) { |
|
|
# &read_block; |
|
|
# } else { |
|
|
# $curr_block++; |
|
|
# |
|
|
# # Generate Character.Subset information |
|
|
# # $block =~ tr/a-z/A-Z/; |
|
|
# # $block =~ y/ ,-/_/; |
|
|
# # print "$block = new Subset('\\u$start', '\\u$end'),\n"; |
|
|
# |
|
|
# $start = hex($start); |
|
|
# $end = hex($end); |
|
|
# |
|
|
# }; |
|
|
# } |
|
48 |
|
|
49 |
sub write_char { |
sub write_char { |
50 |
$S = $jnobreakspace << 5; |
my $wnum = ($jnum < 65534) ? $hex - $jnum : $jnum; |
51 |
print CHAR |
$buf = pack ("Cn3c", ($jmirrored << 6) | ($jnobreakspace << 5) | $cat, |
52 |
(pack ("C", $S | $cat)); |
$wnum, $jupper, $jlower, $jdir); |
53 |
print CHAR (pack ("n", $jnum)); |
print CHAR $buf; |
54 |
print CHAR (pack ("n", $jupper)); |
if (! defined $hash{$buf}) { |
55 |
print CHAR (pack ("n", $jlower)); |
$hash{$buf} = $offset; |
56 |
|
} |
57 |
|
$offset += 8; |
58 |
} |
} |
59 |
|
|
60 |
sub end_block { |
sub end_block { |
61 |
|
my $joffset; |
62 |
print BLOCK (pack ("n", $start)); |
print BLOCK (pack ("n", $start)); |
63 |
print BLOCK (pack ("n", $lhex)); |
print BLOCK (pack ("n", $lhex)); |
64 |
$comp = 0 if ($comp != 1); |
$characters += $lhex - $start + 1; |
65 |
print BLOCK (pack ("C", $comp)); |
$blocks++; |
|
print BLOCK (pack ("N", $offset)); |
|
66 |
|
|
67 |
# calculate next offset |
# calculate next offset |
68 |
if ($comp == 1) { |
if ($comp == 1) { |
69 |
$offset += 7; |
$joffset = $hash{$buf}; |
70 |
} else { |
if ($joffset + 8 < $offset) { # Reuse a previous attribute |
71 |
$offset += (7 * ($lhex - $start + 1)); |
$offset -= 8; |
72 |
|
seek CHAR, $offset, SEEK_SET; |
73 |
|
} |
74 |
|
} else { |
75 |
|
$joffset = $offset - 8 * ($lhex - $start + 1); |
76 |
|
$comp = 0; # Create a string of uncompressed attributes |
77 |
} |
} |
78 |
|
die "sanity: offset out of range!\n" if ($joffset >= 32768); |
79 |
|
print BLOCK (pack ("n", ($comp << 15) | $joffset)); |
80 |
|
|
81 |
# setup next starting block |
# setup next starting block |
82 |
$start = $hex; |
$start = $hex; |
83 |
# default to unknown compression |
# default to unknown compression |
87 |
open (DATA, $ARGV[0]) || die "Can't open Unicode attribute file: $!\n"; |
open (DATA, $ARGV[0]) || die "Can't open Unicode attribute file: $!\n"; |
88 |
|
|
89 |
open (TITLECASE, ">titlecase.uni") || die ("Can't open titlecase file: $!\n"); |
open (TITLECASE, ">titlecase.uni") || die ("Can't open titlecase file: $!\n"); |
90 |
|
binmode TITLECASE; |
91 |
open (CHAR, ">character.uni") || die ("Can't open character file: $!\n"); |
open (CHAR, ">character.uni") || die ("Can't open character file: $!\n"); |
92 |
|
binmode CHAR; |
93 |
open (BLOCK, ">block.uni") || die ("Can't open block file: $!\n"); |
open (BLOCK, ">block.uni") || die ("Can't open block file: $!\n"); |
94 |
|
binmode BLOCK; |
95 |
|
|
96 |
$| = 1; |
$| = 1; |
97 |
print "GNU Classpath Unicode Attribute Database Generator 1.0\n"; |
print "GNU Classpath Unicode Attribute Database Generator 1.1\n"; |
98 |
print "Copyright (C) 1998, Free Software Foundation, Inc.\n"; |
print "Copyright (C) 1998, 2002 Free Software Foundation, Inc.\n"; |
99 |
print "Creating"; |
print "Creating"; |
100 |
|
|
101 |
$offset = 0; |
$offset = 0; |
102 |
$hex = -1; |
$hex = -1; |
103 |
|
$buf = ""; |
104 |
|
$characters = 0; |
105 |
|
$blocks = 0; |
106 |
|
$ignored = 0; |
107 |
while (<DATA>) { |
while (<DATA>) { |
108 |
$llhex = $lhex; |
$llhex = $lhex; |
109 |
$lhex = $hex; |
$lhex = $hex; |
115 |
|
|
116 |
# convert unicode index strings to hex |
# convert unicode index strings to hex |
117 |
$hex = hex($hex); |
$hex = hex($hex); |
118 |
|
if ($hex > 0xffff) { # Ignore surrogates, since Java does |
119 |
|
$ignored++; |
120 |
|
$lhex = $llhex; |
121 |
|
$hex = $lhex; |
122 |
|
next; |
123 |
|
} |
124 |
$upcase = hex($upcase); |
$upcase = hex($upcase); |
125 |
$lowcase = hex($lowcase); |
$lowcase = hex($lowcase); |
126 |
$titlecase = hex($titlecase); |
$titlecase = hex($titlecase); |
127 |
|
|
|
# read blocks - code used only when counting absolute blocks |
|
|
# print "end of block\n" if (($lhex+1) != $hex); |
|
|
# # read blocks until we find a valid range |
|
|
# while ($hex > $end) { |
|
|
# &read_block; |
|
|
# } |
|
|
# # $curr_block now contains the correct block |
|
|
|
|
|
# handle isIdentifierIgnorable() |
|
|
# this is according to the javadoc spec, which is broken. |
|
|
# $jidentignore = ($category =~ /(Cf)|(Cc)/ && |
|
|
# !($unicode1n =~ /SEPARATOR|RETURN|TAB|FEED/)) ? 1 : 0; |
|
|
|
|
128 |
$jnobreakspace = ($category eq "Zs" && $decomp =~ /noBreak/) ? 1 : 0; |
$jnobreakspace = ($category eq "Zs" && $decomp =~ /noBreak/) ? 1 : 0; |
129 |
|
|
130 |
# handle getNumericValue() |
# handle getNumericValue(). $jnum is either -1 for no value, -2 for |
131 |
|
# non-positive integer value, or the offset of the value from $hex |
132 |
if ($numeric eq "") { |
if ($numeric eq "") { |
133 |
$jnum = 65535; # does not have a numeric value |
$jnum = 65535; # does not have a numeric value |
134 |
|
# Special case sequences of 'a'-'z' |
135 |
|
if ($hex >= 0x0041 && $hex <= 0x005a) { |
136 |
|
$jnum = 0x0037; |
137 |
|
} elsif ($hex >= 0x0061 && $hex <= 0x007a) { |
138 |
|
$jnum = 0x0057; |
139 |
|
} elsif ($hex >= 0xff21 && $hex <= 0xff3a) { |
140 |
|
$jnum = 0xff17; |
141 |
|
} elsif ($hex >= 0xff41 && $hex <= 0xff5a) { |
142 |
|
$jnum = 0xff37; |
143 |
|
} |
144 |
} else { |
} else { |
145 |
if ($numeric =~ /^[0-9]+$/) { |
if ($numeric =~ /^[0-9]+$/) { |
146 |
$jnum = $numeric; # nonnegative integer value |
$jnum = $hex - $numeric; # nonnegative integer value |
147 |
die "sanity: numeric out of range!\n" if ($jnum >= 65534); |
die "sanity: numeric out of range!\n" if ($jnum >= 65534 || |
148 |
} else { |
$jnum <= -65534); |
149 |
|
} else { |
150 |
$jnum = 65534; # other integer value |
$jnum = 65534; # other integer value |
151 |
} |
} |
152 |
} |
} |
153 |
|
|
154 |
# handle uppercase mapping |
# handle uppercase mapping - use the offset from $hex |
155 |
$jupper = $upcase; |
$jupper = ($upcase == 0) ? 0 : ($hex - $upcase); |
156 |
|
|
157 |
# handle lowercase mapping |
# handle lowercase mapping - use the offset from $hex |
158 |
$jlower = $lowcase; |
$jlower = ($lowcase == 0) ? 0 : ($hex - $lowcase); |
159 |
|
|
160 |
# handle titlecase mapping - go ahead and output to file |
# handle titlecase mapping - go ahead and output to file |
161 |
if ($titlecase != $upcase && $titlecase != 0 && $upcase != 0) { |
if ($titlecase != $upcase) { |
162 |
|
$titlecase = $hex if ($titlecase == 0); |
163 |
print TITLECASE (pack ("n2", $hex, $titlecase)); |
print TITLECASE (pack ("n2", $hex, $titlecase)); |
164 |
} |
} |
165 |
|
|
195 |
if (/Sc/) { $cat = 26; last CAT; } # symbol, currency |
if (/Sc/) { $cat = 26; last CAT; } # symbol, currency |
196 |
if (/Sk/) { $cat = 27; last CAT; } # symbol, modifier |
if (/Sk/) { $cat = 27; last CAT; } # symbol, modifier |
197 |
if (/So/) { $cat = 28; last CAT; } # symbol, other |
if (/So/) { $cat = 28; last CAT; } # symbol, other |
198 |
|
if (/Pi/) { $cat = 29; last CAT; } # punctuation, initial quote |
199 |
|
if (/Pf/) { $cat = 30; last CAT; } # punctuation, final quote |
200 |
|
$cat = 0; # unassigned |
201 |
|
} |
202 |
|
|
203 |
|
# handle mirrored characters |
204 |
|
$jmirrored = ($mirrored eq "Y") ? 1 : 0; |
205 |
|
|
206 |
|
# handle directionality |
207 |
|
$_ = $bidir; |
208 |
|
BIDIR: { |
209 |
|
if (/^L$/) { $jdir = 0; last BIDIR; } # Left-to-Right |
210 |
|
if (/^R$/) { $jdir = 1; last BIDIR; } # Right-to-Left |
211 |
|
if (/^AL$/) { $jdir = 2; last BIDIR; } # Right-to-Left Arabic |
212 |
|
if (/^EN$/) { $jdir = 3; last BIDIR; } # European Number |
213 |
|
if (/^ES$/) { $jdir = 4; last BIDIR; } # European Numer Separator |
214 |
|
if (/^ET$/) { $jdir = 5; last BIDIR; } # European Numer Terminator |
215 |
|
if (/^AN$/) { $jdir = 6; last BIDIR; } # Arabic Number |
216 |
|
if (/^CS$/) { $jdir = 7; last BIDIR; } # Common Number Separator |
217 |
|
if (/^NSM$/) { $jdir = 8; last BIDIR; } # Non-Spacing Mark |
218 |
|
if (/^BN$/) { $jdir = 9; last BIDIR; } # Boundary Neutral |
219 |
|
if (/^B$/) { $jdir = 10; last BIDIR; } # Paragraph Separator |
220 |
|
if (/^S$/) { $jdir = 11; last BIDIR; } # Segment Separator |
221 |
|
if (/^WS$/) { $jdir = 12; last BIDIR; } # Whitespace |
222 |
|
if (/^ON$/) { $jdir = 13; last BIDIR; } # Other Neutral |
223 |
|
if (/^LRE$/) { $jdir = 14; last BIDIR; } # Left-to-Right Embedding |
224 |
|
if (/^LRO$/) { $jdir = 15; last BIDIR; } # Left-to-Right Override |
225 |
|
if (/^RLE$/) { $jdir = 16; last BIDIR; } # Right-to-Left Embedding |
226 |
|
if (/^RLO$/) { $jdir = 17; last BIDIR; } # Right-to-Left Override |
227 |
|
if (/^PDF$/) { $jdir = 18; last BIDIR; } # Pop Directional Format |
228 |
|
$jdir = -1; # undefined |
229 |
} |
} |
230 |
|
|
231 |
CHAR: { |
CHAR: { |
232 |
# starting point |
# starting point |
233 |
if ($hex == 0) { |
if ($hex == 0) { |
234 |
&write_char; |
&write_char; |
235 |
$comp = 2; # compressed block state unknown until next ch |
$comp = 2; # compressed block state unknown until next ch |
236 |
$start = 0; |
$start = 0; |
237 |
$offset = 0; |
last CHAR; |
|
last CHAR; |
|
238 |
} |
} |
239 |
|
|
240 |
# handle mandatory blocks |
# handle mandatory blocks |
252 |
} |
} |
253 |
|
|
254 |
# not sequential, end block. |
# not sequential, end block. |
255 |
if (($lhex+1) != $hex) { |
if (($lhex+1) != $hex) { |
256 |
&end_block; |
&end_block; |
257 |
&write_char; |
&write_char; |
258 |
last CHAR; |
last CHAR; |
259 |
} |
} |
260 |
|
|
261 |
# check to see if we can compress this character into the current block |
# check to see if we can compress this character into the current block |
263 |
$jnum == $ljnum && |
$jnum == $ljnum && |
264 |
$jnobreakspace == $ljnobreakspace && |
$jnobreakspace == $ljnobreakspace && |
265 |
$jupper == $ljupper && |
$jupper == $ljupper && |
266 |
$jlower == $ljlower) { |
$jlower == $ljlower && |
267 |
|
$jmirrored == $ljmirrored && |
268 |
|
$jdir == $ljdir) { |
269 |
if ($comp == 2) { $comp = 1; } # start compressing |
if ($comp == 2) { $comp = 1; } # start compressing |
270 |
# end uncompressed block |
# end uncompressed block |
271 |
if ($comp == 0) { |
if ($comp == 0) { |
272 |
$tmp = $lhex; |
$tmp = $lhex; |
273 |
$lhex = $llhex; |
$lhex = $llhex; |
274 |
|
$offset -= 8; |
275 |
&end_block; |
&end_block; |
276 |
$start = $lhex = $tmp; |
$start = $lhex = $tmp; |
277 |
$comp = 1; |
$offset += 8; |
278 |
|
$comp = 1; |
279 |
} |
} |
280 |
} else { |
} else { |
281 |
if ($comp == 2) { $comp = 0; }; |
if ($comp == 2) { $comp = 0; }; |
282 |
if ($comp == 1) { &end_block; $comp = 2; } |
if ($comp == 1) { &end_block; } |
283 |
&write_char; |
&write_char; |
284 |
} |
} |
285 |
} |
} |
290 |
$ljnobreakspace = $jnobreakspace; |
$ljnobreakspace = $jnobreakspace; |
291 |
$ljupper = $jupper; |
$ljupper = $jupper; |
292 |
$ljlower = $jlower; |
$ljlower = $jlower; |
293 |
|
$ljmirrored = $jmirrored; |
294 |
|
$ljdir = $jdir; |
295 |
} |
} |
296 |
$lhex = $hex; # setup final block write |
$lhex = $hex; # setup final block write |
297 |
&end_block; # write final block |
&end_block; # write final block |
298 |
|
truncate CHAR, $offset + 8; # remove final duplicate record, if it exists |
299 |
|
|
300 |
close(DATA); |
close(DATA); |
301 |
close(TITLECASE); |
close(TITLECASE); |
303 |
close(BLOCK); |
close(BLOCK); |
304 |
|
|
305 |
print "ok\n"; |
print "ok\n"; |
306 |
|
print "Created " . ($offset + 8)/8 . " attributes for $characters " |
307 |
# Second step of compression -- elimate duplicate compressed blocks |
. "Unicode characters in $blocks blocks.\n" |
308 |
# in char.uni. Should save about 2k; might implement later. |
. "(Ignored $ignored surrogates.)\n"; |
|
# |
|
|
# open (DATA, "<block.uni") || die ("Can't open block file: $!\n"); |
|
|
# open (CHAR, "<character.uni") || die ("Can't open char file: $!\n"); |
|
|
# $offset = 0; |
|
|
# $comp = 0; |
|
|
# while (read DATA, $buf, 9) { |
|
|
# ($start, $end, $comp, $off) = unpack("nnCN", $buf); |
|
|
# if ($comp == 1) { |
|
|
# seek CHAR, $off, 0; |
|
|
# read CHAR, $cbuf, 7; |
|
|
# push @$cbuf, $off; |
|
|
# $arrays{$cbuf} = $cbuf; |
|
|
# } |
|
|
# } |
|