outCMAP

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use vars qw($opt_in_cs $opt_out_cs $opt_help $usage
   5             $in_cs $out_cs
   6             $i @chars
   7             $char $char_id $out_char $omegadb_home
   8             $ids $ids_argc %ids $idsdb
   9             $idsdata_file $ids_start $font_start
  10             %utf8mcs_map_from
  11             %cmap_to
  12             $inotp $perl56 $perl58
  13             $useCDP $useHZK $useGT
  14             @CDP @HZK @GT
  15             );
  16 use Getopt::Long;
  17 use utf8;
  18 use Chise_utils ':all';
  19
  20 my $strictly_forbidden_after = '「【『［（〈“‘‘（〔｛《{\[\(\x{3016}｛｢';
  21 #       \x{3016} | # white 【
  22
  23 my $forbidden_after = "\x{0000}";
  24
  25 # ￥¥＄$〒♯＃#￠¢￡£＠@§
  26 my $slightly_forbidden_after = '￥¥＄$〒♯＃#￠¢￡£＠@§';
  27
  28 # $strictly_forbidden_before
  29 # All these characters are allowed to protrude
  30 # in the right margin
  31 my $strictly_forbidden_before=
  32     '!,.:;?、。！，．：；？。\)#}’”〉》」』】〕\x{3017}）］｝｝」\]';
  33 #       \x{3017} | # white 】
  34
  35 my $forbidden_before
  36     = 'ー々ぁぃぅぇぉゃゅょっゎァィゥェォャュョッヮヵヶ';
  37
  38 my $slightly_forbidden_before
  39     = '\x{000a}\#\-‐−‰′″℃゛゜ゝゞヽヾ＂％－ﾞﾟ';
  40
  41 my $asian = '\x{1100}-\x{11FF}\x{2E80}-\x{D7AF}\x{F900}-\x{FAFF}\x{FE30}-\x{FE4F}\x{FF00}-';
  42
  43 my $space = '\x{0020}\x{0009}\x{000A}\x{000C}\x{000D}';
  44
  45 $useGT=1;
  46 $useHZK=0;
  47 $useCDP=0;
  48
  49 if($^V and $^V ge v5.8){
  50     $perl58=1;
  51 }elsif($^V and $^V ge v5.6){
  52     $perl56=1;
  53 }else{
  54     print STDERR "This versin is not supported.";
  55 }
  56 if($perl58){
  57     eval "use Encode";
  58     binmode(STDIN, ':encoding(utf8)');
  59     binmode(STDOUT, ':encoding(utf8)');
  60 }
  61
  62 $omegadb_home="/Users/izumi/.chise";
  63
  64 &GetOptions("in=s"=>\$opt_in_cs,
  65             "i=s"=>\$opt_in_cs,
  66             "out=s"=>\$opt_out_cs,
  67             "o=s"=>\$opt_out_cs,
  68             "help",\$opt_help,
  69             "h",\$opt_help);
  70
  71 $usage=<<EOF;
  72 Usage: $0 -i <input coding system> -o <cmap encoding>
  73     input coding system:
  74       Utf8mcs, Utf8cns, Utf8gb, Utf8jis, Utf8ks
  75     cmap encoding:
  76       UniCNS, UniGB, UniJIS, UniKS
  77 EOF
  78
  79 if($opt_in_cs or $opt_out_cs){
  80     $in_cs=$opt_in_cs;
  81     $out_cs=$opt_out_cs;
  82 }elsif(@ARGV==0){
  83     ($in_cs,$out_cs)=($0=~/(Utf8.+)To(\w+)/);
  84     $inotp=1;
  85 }
  86
  87 # $in_cs:
  88 #   utf-8-mcs,utf-8-cns,utf-8-gb,utf-8-jis,utf-8-ks,
  89 # $out_cs:
  90 #   UniCNS,UniGB,UniJIS,UniKS
  91
  92 if($opt_help
  93    or not defined($in_cs)
  94    or not defined($out_cs)){
  95     print $usage;
  96     exit 1;
  97 }
  98
  99 $idsdata_file="idsdata.pl";
 100 $ids_start=0x00;
 101 $font_start=0;
 102
 103 if(-e $idsdata_file){
 104     require $idsdata_file;
 105 }
 106
 107 $ids_argc=0;
 108 $ids="";
 109
 110 @GT=(#"=gt","=gt-k",
 111      "=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","=gt-pj-11"
 112      #,"=gt-pj-k1","=gt-pj-k2"
 113      );
 114 @HZK=("=hanziku-1","=hanziku-10","=hanziku-11","=hanziku-12","=hanziku-2","=hanziku-3","=hanziku-4","=hanziku-5","=hanziku-6","=hanziku-7","=hanziku-8","=hanziku-9");
 115 @CDP=("=big5-cdp");
 116
 117 while(<>){
 118     # temporary fix for using in OTP for perl 5.6.
 119     s/(.)/pack("c",unpack("U",$1))/ge if($inotp
 120                                          and $in_cs=~/utf8/i
 121                                          and $perl56);
 122     # for perl 5.8.
 123     $_=decode('utf8', $_)  if ($inotp and $in_cs=~/utf8/i
 124                                and $perl58);
 125     s/(amp.+?;)/&tex_de_er($1)/ge;
 126 #    s/(&.+?;)/&tex_de_er($1)/ge;
 127 #    s/^(.*)$/&add_break($1)/e;
 128     @chars=split(//);
 129     for($i=0;$i<=$#chars;$i++){
 130 #    while(m/(.)/g){
 131         $char=&get_char_in_utf8mcs($chars[$i],$in_cs);
 132         $char_id=unpack("U",$char);
 133         if($ids_argc>0){
 134             # It's in IDS.
 135             ($ids,$ids_argc)=&ids_rest($ids,$ids_argc,$char);
 136             if($ids_argc==0){
 137                 if(($char_id=&get_char_id_for_ids($ids))
 138                    and(($out_char=&get_output_char($char_id,$out_cs)))){
 139                     print $out_char,&add_break($i);
 140                 }else{
 141                     print &replace_ids($ids),&add_break($i) if($perl56);
 142                     print encode('utf8', &replace_ids($ids)),&add_break($i) if($perl58);
 143                 }
 144                 $ids="";
 145             }
 146         }elsif($char_id>=0x2ff0 and $char_id<=0x2fff){
 147             ($ids,$ids_argc)=&ids_rest("",0,$char);
 148             next;
 149         }else{
 150             if($char_id<=0xff){
 151                 print $char;
 152                 next;
 153             }
 154             if(($out_char=&get_output_char($char_id,$out_cs))){
 155                 print $out_char,&add_break($i);
 156             }elsif($char_id >= 0x20000 && $char_id <=0x2a6df){
 157                 unless(defined($ids{$char}) and $ids{$char}[1]>=0){
 158                     $ids{$char}[0]=$font_start;
 159                     $ids{$char}[1]=$ids_start;
 160                     $ids_start++;
 161                     if($ids_start>255){
 162                         $ids_start=0;
 163                         $font_start++;
 164                     }
 165                 }
 166                 print "{\\fontencoding{OT1}\\fontfamily{" .
 167                     sprintf("chise%03d",$ids{$char}[0]) .
 168                     "}\\selectfont\\char$ids{$char}[1]}",&add_break($i);
 169                 next;
 170             }else{
 171                 print &replace_ids(&get_ids($char)),&add_break($i);
 172             }
 173         }
 174     }
 175     if($ids_argc>0){
 176         print STDERR "IDS parse error: $ids\n";
 177 #       print pack("U",0xfffd);
 178         print pack("U",0x3013) if($perl56);
 179         print encode('utf8',pack("U",0x3013)) if($perl58);
 180         $ids="";
 181         $ids_argc=0;
 182     }
 183 }
 184
 185 open(IDSDATA,">$idsdata_file") or die;
 186 print IDSDATA 'use utf8;',"\n";
 187 foreach $ids (keys %ids){
 188     print IDSDATA '$ids{\'',$ids,'\'}=[',join ",",@{$ids{$ids}},"];\n" if($perl56);
 189     print IDSDATA '$ids{\'',encode('utf8',$ids),'\'}=[',join ",",@{$ids{$ids}},"];\n" if($perl58);
 190 }
 191 print IDSDATA '$font_start=',$font_start,";\n";
 192 print IDSDATA '$ids_start=',$ids_start,";\n";
 193 print IDSDATA "1;";
 194
 195 exit 0;
 196
 197 sub tex_de_er{
 198     my($er)=@_;
 199     my($out);
 200     $er=~s/^amp(.*);$/$1/;
 201 #    $er=~s/^&(.*);$/$1/;
 202     $out=&de_er($er);
 203     if($out){
 204         return $out;
 205     }else{
 206         return "amp$er;";
 207     }
 208 }
 209
 210 sub add_break{
 211     my($i)=@_;
 212
 213     if($i<$#chars){
 214         if($i<($#chars-1)){
 215             if(($chars[$i+1]=~m/[$strictly_forbidden_before]/o)
 216                and($chars[$i+2]=~m/[^$strictly_forbidden_before]/o)){
 217                 return "\\CJKunbreakablekernone \\CJKprotrude ";
 218             }elsif(($chars[$i+1]=~m/[$strictly_forbidden_before]/o)
 219                and($chars[$i+2]=~m/[$strictly_forbidden_before]/o)){
 220                 return "\\CJKunbreakablekernone ";
 221             }
 222         }
 223         if($chars[$i+1]=~m/[$strictly_forbidden_before]/o){
 224             return "\\CJKunbreakablekernone ";
 225         }elsif($chars[$i+1]=~m/[$forbidden_before]/o){
 226             return "\\CJKunbreakablekerntwo ";
 227         }elsif($chars[$i+1]=~m/[$slightly_forbidden_before]/o){
 228             return "\\CJKunbreakablekernthree ";
 229         }
 230     }elsif($i>0){
 231         if($chars[$i]=~m/[$forbidden_after]/o){
 232             return "\\CJKunbreakablekerntwo ";
 233         }elsif($chars[$i]=~m/[$strictly_forbidden_after]/o){
 234             return "\\CJKunbreakablekernone ";
 235         }elsif($chars[$i]=~m/[$slightly_forbidden_after]/o){
 236             return "\\CJKunbreakablekernthree ";
 237         }
 238     }
 239     return "\\CJKbreakablekern ";
 240 }
 241
 242 sub ids_rest{
 243     my($ids,$ids_argc,$char)=@_;
 244     my($argc);
 245     $argc=&ids_argc($char);
 246     if($argc){
 247         $ids_argc+= $ids_argc==0 ? $argc : $argc-1;
 248     }else{
 249         $ids_argc--;
 250     }
 251     $ids.=$char if($perl56);
 252     $ids.=encode('utf8',$char) if($perl58);
 253     return ($ids,$ids_argc);
 254 }
 255
 256 sub replace_ids{
 257     my($ids)=@_;
 258     $ids=&normalize_ids($ids,"UniJIS");
 259 #    return pack("U",0xfffd) if($ids!~/[$idc]/);
 260     return pack("U",0x3013) if(($ids!~/[$idc]/)
 261                                or($ids=~/[\x{10000}-]/));
 262                     #irregular for KAGE.
 263     unless(defined($ids{$ids}) and $ids{$ids}[1]>=0){
 264         $ids{$ids}[0]=$font_start;
 265         $ids{$ids}[1]=$ids_start;
 266         $ids_start++;
 267     }
 268     if($ids_start>255){
 269         $ids_start=0;
 270         $font_start++;
 271     }
 272     return "{\\fontencoding{OT1}\\fontfamily{".sprintf("chise%03d",$ids{$ids}[0])."}\\selectfont\\char$ids{$ids}[1]}";
 273 }
 274
 275 sub normalize_ids{
 276     my($ids,$out_cs)=@_;
 277     $ids = decode('utf8', $ids) if $perl58;
 278     $out_cs=~s/Uni(.+)/"ucs-".lc($1)/e;
 279     my $output_ids="";
 280     my($char,$char_id,$output_char_id);
 281     while($ids=~m/(.)/g){
 282         $char=$1;
 283         $char_id=unpack("U",$char);
 284         if($char=~/[$idc]/){
 285             $output_ids.=$char;
 286         }elsif($output_char_id=&get_char_attribute($char,$out_cs)){
 287             $output_ids.=pack("U",$output_char_id);
 288         }elsif($output_char_id=&get_char_attribute($char,"=ucs")){
 289             $output_ids.=pack("U",$output_char_id);
 290         }elsif($output_char_id=&get_char_attribute($char,"ucs")){
 291             $output_ids.=pack("U",$output_char_id);
 292         }else{
 293             return pack("U",0xfffe);
 294         }
 295     }
 296     return $output_ids;
 297 }
 298
 299 sub get_output_char{
 300     my($char_id,$out_cs)=@_;
 301     my($out_char_id,$suffix);
 302     my($gt,$hzk,$cdp);
 303     if(not defined($cmap_to{$out_cs})){
 304         &get_cmap($out_cs);
 305     }
 306     if($out_char_id=$cmap_to{$out_cs}->{$char_id}){
 307         return pack("U",$out_char_id);
 308     }else{
 309         return $gt if($useGT and $gt=&get_macro_for_GT($char_id));
 310         return $hzk if($useHZK and $hzk=&get_macro_for_HZK($char_id));
 311         return $cdp if($useCDP and $cdp=&get_macro_for_CDP($char_id));
 312         return undef;
 313     }
 314 }
 315
 316 sub get_cmap{
 317     my($out_cs)=@_;
 318     tie %{$cmap_to{$out_cs}}, "BerkeleyDB::Hash",
 319     -Filename => "$omegadb_home/$out_cs" or die $!;
 320 }
 321
 322 sub get_ids{
 323     my($char)=@_;
 324     my $ids="";
 325     $ids=&get_char_attribute($char,"ids-aggregated")
 326         or &get_char_attribute($char,"ids");
 327 #       or &get_char_attribute($char,"ideographic-structure");
 328     $ids=decode('utf8', $ids) if($perl58);
 329 #    $ids=~s/[? ()]//g;
 330     return $ids;
 331 }
 332
 333 sub get_char_id_for_ids{
 334     my($ids)=@_;
 335     my($char_id,$char);
 336     $ids=decode('utf8', $ids) if($perl58);
 337 #    $ids="(?".(join " ?",(split(//,$ids))).")";
 338     &get_idsdb if(not defined($idsdb));
 339     $char=$idsdb->{$ids};
 340     $char=decode('utf8',$char) if($perl58);
 341     if($char){
 342         return unpack("U",$char);
 343     }else{
 344         return undef;
 345     }
 346 }
 347
 348 sub get_idsdb{
 349     tie %{$idsdb}, "BerkeleyDB::Hash",
 350     -Filename => "$omegadb_home/idsdb" or die $!;
 351 }
 352
 353 sub get_char_in_utf8mcs_bak{
 354     my($char,$in_cs)=@_;
 355     return $char if($in_cs eq "Utf8mcs");
 356     my($char_id,$output_char);
 357     $in_cs=~s/Utf8/ucs-/;
 358     $char_id=unpack("U",$char);
 359     if(($output_char)=&get_chars_matching("$in_cs",$char_id)){
 360         $output_char=decode('utf8', $output_char) if($perl58);
 361         return $output_char;
 362     }else{
 363         return $char;
 364     }
 365 }
 366
 367 sub get_char_in_utf8mcs{
 368     # argument: <character>, <input coding system>
 369     # return:   character in UTF-8mcs.
 370     my($char,$in_cs)=@_;
 371     my($char_id,$output_char_id);
 372     return $char if($in_cs eq "Utf8mcs");
 373     $char_id=unpack("U",$char);
 374     &get_utf8mcs_map($in_cs) if(not defined($utf8mcs_map_from{$in_cs}));
 375     if($output_char_id=$utf8mcs_map_from{$in_cs}->{$char_id}){
 376         return pack("U",$output_char_id);
 377    }else{
 378         return $char;
 379    }
 380 }
 381
 382 sub get_utf8mcs_map{
 383     my($in_cs)=@_;
 384     my($suffix);
 385     ($suffix=$in_cs)=~s/^Utf8//;
 386     tie %{$utf8mcs_map_from{$in_cs}}, "BerkeleyDB::Hash",
 387     -Filename => "$omegadb_home/ucs-$suffix" or die $!;
 388 }
 389
 390 sub get_macro_for_GT{
 391     my($char_id)=@_;
 392     my($char,$gt,$GT);
 393     $char=pack("U",$char_id);
 394     foreach (@GT){
 395         if($gt=&get_char_attribute($char,$_)){
 396             m/gt\-pj\-(\d+)/ and $GT=$1;
 397             last;
 398         }
 399     }
 400     if($gt){
 401         return "{\\fontencoding{OT1}\\fontfamily{".sprintf("gt%02d",$GT)."}\\selectfont\\char".($gt|0x8080)."}";
 402 #       return "\\GT{".sprintf("gt%02d",$GT)."}{\\char".($gt|0x8080)."}";
 403     }else{
 404         return undef;
 405     }
 406 }
 407
 408 sub get_macro_for_HZK{
 409     my($char_id)=@_;
 410     my($char,$hzk,$HZK);
 411     $char=pack("U",$char_id);
 412     foreach (@HZK){
 413         if($hzk=&get_char_attribute($char,$_)){
 414             m/hanziku\-(\d+)/ and $HZK=$1;
 415             last;
 416         }
 417     }
 418     if($hzk){
 419         return "{\\fontencoding{OT1}\\fontfamily{".sprintf("hzk%02d",$HZK)."}\\selectfont\\char".($hzk|0x8080)."}";
 420     }else{
 421         return undef;
 422     }
 423 }
 424
 425 sub get_macro_for_CDP{
 426     my($char_id)=@_;
 427     my($char,$cdp);
 428     $char=pack("U",$char_id);
 429     foreach (@CDP){
 430         if($cdp=&get_char_attribute($char,$_)){
 431             last;
 432         }
 433     }
 434     if($cdp){
 435         return "{\\fontencoding{OT1}\\fontfamily{cdp}\\selectfont\\char".($cdp|0x8080)."}";
 436     }else{
 437         return undef;
 438     }
 439 }