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             $char $char_id $out_char $omegadb_home
   7             $ids $ids_argc %ids $idsdb
   8             $idsdata_file $ids_start $font_start
   9             %utf8mcs_map_from
  10             %cmap_to
  11             $inotp $perl56 $perl58
  12             $useCDP $useHZK $useGT
  13             @CDP @HZK @GT
  14             );
  15 use Getopt::Long;
  16 use utf8;
  17 use Chise_utils ':all';
  18
  19 $useGT=1;
  20 $useHZK=0;
  21 $useCDP=0;
  22
  23 if($^V and $^V ge v5.8){
  24     $perl58=1;
  25 }elsif($^V and $^V ge v5.6){
  26     $perl56=1;
  27 }else{
  28     print STDERR "This versin is not supported.";
  29 }
  30 if($perl58){
  31     eval "use Encode";
  32     binmode(STDIN, ':encoding(utf8)');
  33     binmode(STDOUT, ':encoding(utf8)');
  34 }
  35
  36 #$omegadb_home="/home/ttomabec/.chise";
  37 $omegadb_home="/Users/izumi/.chise";
  38
  39 &GetOptions("in=s"=>\$opt_in_cs,
  40             "i=s"=>\$opt_in_cs,
  41             "out=s"=>\$opt_out_cs,
  42             "o=s"=>\$opt_out_cs,
  43             "help",\$opt_help,
  44             "h",\$opt_help);
  45
  46 $usage=<<EOF;
  47 Usage: $0 -i <input coding system> -o <cmap encoding>
  48     input coding system:
  49       Utf8mcs, Utf8cns, Utf8gb, Utf8jis, Utf8ks
  50     cmap encoding:
  51       UniCNS, UniGB, UniJIS, UniKS
  52 EOF
  53
  54 if($opt_in_cs or $opt_out_cs){
  55     $in_cs=$opt_in_cs;
  56     $out_cs=$opt_out_cs;
  57 }elsif(@ARGV==0){
  58     ($in_cs,$out_cs)=($0=~/(Utf8.+)To(\w+)/);
  59     $inotp=1;
  60 }
  61
  62 # $in_cs:
  63 #   utf-8-mcs,utf-8-cns,utf-8-gb,utf-8-jis,utf-8-ks,
  64 # $out_cs:
  65 #   UniCNS,UniGB,UniJIS,UniKS
  66
  67 if($opt_help
  68    or not defined($in_cs)
  69    or not defined($out_cs)){
  70     print $usage;
  71     exit 1;
  72 }
  73
  74 $idsdata_file="idsdata.pl";
  75 $ids_start=0x00;
  76 $font_start=0;
  77
  78 if(-e $idsdata_file){
  79     require $idsdata_file;
  80 }
  81
  82 $ids_argc=0;
  83 $ids="";
  84
  85 @GT=(#"=gt","=gt-k",
  86      "=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"
  87      #,"=gt-pj-k1","=gt-pj-k2"
  88      );
  89 @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");
  90 @CDP=("=big5-cdp");
  91
  92 while(<>){
  93     # temporary fix for using in OTP for perl 5.6.
  94     s/(.)/pack("c",unpack("U",$1))/ge if($inotp
  95                                          and $in_cs=~/utf8/i
  96                                          and $perl56);
  97     # for perl 5.8.
  98     $_=decode('utf8', $_)  if ($inotp and $in_cs=~/utf8/i
  99                                and $perl58);
 100     s/(amp.+?;)/&tex_de_er($1)/ge;
 101 #    s/(&.+?;)/&tex_de_er($1)/ge;
 102     while(m/(.)/g){
 103         $char=&get_char_in_utf8mcs($1,$in_cs);
 104         $char_id=unpack("U",$char);
 105         if($ids_argc>0){
 106             ($ids,$ids_argc)=&ids_rest($ids,$ids_argc,$char);
 107             if($ids_argc==0){
 108                 if(($char_id=&get_char_id_for_ids($ids))
 109                    and(($out_char=&get_output_char($char_id,$out_cs)))){
 110                     print $out_char;
 111                 }else{
 112                     print &replace_ids($ids) if($perl56);
 113                     print encode('utf8', &replace_ids($ids)) if($perl58);
 114                 }
 115                 $ids="";
 116             }
 117         }elsif($char_id>=0x2ff0 and $char_id<=0x2fff){
 118             ($ids,$ids_argc)=&ids_rest("",0,$char);
 119             next;
 120         }else{
 121             if($char_id<=0xff){
 122                 print $char;
 123                 next;
 124             }
 125             if(($out_char=&get_output_char($char_id,$out_cs))){
 126                 print $out_char;
 127             }elsif($char_id >= 0x20000 && $char_id <=0x2a6df){
 128                 unless(defined($ids{$char}) and $ids{$char}[1]>=0){
 129                     $ids{$char}[0]=$font_start;
 130                     $ids{$char}[1]=$ids_start;
 131                     $ids_start++;
 132                     if($ids_start>255){
 133                         $ids_start=0;
 134                         $font_start++;
 135                     }
 136                 }
 137                 print "{\\fontencoding{OT1}\\fontfamily{" .
 138                     sprintf("chise%03d",$ids{$char}[0]) .
 139                     "}\\selectfont\\char$ids{$char}[1]}";
 140                 next;
 141             }else{
 142                 print &replace_ids(&get_ids($char));
 143             }
 144         }
 145     }
 146     if($ids_argc>0){
 147         print STDERR "IDS parse error: $ids\n";
 148 #       print pack("U",0xfffd);
 149         print pack("U",0x3013) if($perl56);
 150         print encode('utf8',pack("U",0x3013)) if($perl58);
 151         $ids="";
 152         $ids_argc=0;
 153     }
 154 }
 155
 156 open(IDSDATA,">$idsdata_file") or die;
 157 print IDSDATA 'use utf8;',"\n";
 158 foreach $ids (keys %ids){
 159     print IDSDATA '$ids{\'',$ids,'\'}=[',join ",",@{$ids{$ids}},"];\n" if($perl56);
 160     print IDSDATA '$ids{\'',encode('utf8',$ids),'\'}=[',join ",",@{$ids{$ids}},"];\n" if($perl58);
 161 }
 162 print IDSDATA '$font_start=',$font_start,";\n";
 163 print IDSDATA '$ids_start=',$ids_start,";\n";
 164 print IDSDATA "1;";
 165
 166 exit 0;
 167
 168 sub tex_de_er{
 169     my($er)=@_;
 170     my($out);
 171     $er=~s/^amp(.*);$/$1/;
 172 #    $er=~s/^&(.*);$/$1/;
 173     $out=&de_er($er);
 174     if($out){
 175         return $out;
 176     }else{
 177         return "amp$er;";
 178     }
 179 }
 180
 181 sub ids_rest{
 182     my($ids,$ids_argc,$char)=@_;
 183     my($argc);
 184     $argc=&ids_argc($char);
 185     if($argc){
 186         $ids_argc+= $ids_argc==0 ? $argc : $argc-1;
 187     }else{
 188         $ids_argc--;
 189     }
 190     $ids.=$char if($perl56);
 191     $ids.=encode('utf8',$char) if($perl58);
 192     return ($ids,$ids_argc);
 193 }
 194
 195 sub replace_ids{
 196     my($ids)=@_;
 197     $ids=&normalize_ids($ids,"UniJIS");
 198 #    return pack("U",0xfffd) if($ids!~/[$idc]/);
 199     return pack("U",0x3013) if(($ids!~/[$idc]/)
 200                                or($ids=~/[\x{10000}-]/));
 201                     #irregular for KAGE.
 202     unless(defined($ids{$ids}) and $ids{$ids}[1]>=0){
 203         $ids{$ids}[0]=$font_start;
 204         $ids{$ids}[1]=$ids_start;
 205         $ids_start++;
 206     }
 207     if($ids_start>255){
 208         $ids_start=0;
 209         $font_start++;
 210     }
 211     return "{\\fontencoding{OT1}\\fontfamily{".sprintf("chise%03d",$ids{$ids}[0])."}\\selectfont\\char$ids{$ids}[1]}";
 212 }
 213
 214 sub normalize_ids{
 215     my($ids,$out_cs)=@_;
 216     $ids = decode('utf8', $ids) if $perl58;
 217     $out_cs=~s/Uni(.+)/"ucs-".lc($1)/e;
 218     my $output_ids="";
 219     my($char,$char_id,$output_char_id);
 220     while($ids=~m/(.)/g){
 221         $char=$1;
 222         $char_id=unpack("U",$char);
 223         if($char=~/[$idc]/){
 224             $output_ids.=$char;
 225         }elsif($output_char_id=&get_char_attribute($char,$out_cs)){
 226             $output_ids.=pack("U",$output_char_id);
 227         }elsif($output_char_id=&get_char_attribute($char,"=ucs")){
 228             $output_ids.=pack("U",$output_char_id);
 229         }elsif($output_char_id=&get_char_attribute($char,"ucs")){
 230             $output_ids.=pack("U",$output_char_id);
 231         }else{
 232             return pack("U",0xfffe);
 233         }
 234     }
 235     return $output_ids;
 236 }
 237
 238 sub get_output_char{
 239     my($char_id,$out_cs)=@_;
 240     my($out_char_id,$suffix);
 241     my($gt,$hzk,$cdp);
 242     if(not defined($cmap_to{$out_cs})){
 243         &get_cmap($out_cs);
 244     }
 245     if($out_char_id=$cmap_to{$out_cs}->{$char_id}){
 246         return pack("U",$out_char_id);
 247     }else{
 248         return $gt if($useGT and $gt=&get_macro_for_GT($char_id));
 249         return $hzk if($useHZK and $hzk=&get_macro_for_HZK($char_id));
 250         return $cdp if($useCDP and $cdp=&get_macro_for_CDP($char_id));
 251         return undef;
 252     }
 253 }
 254
 255 sub get_cmap{
 256     my($out_cs)=@_;
 257     tie %{$cmap_to{$out_cs}}, "BerkeleyDB::Hash",
 258     -Filename => "$omegadb_home/$out_cs" or die $!;
 259 }
 260
 261 sub get_ids{
 262     my($char)=@_;
 263     my $ids="";
 264     $ids=&get_char_attribute($char,"ids-aggregated")
 265         or &get_char_attribute($char,"ids");
 266 #       or &get_char_attribute($char,"ideographic-structure");
 267     $ids=decode('utf8', $ids) if($perl58);
 268 #    $ids=~s/[? ()]//g;
 269     return $ids;
 270 }
 271
 272 sub get_char_id_for_ids{
 273     my($ids)=@_;
 274     my($char_id,$char);
 275     $ids=decode('utf8', $ids) if($perl58);
 276 #    $ids="(?".(join " ?",(split(//,$ids))).")";
 277     &get_idsdb if(not defined($idsdb));
 278     $char=$idsdb->{$ids};
 279     $char=decode('utf8',$char) if($perl58);
 280     if($char){
 281         return unpack("U",$char);
 282     }else{
 283         return undef;
 284     }
 285 }
 286
 287 sub get_idsdb{
 288     tie %{$idsdb}, "BerkeleyDB::Hash",
 289     -Filename => "$omegadb_home/idsdb" or die $!;
 290 }
 291
 292 sub get_char_in_utf8mcs_bak{
 293     my($char,$in_cs)=@_;
 294     return $char if($in_cs eq "Utf8mcs");
 295     my($char_id,$output_char);
 296     $in_cs=~s/Utf8/ucs-/;
 297     $char_id=unpack("U",$char);
 298     if(($output_char)=&get_chars_matching("$in_cs",$char_id)){
 299         $output_char=decode('utf8', $output_char) if($perl58);
 300         return $output_char;
 301     }else{
 302         return $char;
 303     }
 304 }
 305
 306 sub get_char_in_utf8mcs{
 307     # argument: <character>, <input coding system>
 308     # return:   character in UTF-8mcs.
 309     my($char,$in_cs)=@_;
 310     my($char_id,$output_char_id);
 311     return $char if($in_cs eq "Utf8mcs");
 312     $char_id=unpack("U",$char);
 313     &get_utf8mcs_map($in_cs) if(not defined($utf8mcs_map_from{$in_cs}));
 314     if($output_char_id=$utf8mcs_map_from{$in_cs}->{$char_id}){
 315         return pack("U",$output_char_id);
 316    }else{
 317         return $char;
 318    }
 319 }
 320
 321 sub get_utf8mcs_map{
 322     my($in_cs)=@_;
 323     my($suffix);
 324     ($suffix=$in_cs)=~s/^Utf8//;
 325     tie %{$utf8mcs_map_from{$in_cs}}, "BerkeleyDB::Hash",
 326     -Filename => "$omegadb_home/ucs-$suffix" or die $!;
 327 }
 328
 329 sub get_macro_for_GT{
 330     my($char_id)=@_;
 331     my($char,$gt,$GT);
 332     $char=pack("U",$char_id);
 333     foreach (@GT){
 334         if($gt=&get_char_attribute($char,$_)){
 335             m/gt\-pj\-(\d+)/ and $GT=$1;
 336             last;
 337         }
 338     }
 339     if($gt){
 340         return "{\\fontencoding{OT1}\\fontfamily{".sprintf("gt%02d",$GT)."}\\selectfont\\char".($gt|0x8080)."}";
 341     }else{
 342         return undef;
 343     }
 344 }
 345
 346 sub get_macro_for_HZK{
 347     my($char_id)=@_;
 348     my($char,$hzk,$HZK);
 349     $char=pack("U",$char_id);
 350     foreach (@HZK){
 351         if($hzk=&get_char_attribute($char,$_)){
 352             m/hanziku\-(\d+)/ and $HZK=$1;
 353             last;
 354         }
 355     }
 356     if($hzk){
 357         return "{\\fontencoding{OT1}\\fontfamily{".sprintf("hzk%02d",$HZK)."}\\selectfont\\char".($hzk|0x8080)."}";
 358     }else{
 359         return undef;
 360     }
 361 }
 362
 363 sub get_macro_for_CDP{
 364     my($char_id)=@_;
 365     my($char,$cdp);
 366     $char=pack("U",$char_id);
 367     foreach (@CDP){
 368         if($cdp=&get_char_attribute($char,$_)){
 369             last;
 370         }
 371     }
 372     if($cdp){
 373         return "{\\fontencoding{OT1}\\fontfamily{cdp}\\selectfont\\char".($cdp|0x8080)."}";
 374     }else{
 375         return undef;
 376     }
 377 }