projects / p5sagit/p5-mst-13.2.git / commitdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw (parent: 9b37254)
Fix .ucm reading - forgot a chr()
Nick Ing-Simmons [Sun, 31 Dec 2000 21:27:53 +0000 (21:27 +0000)]
Start of .ucm write (for .enc to .ucm)

p4raw-id: //depot/perlio@8288

ext/Encode/compile patch | blob | blame | history

diff --git a/ext/Encode/compile b/ext/Encode/compile
index 21478f8..b890a04 100755 (executable)
--- a/ext/Encode/compile
+++ b/ext/Encode/compile
@@ -50,32 +50,47 @@ chmod(0666,$cname) if -f $cname && !-w $cname;
 open(C,">$cname") || die "Cannot open $cname:$!";
 my $dname = $cname;
 $dname =~ s/(\.[^\.]*)?$/.def/;
-chmod(0666,$dname) if -f $cname && !-w $dname;
-open(D,">$dname") || die "Cannot open $dname:$!";
-my $hname = $cname;
-$hname =~ s/(\.[^\.]*)?$/.h/;
-chmod(0666,$hname) if -f $cname && !-w $hname;
-open(H,">$hname") || die "Cannot open $hname:$!";
-
-foreach my $fh (\*C,\*D,\*H)
-{
- print $fh <<"END";
+
+my ($doC,$doEnc,$doUcm);
+
+if ($cname =~ /\.(c|xs)$/)
+ {
+  $doC = 1;
+  chmod(0666,$dname) if -f $cname && !-w $dname;
+  open(D,">$dname") || die "Cannot open $dname:$!";
+  my $hname = $cname;
+  $hname =~ s/(\.[^\.]*)?$/.h/;
+  chmod(0666,$hname) if -f $cname && !-w $hname;
+  open(H,">$hname") || die "Cannot open $hname:$!";
+
+  foreach my $fh (\*C,\*D,\*H)
+  {
+   print $fh <<"END";
 /*
  !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
  This file was autogenerated by:
  $^X $0 $cname @ARGV
 */
 END
-}
+  }
 
-if ($cname =~ /(\w+)\.xs$/)
+  if ($cname =~ /(\w+)\.xs$/)
+   {
+    print C "#include <EXTERN.h>\n";
+    print C "#include <perl.h>\n";
+    print C "#include <XSUB.h>\n";
+    print C "#define U8 U8\n";
+   }
+  print C "#include \"encode.h\"\n";
+ }
+elsif ($cname =~ /\.enc$/)
+ {
+  $doEnc = 1;
+ }
+elsif ($cname =~ /\.ucm$/)
  {
-  print C "#include <EXTERN.h>\n";
-  print C "#include <perl.h>\n";
-  print C "#include <XSUB.h>\n";
-  print C "#define U8 U8\n";
+  $doUcm = 1;
  }
-print C "#include \"encode.h\"\n";
 
 my %encoding;
 my %strings;
@@ -114,33 +129,36 @@ foreach my $enc (sort cmp_name @ARGV)
    }
  }
 
-foreach my $enc (sort cmp_name keys %encoding)
+if ($doC)
  {
-  my $sym = "${enc}_encoding";
-  $sym =~ s/\W+/_/g;
-  print C "encode_t $sym = \n";
-  print C " {",join(',',"\"$enc\"",@{$encoding{$enc}}),"};\n\n";
- }
+  foreach my $enc (sort cmp_name keys %encoding)
+   {
+    my $sym = "${enc}_encoding";
+    $sym =~ s/\W+/_/g;
+    print C "encode_t $sym = \n";
+    print C " {",join(',',"\"$enc\"",@{$encoding{$enc}}),"};\n\n";
+   }
 
-foreach my $enc (sort cmp_name keys %encoding)
- {
-  my $sym = "${enc}_encoding";
-  $sym =~ s/\W+/_/g;
-  print H "extern encode_t $sym;\n";
-  print D " Encode_Define(aTHX_ &$sym);\n";
- }
+  foreach my $enc (sort cmp_name keys %encoding)
+   {
+    my $sym = "${enc}_encoding";
+    $sym =~ s/\W+/_/g;
+    print H "extern encode_t $sym;\n";
+    print D " Encode_Define(aTHX_ &$sym);\n";
+   }
 
-if ($cname =~ /(\w+)\.xs$/)
- {
-  my $mod = $1;
-  print C "\nMODULE = Encode::$mod\tPACKAGE = Encode::$mod\n\n";
-  print C "BOOT:\n{\n";
-  print C "#include \"$dname\"\n";
-  print C "}\n";
+  if ($cname =~ /(\w+)\.xs$/)
+   {
+    my $mod = $1;
+    print C "\nMODULE = Encode::$mod\tPACKAGE = Encode::$mod\n\n";
+    print C "BOOT:\n{\n";
+    print C "#include \"$dname\"\n";
+    print C "}\n";
+   }
+  close(D);
+  close(H);
  }
 close(C);
