fix $asian.

remove unnecessary pack and unpack.
move some utf8::decode to Chise_utils.pm.

diff --git a/inCHISE b/inCHISE
index 2aeb780..0750906 100755 (executable)
--- a/inCHISE
+++ b/inCHISE
@@ -1,4 +1,4 @@
-#!/usr/bin/perl -CSD
+#!/usr/bin/perl -w -CSD
 
 # ver.0.2
 
@@ -10,8 +10,8 @@ use vars qw($omegadb_path
            $opt_help $usage
            $in_cs $out_cs $i @chars
            $char $char_id $out_char
-           $char_id_unified @char_id_unified
-           $ids $ids_argc %ids $idsdb
+           $char_unified @chars_unified
+           $ids $ids_argc %ids $idsdb $geta
            $idsdata_file $ids_start $font_start
            @CDP @HZK @GT
            );
@@ -27,8 +27,8 @@ my $omegadb_path="/usr/local/lib/chise/omega";
 
 #$opt_order{'UniMulti'}='jcgk';
 $opt_order{'UniMulti'}='jGcgkHC';
-$opt_order{'UniGB'}='g';
 $opt_order{'UniCNS'}='c';
+$opt_order{'UniGB'}='g';
 $opt_order{'UniJIS'}='j';
 $opt_order{'UniKS'}='k';
 
@@ -58,7 +58,7 @@ my $forbidden_before
 my $slightly_forbidden_before
     = '\x{000a}\#\-‐−‰′″℃゛゜ゝゞヽヾ＂％－ﾞﾟ';
 
-my $asian = '\x{1100}-\x{11FF}\x{2E80}-\x{D7AF}\x{F900}-\x{FAFF}\x{FE30}-\x{FE4F}\x{FF00}-';
+my $asian = '\x{1100}-\x{11FF}\x{2E80}-\x{D7AF}\x{F900}-\x{FAFF}\x{FE30}-\x{FE4F}\x{FF00}-\x{FFFFFF}';
 
 my $space = '\x{0020}\x{0009}\x{000A}\x{000C}\x{000D}';
 
