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="/usr/local/lib/chise/omega/db";
  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-1)){
 214         if(($chars[$i+1]=~m/[$strictly_forbidden_before]/o)
 215            and($chars[$i+2]=~m/[$strictly_forbidden_before]/o)){
 216             return "\\CJKunbreakablekernone ";
 217         }elsif(($chars[$i+1]=~m/[$strictly_forbidden_before]/o)
 218                and($chars[$i+2]=~m/[^$strictly_forbidden_before]/o)){
 219             return "\\CJKunbreakablekernone \\CJKprotrude ";
 220         }
 221     }
 222     if(($i<$#chars)
 223        and($chars[$i+1]=~m/[$strictly_forbidden_before]/o)){
 224         return "\\CJKunbreakablekernone ";
 225     }
 226     if($chars[$i]=~m/[$strictly_forbidden_after]/o){
 227         return "\\CJKunbreakablekernone ";
 228     }
 229     if(($i<$#chars)
 230        and($chars[$i+1]=~m/[$forbidden_before]/o)){
 231         return "\\CJKunbreakablekerntwo ";
 232
 233     }
 234     if($chars[$i]=~m/[$forbidden_after]/o){
 235         return "\\CJKunbreakablekerntwo ";
 236     }
 237     if(($i<$#chars)
 238        and($chars[$i+1]=~m/[$slightly_forbidden_before]/o)){
 239         return "\\CJKunbreakablekernthree ";
 240     }
 241     if($chars[$i]=~m/[$slightly_forbidden_after]/o){
 242         return "\\CJKunbreakablekernthree ";
 243     }
 244     if($chars[$i]=~m/[$asian]/o){
 245         return "\\CJKbreakablekern ";
 246     }
 247     if(($i<$#chars)and($chars[$i+1]=~m/[$asian]/o)){
 248         return "\\CJKbreakablekern ";
 249     }
 250 }
 251
 252 sub ids_rest{
 253     my($ids,$ids_argc,$char)=@_;
 254     my($argc);
 255     $argc=&ids_argc($char);
 256     if($argc){
 257         $ids_argc+= $ids_argc==0 ? $argc : $argc-1;
 258     }else{
 259         $ids_argc--;
 260     }
 261     $ids.=$char if($perl56);
 262     $ids.=encode('utf8',$char) if($perl58);
 263     return ($ids,$ids_argc);
 264 }
 265
 266 sub replace_ids{
 267     my($ids)=@_;
 268     $ids=&normalize_ids($ids,"UniJIS");
 269 #    return pack("U",0xfffd) if($ids!~/[$idc]/);
 270     return pack("U",0x3013) if(($ids!~/[$idc]/)
 271                                or($ids=~/[\x{10000}-]/));
 272                     #irregular for KAGE.
 273     unless(defined($ids{$ids}) and $ids{$ids}[1]>=0){
 274         $ids{$ids}[0]=$font_start;
 275         $ids{$ids}[1]=$ids_start;
 276         $ids_start++;
 277     }
 278     if($ids_start>255){
 279         $ids_start=0;
 280         $font_start++;
 281     }
 282     return "{\\fontencoding{OT1}\\fontfamily{".sprintf("chise%03d",$ids{$ids}[0])."}\\selectfont\\char$ids{$ids}[1]}";
 283 }
 284
 285 sub normalize_ids{
 286     my($ids,$out_cs)=@_;
 287     $ids = decode('utf8', $ids) if $perl58;
 288     $out_cs=~s/Uni(.+)/"ucs-".lc($1)/e;
 289     my $output_ids="";
 290     my($char,$char_id,$output_char_id);
 291     while($ids=~m/(.)/g){
 292         $char=$1;
 293         $char_id=unpack("U",$char);
 294         if($char=~/[$idc]/){
 295             $output_ids.=$char;
 296         }elsif($output_char_id=&get_char_attribute($char,$out_cs)){
 297             $output_ids.=pack("U",$output_char_id);
 298         }elsif($output_char_id=&get_char_attribute($char,"=ucs")){
 299             $output_ids.=pack("U",$output_char_id);
 300         }elsif($output_char_id=&get_char_attribute($char,"ucs")){
 301             $output_ids.=pack("U",$output_char_id);
 302         }else{
 303             return pack("U",0xfffe);
 304         }
 305     }
 306     return $output_ids;
 307 }
 308
 309 sub get_output_char{
 310     my($char_id,$out_cs)=@_;
 311     my($out_char_id,$suffix);
 312     my($gt,$hzk,$cdp);
 313     if(not defined($cmap_to{$out_cs})){
 314         &get_cmap($out_cs);
 315     }
 316     if($out_char_id=$cmap_to{$out_cs}->{$char_id}){
 317         return pack("U",$out_char_id);
 318     }else{
 319         return $gt if($useGT and $gt=&get_macro_for_GT($char_id));
 320         return $hzk if($useHZK and $hzk=&get_macro_for_HZK($char_id));
 321         return $cdp if($useCDP and $cdp=&get_macro_for_CDP($char_id));
 322         return undef;
 323     }
 324 }
 325
 326 sub get_cmap{
 327     my($out_cs)=@_;
 328     tie %{$cmap_to{$out_cs}}, "BerkeleyDB::Hash",
 329     -Filename => "$omegadb_home/$out_cs" or die $!;
 330 }
 331
 332 sub get_ids{
 333     my($char)=@_;
 334     my $ids="";
 335     $ids=&get_char_attribute($char,"ids-aggregated")
 336         or &get_char_attribute($char,"ids");
 337 #       or &get_char_attribute($char,"ideographic-structure");
 338     $ids=decode('utf8', $ids) if($perl58);
 339 #    $ids=~s/[? ()]//g;
 340     return $ids;
 341 }
 342
 343 sub get_char_id_for_ids{
 344     my($ids)=@_;
 345     my($char_id,$char);
 346     $ids=decode('utf8', $ids) if($perl58);
 347 #    $ids="(?".(join " ?",(split(//,$ids))).")";
 348     &get_idsdb if(not defined($idsdb));
 349     $char=$idsdb->{$ids};
 350     $char=decode('utf8',$char) if($perl58);
 351     if($char){
 352         return unpack("U",$char);
 353     }else{
 354         return undef;
 355     }
 356 }
 357
 358 sub get_idsdb{
 359     tie %{$idsdb}, "BerkeleyDB::Hash",
 360     -Filename => "$omegadb_home/idsdb" or die $!;
 361 }
 362
 363 sub get_char_in_utf8mcs_bak{
 364     my($char,$in_cs)=@_;
 365     return $char if($in_cs eq "Utf8mcs");
 366     my($char_id,$output_char);
 367     $in_cs=~s/Utf8/ucs-/;
 368     $char_id=unpack("U",$char);
 369     if(($output_char)=&get_chars_matching("$in_cs",$char_id)){
 370         $output_char=decode('utf8', $output_char) if($perl58);
 371         return $output_char;
 372     }else{
 373         return $char;
 374     }
 375 }
 376
 377 sub get_char_in_utf8mcs{
 378     # argument: <character>, <input coding system>
 379     # return:   character in UTF-8mcs.
 380     my($char,$in_cs)=@_;
 381     my($char_id,$output_char_id);
 382     return $char if($in_cs eq "Utf8mcs");
 383     $char_id=unpack("U",$char);
 384     &get_utf8mcs_map($in_cs) if(not defined($utf8mcs_map_from{$in_cs}));
 385     if($output_char_id=$utf8mcs_map_from{$in_cs}->{$char_id}){
 386         return pack("U",$output_char_id);
 387    }else{
 388         return $char;
 389    }
 390 }
 391
 392 sub get_utf8mcs_map{
 393     my($in_cs)=@_;
 394     my($suffix);
 395     ($suffix=$in_cs)=~s/^Utf8//;
 396     tie %{$utf8mcs_map_from{$in_cs}}, "BerkeleyDB::Hash",
 397     -Filename => "$omegadb_home/ucs-$suffix" or die $!;
 398 }
 399
 400 sub get_macro_for_GT{
 401     my($char_id)=@_;
 402     my($char,$gt,$GT);
 403     $char=pack("U",$char_id);
 404     foreach (@GT){
 405         if($gt=&get_char_attribute($char,$_)){
 406             m/gt\-pj\-(\d+)/ and $GT=$1;
 407             last;
 408         }
 409     }
 410     if($gt){
 411         return "{\\fontencoding{OT1}\\fontfamily{".sprintf("gt%02d",$GT)."}\\selectfont\\char".($gt|0x8080)."}";
 412 #       return "\\GT{".sprintf("gt%02d",$GT)."}{\\char".($gt|0x8080)."}";
 413     }else{
 414         return undef;
 415     }
 416 }
 417
 418 sub get_macro_for_HZK{
 419     my($char_id)=@_;
 420     my($char,$hzk,$HZK);
 421     $char=pack("U",$char_id);
 422     foreach (@HZK){
 423         if($hzk=&get_char_attribute($char,$_)){
 424             m/hanziku\-(\d+)/ and $HZK=$1;
 425             last;
 426         }
 427     }
 428     if($hzk){
 429         return "{\\fontencoding{OT1}\\fontfamily{".sprintf("hzk%02d",$HZK)."}\\selectfont\\char".($hzk|0x8080)."}";
 430     }else{
 431         return undef;
 432     }
 433 }
 434
 435 sub get_macro_for_CDP{
 436     my($char_id)=@_;
 437     my($char,$cdp);
 438     $char=pack("U",$char_id);
 439     foreach (@CDP){
 440         if($cdp=&get_char_attribute($char,$_)){
 441             last;
 442         }
 443     }
 444     if($cdp){
 445         return "{\\fontencoding{OT1}\\fontfamily{cdp}\\selectfont\\char".($cdp|0x8080)."}";
 446     }else{
 447         return undef;
 448     }
 449 }