From: Nick Ing-Simmons Date: Sun, 31 Dec 2000 21:27:53 +0000 (+0000) Subject: Fix .ucm reading - forgot a chr() X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e0c49a6baed38305536b5d74ba7486451327612c;p=p5sagit%2Fp5-mst-13.2.git Fix .ucm reading - forgot a chr() Start of .ucm write (for .enc to .ucm) p4raw-id: //depot/perlio@8288 --- diff --git a/ext/Encode/compile b/ext/Encode/compile index 21478f8..b890a04 100755 --- 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 \n"; + print C "#include \n"; + print C "#include \n"; + print C "#define U8 U8\n"; + } + print C "#include \"encode.h\"\n"; + } +elsif ($cname =~ /\.enc$/) + { + $doEnc = 1; + } +elsif ($cname =~ /\.ucm$/) { - print C "#include \n"; - print C "#include \n"; - print C "#include \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; + 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"; +}