Salvage bits and pieces from the experimental 'utf8 everywhere'

[p5sagit/p5-mst-13.2.git] / lib / unicode / mktables.PL

diff --git a/lib/unicode/mktables.PL b/lib/unicode/mktables.PL
index bb25305..637050a 100755 (executable)
--- a/lib/unicode/mktables.PL
+++ b/lib/unicode/mktables.PL
@@ -31,7 +31,8 @@ mkdir "To", 0755;
     ['IsSpacePerl',
                  '$cat  =~ /^Z/ ||
                   $code =~ /^(0009|000A|000C|000D)$/',         ''],
-    ['IsBlank',  '$cat  =~ /^Z[^lp]$/ ||  $code eq "0009"',    ''],
+    ['IsBlank',  '$code =~ /^(0020|0009)$/ ||
+                 $cat  =~ /^Z[^lp]$/', ''],
     ['IsDigit',  '$cat =~ /^Nd$/',     ''],
     ['IsUpper',  '$cat =~ /^L[ut]$/',  ''],
     ['IsLower',  '$cat =~ /^Ll$/',     ''],
@@ -230,11 +231,24 @@ mkdir "To", 0755;
 
 # This is not written for speed...
 
+my %InId;
+my $InId = 0;
+
 foreach $file (@todo) {
     my ($table, $wanted, $val) = @$file;
     next if @ARGV and not grep { $_ eq $table } @ARGV;
-    print $table,"\n";
-    if ($table =~ /^(Is|In|To)(.*)/) {
+    print $table, "\n";
+    $table =~ s/\W+//g;
+    if ($table =~ /^In(.+)/) {
+       my $id;
+        unless (exists $InId{$1}) {
+           $InId{$1} = $InId++;
+       }
+       $id = $InId{$1};
+       open(OUT, ">In/$id.pl") or die "Can't create In/$id.pl: $!\n";
+       print OUT "# In/$id.pl $1\n";
+    }
+    elsif ($table =~ /^(Is|To)(.+)/) {
        open(OUT, ">$1/$2.pl") or die "Can't create $1/$2.pl: $!\n";
     }
     else {
@@ -256,9 +270,9 @@ END
 # Must treat blocks specially.
 
 exit if @ARGV and not grep { $_ eq Block } @ARGV;
-print "Block\n";
+print "Blocks\n";
 open(UD, 'Blocks.txt') or die "Can't open Blocks.txt: $!\n";
-open(OUT, ">Block.pl") or die "Can't create Block.pl: $!\n";
+open(OUT, ">Blocks.pl") or die "Can't create Blocks.pl: $!\n";
 print OUT <<EOH;
 # !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!! 
 # This file is built by $0 from e.g. $UnicodeData.
@@ -272,11 +286,17 @@ while (<UD>) {
     next if /^#/;
     next if /^$/;
     chomp;
-    ($code, $last, $name) = split(/; */);
+    ($code, $last, $name) = /^([0-9a-f]+)\.\.([0-9a-f]+); (.+)/i;
     if ($name) {
        print OUT "$code        $last   $name\n";
-       $name =~ s/\s+//g;
-       open(BLOCK, ">In/$name.pl");
+       $name =~ s/\W+//g;
+       my $id;
+        unless (exists $InId{$name}) {
+           $InId{$name} = $InId++;
+       }
+       $id = $InId{$name};
+       open(BLOCK, ">In/$id.pl");
+       print OUT "# In/$id.pl $name\n";
        print BLOCK <<EOH;
 # !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!! 
 # This file is built by $0 from e.g. $UnicodeData.
@@ -294,6 +314,24 @@ END2
 print OUT "END\n";
 close OUT;
 
+open(INID, ">In.pl");
+
+print INID <<EOH;
+# !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!! 
+# This file is built by $0 from e.g. $UnicodeData.
+# Any changes made here will be lost!
+%utf8::In = (
+EOH
+
+# Order doesn't matter but let's prettyprint anyway.
+foreach my $in (sort { $InId{$a} <=> $InId{$b} } keys %InId) {
+    printf INID "%-40s => %3d,\n", "'$in'", $InId{$in};
+}
+
+print INID ");\n";
+
+close(INID);
+
 ##################################################
 
 sub proplist {
@@ -322,7 +360,7 @@ sub proplist {
     elsif ($table =~ /^IsLbrk/) {
        open(UD, "LineBrk.txt") or warn "Can't open $table: $!";
 
-       $split = '($code, $brk, $name) = split(/;/);';
+       $split = '($code, $brk, $name) = /^([0-9a-f]+);(\w+) # (.+)/i;';
     }
     else {
        open(UD, $UnicodeData) or warn "Can't open $UnicodeData: $!";