@@ -119,6 +119,9 @@ if(-e $idsdata_file){
 $ids_argc=0;
 $ids="";
 
+$geta=pack("U",0x3013);
+#$geta=pack("U",0xfffd);
+
 @GT=(#"=gt","=gt-k",
      "=gt-pj-1","=gt-pj-2","=gt-pj-3","=gt-pj-4","=gt-pj-5",
      "=gt-pj-6","=gt-pj-7","=gt-pj-8","=gt-pj-9","=gt-pj-10",
@@ -139,7 +142,7 @@ $ids="";
            'C'=>'CDP',
            );
 
-foreach $out_cs ('UniGB','UniCNS','UniJIS','UniKS','UniMulti'){
+foreach $out_cs ('UniCNS','UniGB','UniJIS','UniKS','UniMulti'){
     if(defined($opt_order{$out_cs})){
        if($opt_order{$out_cs}=~/^[cgjkGHC]+$/){
            @{$order{$out_cs}}=map {$order_map{$_}}
@@ -154,7 +157,7 @@ foreach $out_cs ('UniGB','UniCNS','UniJIS','UniKS','UniMulti'){
 while(<>){
     utf8::decode($_);
     if($in_cs ne 'ucs@mcs'){
-       s/(.)/pack("U",&get_char_id(unpack("U",$1),$in_cs))/ge;
+       s/(.)/&get_char_in_mcs($1,$in_cs)/ge;
     }
     s/(amp.+?;)/&de_tex_er($1)/ge;
 #    s/(&.+?;)/&de_tex_er($1)/ge;
@@ -180,7 +183,7 @@ while(<>){
            print &ids_parse();
            next CHAR;
        }else{
-           if(($out_char=&get_output_char($char_id,$out_cs))){
+           if(($out_char=&get_output_char($char,$out_cs))){
                print $out_char,&add_break($i);
            }elsif($char_id >= 0x20000 && $char_id <=0x2a6df){
                # CJK Unified Ideographs Extension B
@@ -199,11 +202,11 @@ while(<>){
                next CHAR;
            }else{
                if($opt_allow_unify){
-                   @char_id_unified=&get_char_id_unified($char_id);
-                   if(@char_id_unified>0){
-                       foreach $char_id_unified (@char_id_unified){
+                   @chars_unified=&get_chars_unified($char);
+                   if(@chars_unified>0){
+                       foreach $char_unified (@chars_unified){
                            if(($out_char
-                               =&get_output_char($char_id_unified,$out_cs))){
+                               =&get_output_char($char_unified,$out_cs))){
                                print $out_char,&add_break($i);
                                next CHAR;
                            }
@@ -247,7 +250,6 @@ sub de_tex_er{
            $value=hex($value);
        }
        ($output_char)=&get_chars_matching($er_alias{$atr},$value);
-       utf8::decode($output_char);
     }
     if($output_char){
        return $output_char;
@@ -331,18 +333,16 @@ sub ids_parse{
        $i++;
        if($i>$#chars){
            print STDERR "IDS parse error: $ids\n";
-#          return pack("U",0xfffd);
-           return pack("U",0x3013);
+           return $geta;
        }
 
        ($ids,$ids_argc)=&ids_rest($ids,$ids_argc,$chars[$i]);
        if($ids_argc==0){
-           if(($char_id=&get_char_id_for_ids($ids))
-              and($out_char=&get_output_char($char_id,$out_cs))){
+           if(($char=&get_char_for_ids($ids))
+              and($out_char=&get_output_char($char,$out_cs))){
                return $out_char;
            }else{
                return &get_macro_for_ids($ids);
-#              return encode('utf8', &get_macro_for_ids($ids)) if($perl58);
            }
        }
     }
@@ -355,12 +355,11 @@ sub ids_rest{
     my($argc);
     $argc=&ids_argc($char);
     if($argc){
-       $ids_argc+= $ids_argc==0 ? $argc : $argc-1;
+       $ids_argc+=$ids_argc==0?$argc:$argc-1;
     }else{
        $ids_argc--;
     }
     $ids.=$char;
-#    $ids.=encode('utf8',$char) if($perl58);
     return ($ids,$ids_argc);
 }
 
@@ -370,9 +369,8 @@ sub get_macro_for_ids{
     #          or GETA character if ids is invalid for KAGE.
     my($ids)=@_;
     $ids=&normalize_ids($ids,"UniJIS");
-#    return pack("U",0xfffd) if(($ids!~/[$idc]/)
-    return pack("U",0x3013) if(($ids!~/[$idc]/)
-                              or($ids=~/[\x{10000}-]/));
+    return $geta if(($ids!~/[$idc]/)
+                   or($ids=~/[\x{10000}-]/));
                     #irregular for KAGE.
     if(not defined($ids{$ids}) and $ids{$ids}[1]>=0){
        $ids{$ids}[0]=$font_start;
@@ -395,33 +393,33 @@ sub normalize_ids{
     $out_cs=~s/Uni(.+)/'ucs@'.lc($1)/e;
 
     my $output_ids="";
-    my($char,$char_id,$output_char_id);
+    my($char,$output_char_id);
     while($ids=~m/(.)/g){
        $char=$1;
-       $char_id=unpack("U",$char);
        if($char=~/[$idc]/){
            $output_ids.=$char;
        }elsif($output_char_id=&get_char_attribute($char,"=$out_cs")){
            $output_ids.=pack("U",$output_char_id);
        }elsif($output_char_id=&get_char_attribute($char,"=ucs")){
            $output_ids.=pack("U",$output_char_id);
+       }elsif($output_char_id=&get_char_attribute($char,"=>$out_cs")){
+           $output_ids.=pack("U",$output_char_id);
+       }elsif($output_char_id=&get_char_attribute($char,"=>ucs")){
+           $output_ids.=pack("U",$output_char_id);
        }else{
-#          return pack("U",0xfffd);
-           return pack("U",0x3013);
+           return $geta;
        }
     }
     return $output_ids;
 }
 
 sub get_output_char{
-    # argument: <char-id>
+    # argument: <char>
     # return: character in output coding system or TeX macro or undef.
-    my($char_id,$out_cs)=@_;
-    my($char,$out_char_id,$suffix);
+    my($char,$out_cs)=@_;
+    my($out_char_id,$suffix);
     my($gt,$hzk,$cdp);
 
-    $char=pack('U',$char_id);
-
     foreach $out_cs (@{$order{$out_cs}}){
        if($out_cs eq 'UniJIS'
           and &get_char_attribute($char,"vnd-adobe-cid-unijis-utf16-h")){
@@ -460,11 +458,11 @@ sub get_output_char{
                return '{\selectksxfont\char'.$out_char_id.'}';
            }
        }elsif($out_cs eq 'GT'){
-           return $gt if($gt=&get_macro_for_GT($char_id));
+           return $gt if($gt=&get_macro_for_GT($char));
        }elsif($out_cs eq 'HZK'){
-           return $hzk if($hzk=&get_macro_for_HZK($char_id));
+           return $hzk if($hzk=&get_macro_for_HZK($char));
        }elsif($out_cs eq 'CDP'){
-           return $cdp if($cdp=&get_macro_for_CDP($char_id));
+           return $cdp if($cdp=&get_macro_for_CDP($char));
        }
     }
     return undef;
@@ -478,70 +476,63 @@ sub get_ids{
     $ids=&get_char_attribute($char,"ids-aggregated")
        or $ids=&get_char_attribute($char,"ids");
 #        or $ids=&get_char_attribute($char,"ideographic-structure");
-    utf8::decode($ids);
 #    $ids=~s/[? ()]//g;
     return $ids;
 }
 
-sub get_char_id_for_ids{
+sub get_char_for_ids{
     # argument: <ideographic description sequence>
-    # return: char-id or undef.
+    # return: char or undef.
     my($ids)=@_;
     my($output_char);
 
     if(($output_char)=&get_chars_matching("ids",$ids)){
-       utf8::decode($output_char);
-       return unpack("U",$output_char);
+       return $output_char;
     }else{
        return undef;
     }
 }
 
-sub get_char_id{
-    # argument: <char-id>, <input coding system>
-    # return:   char-id.
-    my($char_id,$in_cs)=@_;
+sub get_char_in_mcs{
+    # argument: <char>, <input coding system>
+    # return:   char in ucs@mcs.
+    my($char,$in_cs)=@_;
     my($output_char);
 
-    return $char_id if($in_cs eq 'ucs@mcs');
+    return $char if($in_cs eq 'ucs@mcs');
 
-    if(($output_char)=&get_chars_matching("=$in_cs",$char_id)){
-       utf8::decode($output_char);
-       return unpack("U",$output_char);
+    if(($output_char)=&get_chars_matching("=$in_cs",unpack("U",$char))){
+       return $output_char;
     }else{
-       return $char_id;
+       return $char;
     }
 }
 
-sub get_char_id_unified{
-    my($char_id)=@_;
-    my($char,$chars,$ucs);
-    my(@char_id);
-    $char=pack("U",$char_id);
+sub get_chars_unified{
+    my($char)=@_;
+    my($chars,$ucs,$char_ucs);
+    my(@chars);
 
     if($chars=&get_char_attribute($char,'->ucs-unified')){
-       utf8::decode($chars);
        $chars=~s/^\((.*)\)$/$1/;
-       return map {unpack("U",$_)} (split(/\s*\?/,$chars));
-    }elsif($ucs=&get_char_attribute(pack("U",$char_id),'=>ucs')){
-       if($chars=&get_char_attribute(pack("U",$ucs),'->ucs-unified')){
-           utf8::decode($chars);
+       return (split(/\s*\?/,$chars));
+    }elsif($ucs=&get_char_attribute($char,'=>ucs')){
+       $char_ucs=pack("U",$ucs);
+       if($chars=&get_char_attribute($char_ucs,'->ucs-unified')){
            $chars=~s/^\((.*)\)$/$1/;
-           @char_id=grep {$char_id!=$_}
-               map {unpack("U",$_)}
-                   (split(/\s*\?/,$chars));
-           push(@char_id,$ucs);
-           return @char_id;
+           @chars=grep {not /^$char$/}
+               (split(/\s*\?/,$chars));
+           push(@chars,$char_ucs);
+           return @chars;
        }
     }
 }
 
 sub get_macro_for_GT{
-    # argument: <char-id>
+    # argument: <char>
     # return: TeX macro for GT fonts or undef.
-    my($char_id)=@_;
-    my($char,$gt,$GT);
-    $char=pack("U",$char_id);
+    my($char)=@_;
+    my($gt,$GT);
     foreach (@GT){
        if($gt=&get_char_attribute($char,$_)){
            m/gt\-pj\-(\d+)/ and $GT=$1;
@@ -558,11 +549,10 @@ sub get_macro_for_GT{
 }
 
 sub get_macro_for_HZK{
-    # argument: <char-id>
+    # argument: <char>
     # return: TeX macro for Hanziku fonts or undef.
-    my($char_id)=@_;
-    my($char,$hzk,$HZK);
-    $char=pack("U",$char_id);
+    my($char)=@_;
+    my($hzk,$HZK);
     foreach (@HZK){
        if($hzk=&get_char_attribute($char,$_)){
            m/hanziku\-(\d+)/ and $HZK=$1;
@@ -577,24 +567,23 @@ sub get_macro_for_HZK{
 }
 
 sub get_macro_for_CDP{
-    # argument: <char-id>
+    # argument: <char>
     # return: TeX macro for CDP fonts or undef.
-    my($char_id)=@_;
-    my($char,$cdp,$ucs);
-    $char=pack("U",$char_id);
+    my($char)=@_;
+    my($cdp,$ucs);
     foreach (@CDP){
        if($cdp=&get_char_attribute($char,$_)){
            last;
        }
     }
     if($cdp){
-       $ucs=&get_char_attribute(utf8::decode(&get_chars_matching("=big5-pua",$cdp)),"=ucs");
+       $ucs=&get_char_attribute(&get_chars_matching("=big5-pua",$cdp),"=ucs");
        if($ucs){
            return "{\\fontencoding{OT1}\\fontfamily{cdp}\\selectfont\\char"
                .$ucs.
                    "}";
        }else{
-           print STDERR "This hould not happen.\n";
+           print STDERR "This should not happen.\n";
            print STDERR "ucs code point of CDP: $cdp not found.\n";
        }
     }else{