-close(D);
-close(H);
 
 
 sub compile_ucm
@@ -165,7 +183,7 @@ sub compile_ucm
   }
  else
   {
-   $name = lc($cs);
+   # $name = lc($cs);
   }
  my $erep;
  my $urep;
@@ -174,7 +192,7 @@ sub compile_ucm
    my @byte = $attr{'subchar'} =~ /^\s*(?:\\x([0-9a-f]+))+\s*$/;
    $erep = join('',map(hex($_),@byte));
   }
- warn "Scanning $cs\n";
+ warn "Scanning $name ($cs)\n";
  my $nfb = 0;
  my $hfb = 0;
  while (<$fh>)
@@ -187,7 +205,7 @@ sub compile_ucm
    if (defined($u))
     {
      my $uch = encode_U(hex($u));
-     my $ech = join('',map(hex($_),@byte));
+     my $ech = join('',map(chr(hex($_)),@byte));
      if (length($fb))
       {
        $fb = substr($fb,1);
@@ -216,10 +234,21 @@ sub compile_ucm
   {
    die "$nfb entries without fallback, $hfb entries with\n";
   }
- output($ch,$name.'_utf8',$e2u);
- output($ch,'utf8_'.$name,$u2e);
- $encoding{$name} = [$e2u->{Cname},$u2e->{Cname},
-                     outstring($ch,$e2u->{Cname}.'_def',$erep),length($erep)];
+ if ($doC)
+  {
+   output($ch,$name.'_utf8',$e2u);
+   output($ch,'utf8_'.$name,$u2e);
+   $encoding{$name} = [$e2u->{Cname},$u2e->{Cname},
+                       outstring($ch,$e2u->{Cname}.'_def',$erep),length($erep)];
+  }
+ elsif ($doEnc)
+  {
+   output_enc($ch,$name,$e2u);
+  }
+ elsif ($doUcm)
+  {
+   output_ucm($ch,$name,$u2e);
+  }
 }
 
 sub compile_enc
@@ -272,10 +301,21 @@ sub compile_enc
       }
     }
   }
- output($ch,$name.'_utf8',$e2u);
- output($ch,'utf8_'.$name,$u2e);
- $encoding{$name} = [$e2u->{Cname},$u2e->{Cname},
-                     outstring($ch,$e2u->{Cname}.'_def',$rep),length($rep)];
+ if ($doC)
+  {
+   output($ch,$name.'_utf8',$e2u);
+   output($ch,'utf8_'.$name,$u2e);
+   $encoding{$name} = [$e2u->{Cname},$u2e->{Cname},
+                       outstring($ch,$e2u->{Cname}.'_def',$rep),length($rep)];
+  }
+ elsif ($doEnc)
+  {
+   output_enc($ch,$name,$e2u);
+  }
+ elsif ($doUcm)
+  {
+   output_ucm($ch,$name,$u2e);
+  }
 }
 
 sub enter
@@ -407,6 +447,7 @@ sub outtable
    my ($s,$e,$out,$t,$end,$l,$fb) = @{$a->{$b}};
    my $sc = ord($s);
    my $ec = ord($e);
+   $end |= 0x80 if $fb;
    print  $fh "{";
    if ($l)
     {
@@ -430,4 +471,60 @@ sub output
  outtable($fh,$a);
 }
 
+sub output_enc
+{
+ my ($fh,$name,$a) = @_;
+ foreach my $b (sort keys %$a)
+  {
+   my ($s,$e,$out,$t,$end,$l,$fb) = @{$a->{$b}};
+  }
+}
+
+sub decode_U
+{
+ my $s = shift;
+
+}
+
+
+sub output_ucm_page
+{
+ my ($fh,$a,$t,$pre) = @_;
+ # warn sprintf("Page %x\n",$pre);
+ foreach my $b (sort keys %$t)
+  {
+   my ($s,$e,$out,$n,$end,$l,$fb) = @{$t->{$b}};
+   die "oops $s $e" unless $s eq $e;
+   my $u = ord($s);
+   if ($n != $a && $n != $t)
+    {
+     output_ucm_page($fh,$a,$n,(($pre|($u &0x3F)) << 6)&0xFFFF);
+    }
+   elsif (length($out))
+    {
+     if ($pre)
+      {
+       $u = $pre|($u &0x3f);
+      }
+     printf $fh "<U%04X> ",$u;
+     foreach my $c (split(//,$out))
+      {
+       printf $fh "\\x%02X",ord($c);
+      }
+     printf $fh " |%d\n",($fb ? 1 : 0);
+    }
+   else
+    {
+     warn join(',',@{$t->{$b}},$a,$t);
+    }
+  }
+}
+
+sub output_ucm
+{
+ my ($fh,$name,$a) = @_;
+ print $fh "CHARMAP\n";
+ output_ucm_page($fh,$a,$a,0);
+ print $fh "END CHARMAP\n";
+}
 
Unnamed repository; edit this file to name it for gitweb.