From: imiyazaki <imiyazaki>
Date: Sun, 2 Nov 2003 14:29:46 +0000 (+0000)
Subject: support perl 5.8 only.
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=a82c439ebc29aad941631860fdd786270458a8d5;p=chise%2Fomega.git

support perl 5.8 only.
change order options.
---

diff --git a/chise2otf/chise2otf b/chise2otf/chise2otf
index f736029..bf9418f 100755
--- a/chise2otf/chise2otf
+++ b/chise2otf/chise2otf
@@ -1,4 +1,4 @@
-#!/usr/bin/perl
+#!/usr/bin/perl -w -CID
 
 use strict;
 use vars qw($opt_in_cs $opt_order $opt_kage $opt_replace
@@ -13,9 +13,10 @@ use vars qw($opt_in_cs $opt_order $opt_kage $opt_replace
 	    @CDP @HZK @GT
 	    );
 use Getopt::Long;
-use utf8;
 use Fcntl ':flock';
+use utf8;
 use Chise_utils ':all';
+require 5.008;
 
 my $omegadb_path="/usr/local/lib/chise/omega";
 $omegadb_path=~s!/$!!;
@@ -24,19 +25,6 @@ my $makefonts="$omegadb_path/makefonts.pl";
 my $exec_makefonts=0;
 my $geta=pack("S",8750|0x8080);
 
-if($^V and $^V ge v5.8){
-    $perl58=1;
-}elsif($^V and $^V ge v5.6){
-    $perl56=1;
-}else{
-    print STDERR "This versin is not supported.";
-}
-if($perl58){
-    eval "use Encode";
-    binmode(STDIN, ':encoding(utf8)');
-    binmode(STDOUT, ':encoding(utf8)');
-}
-
 &GetOptions("in=s"=>\$opt_in_cs,
 	    "order=s"=>\$opt_order,
 	    "replace",\$opt_replace,
@@ -52,7 +40,7 @@ Usage: $0 [-i <input coding system>] [-o <order of kanji>] [-k] <filename>
        g: GB
        j: JIS
        k: KS
-       t: GT
+       G: GT
        m: Multi, use \\UTFM of otf.sty
       You can also combine them, ex. jtcgkm
     k: use Kage server.
@@ -63,7 +51,7 @@ EOF
 	'g'=>'UniGB',
 	'j'=>'UniJIS',
 	'k'=>'UniKS',
-	't'=>'GT',
+	'G'=>'GT',
 	'm'=>'Multi',
 	);
 
@@ -95,7 +83,7 @@ if(not defined($opt_order)){
 }
 
 if(defined($opt_order)){
-    if($opt_order=~/^[cgjktm]+$/){
+    if($opt_order=~/^[cgjkGm]+$/){
 	@order=split(//,$opt_order);
 	@order=map {$order{$_}} @order;
     }else{
@@ -158,7 +146,7 @@ while(<>){
     if($in_cs ne 'ucs@mcs'){
 	s/(.)/pack("U",&get_char_id(unpack("U",$1),$in_cs))/ge;
     }
-    s/((?:^|[^\\])(?:\\\\)*)(&.*?;)/$1.&de_er($2)/ge;
+    s/((?:^|[^\\])(?:\\\\)*)(&.*?;)/&de_tex_er($1,$2)/ge;
     s/((?:^|[^\\])(?:\\\\)*)\\([$idc])/$1.'\UTFM{'.sprintf("%X",unpack("U",$2)).'}'/ge;
     @chars=split(//);
     for($i=0;$i<=$#chars;$i++){
@@ -208,13 +196,12 @@ while(<>){
 print IDSDATA 'use utf8;',"\n";
 foreach $ids (keys %ids){
     print IDSDATA '$ids{\'',$ids,'\'}='
-	,'[',join ",",@{$ids{$ids}},"];\n" if($perl56);
-    print IDSDATA '$ids{\'',encode('utf8',$ids),'\'}='
-	,'[',join ",",@{$ids{$ids}},"];\n" if($perl58);
+    ,'[',join ",",@{$ids{$ids}},"];\n";
 }
 print IDSDATA '$font_start=',$font_start,";\n";
 print IDSDATA '$ids_start=',$ids_start,";\n";
 print IDSDATA "1;";
+flock(IDSDATA,LOCK_UN);
 
 if($exec_makefonts){
     if(-f $makefonts){
@@ -227,6 +214,30 @@ if($exec_makefonts){
 
 exit 0;
 
+sub de_tex_er{
+    my($before_er,$er)=@_;
+    my($prefix,$suffix);
+    my($output_char,$atr,$value);
+    $er=~/^(\&)(.*)(;)$/
+	and $prefix=$1,$er=$2,$suffix=$3;
+    $prefix or $prefix="",$suffix or $suffix="";
+    if($er=~/^U[\+|\-]([a-fA-F\d]+)/){
+	$output_char=pack("U",hex($1));
+    }elsif($er=~/^(?:I\-)?($er_prefix_re)\-?([0-9a-fA-F]+)$/){
+	($atr,$value)=($1,$2);
+	unless($er_alias{$atr}=~/daikanwa|gt/){
+	    $value=hex($value);
+	}
+	($output_char)=&get_chars_matching($er_alias{$atr},$value);
+	utf8::decode($output_char);
+    }
+    if($output_char){
+	return $before_er.$output_char;
+    }else{
+	return $before_er.$prefix.$er.$suffix;
+    }
+}
+
 sub ids_parse{
     # arguments: none
     # return: return character for output,
@@ -248,8 +259,7 @@ sub ids_parse{
 	       and($out_char=&get_output_char($char_id))){
 		return $out_char;
 	    }else{
-		return &get_macro_for_ids($ids) if($perl56);
-		return encode('utf8', &get_macro_for_ids($ids)) if($perl58);
+		return &get_macro_for_ids($ids);
 	    }
 	}
     }
@@ -266,8 +276,9 @@ sub ids_rest{
     }else{
 	$ids_argc--;
     }
-    $ids.=$char if($perl56);
-    $ids.=encode('utf8',$char) if($perl58);
+    $ids.=$char;
+#    $ids.=$char if($perl56);
+#    $ids.=encode('utf8',$char) if($perl58);
     return ($ids,$ids_argc);
 }
 
@@ -299,7 +310,6 @@ sub normalize_ids{
     # argument: <ids>, <output coding system>
     # return: ids or GETA character if ids is invalid for KAGE.
     my($ids,$out_cs)=@_;
-    $ids = decode('utf8', $ids) if $perl58;
     $out_cs=~s/Uni(.+)/'ucs@'.lc($1)/e;
 
     my $output_ids="";
@@ -387,7 +397,6 @@ sub get_ids{
     my $ids="";
     $ids=&get_char_attribute($char,"ids-aggregated")
 	or &get_char_attribute($char,"ids");
-    $ids=decode('utf8', $ids) if($perl58);
     return $ids;
 }
 
@@ -396,7 +405,6 @@ sub get_char_id_for_ids{
     # return: char-id
     my($ids)=@_;
     my($output_char);
-    $ids=decode('utf8', $ids) if($perl58);
 
     if(($output_char)=&get_chars_matching("ids",$ids)){
 	return unpack("U",$output_char);