add_adobecid.pl

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use vars qw($cmapfile $db_home $encoding
   5             %cs_var
   6             $ucs $cid $last
   7             $ciddb_filename $ciddb %ciddb %cid
   8             );
   9 use BerkeleyDB;
  10 use Chise_utils ':all';
  11 require 5.008;
  12
  13 my $debug=0;
  14
  15 my $usage=<<EOF;
  16 Usage: perl $0 <CMAP file> <CHISE DB dir>
  17     <CMAP file> UniJIS-UTF16-H etc. available in Adobe Reader Directory.
  18     <CHISE DB dir> is directory to store BDB data,
  19       typically /usr/local/share/chise/0.3/db.
  20 EOF
  21
  22 #my $db_home="/usr/local/lib/chise/char-db";
  23 #my $db_home="/usr/local/lib/chise/db";
  24
  25 if(@ARGV==2){
  26     $cmapfile=shift;
  27     $db_home=shift;
  28
  29     $db_home=~s!/$!!;
  30     if(-d "$db_home/character"){
  31         $db_home=$db_home."/character/feature";
  32     }elsif(-d "$db_home/system-char-id"){
  33         $db_home=$db_home."/system-char-id";
  34     }else{
  35         print STDERR $usage;
  36         exit 1;
  37     }
  38
  39     ($ciddb_filename=$cmapfile)=~s!^.*/(.*)$!"vnd-adobe-cid-".lc($1)!e;
  40     ($encoding=$cmapfile)=~s!.*/Uni(\w+).*$!"\=ucs\@".lc($1)!e;
  41 }
  42
  43 unless(defined($cmapfile) and -f $cmapfile
  44        and $encoding=~/^=ucs\@(cns|gb|jis|ks)$/
  45        and -d $db_home){
  46     print STDERR $usage;
  47     exit 1;
  48 }
  49
  50 # if working on Mac OS.
  51 if($^O=~/darwin/){
  52     print STDERR "Using ^M as delimiter.\n";
  53     $/="\r";
  54 }
  55
  56 $cs_var{'=ucs@cns'}=['=cns11643-1','=cns11643-2',
  57                      '=cns11643-3','=cns11643-4',
  58                      '=cns11643-5','=cns11643-6',
  59                      '=cns11643-7'];
  60
  61 $cs_var{'=ucs@gb'}=['=gb12345','=gb2312'];
  62
  63 $cs_var{'=ucs@jis'}=['=jis-x0208','=jis-x0208-1978',
  64                      '=jis-x0208-1983','=jis-x0208-1990',
  65                      '=jis-x0212',
  66                      '=jis-x0213-1-2000','=jis-x0213-2-2000'];
  67
  68 $cs_var{'=ucs@ks'}=['=ks-x1001'];
  69
  70 if(-f "$db_home/$ciddb_filename"){
  71     print STDERR "Removing old DB $db_home/$ciddb_filename.\n";
  72     unlink "$db_home/$ciddb_filename";
  73 }
  74
  75 $ciddb=tie %ciddb, 'BerkeleyDB::Hash',
  76     -Filename => "$db_home/$ciddb_filename",
  77     -Flags => DB_CREATE|DB_TRUNCATE,
  78     -Pagesize      => 512,
  79     or die $!;
  80
  81 my $in_cidrange=0;
  82 my $in_cidchar=0;
  83 print STDERR "Reading $cmapfile...";
  84 open(CMAP,"<$cmapfile") or die $!;
  85 # taken from expandcmap.pl by taiji.
  86 while(<CMAP>){
  87     if(/begincidrange/){
  88         $in_cidrange=1;
  89     }elsif(/endcidrange/){
  90         $in_cidrange=0;
  91     }elsif(/begincidchar/){
  92         $in_cidchar=1;
  93     }elsif(/endcidchar/){
  94         $in_cidchar=0;
  95     }elsif($in_cidchar){
  96         if(/<([\da-fA-F]+)>\s*(\d+)/){
  97             ($ucs,$cid)=(hex($1),$2);
  98             &store_cid($ucs,$cid,$encoding);
  99         }
 100     }elsif($in_cidrange){
 101         if(/<([\da-fA-F]+)>\s*<([\da-fA-F]+)>\s*(\d+)/){
 102             ($ucs, $last, $cid) = (hex($1), hex($2), $3);
 103             while ($ucs <= $last) {
 104                 &store_cid($ucs,$cid,$encoding);
 105                 $cid++,$ucs++;
 106             }
 107         }
 108     }
 109 }
 110 close(CMAP);
 111 print STDERR "done!\n";
 112
 113 print STDERR "Storing data to CHISE DB...";
 114 foreach my $char (sort keys %cid){
 115     unless($ciddb->db_put("?".$char,$cid{$char})==0){
 116         die $!;
 117     }
 118 }
 119 print STDERR "done!\n";
 120
 121 undef $ciddb;
 122 untie %ciddb;
 123
 124 exit 0;
 125
 126 sub store_cid{
 127     my($ucs,$cid,$encoding)=@_;
 128     my($char,$char_id,$char_id_unified);
 129
 130     if($char_id=&replace_char_id($ucs,$encoding)){
 131         $char=pack("U",$char_id);
 132     }else{
 133         if(&have_glyph($ucs,$encoding)){
 134             $char=pack("U",$ucs);
 135         }else{
 136             foreach $char_id_unified (&get_char_id_unified($ucs)){
 137                 if(&have_glyph($char_id_unified,$encoding)){
 138                     $char_id=$char_id_unified;
 139                     last;
 140                 }
 141             }
 142             if($char_id){
 143                 $char=pack("U",$char_id);
 144                 if($debug){
 145                     print STDERR sprintf("%x is used for %x(%s).\n",
 146                                          $char_id,$ucs,$encoding);
 147                 }
 148             }else{
 149                 $char=pack("U",$ucs);
 150                 if($debug){
 151                     print STDERR sprintf("%x is uncertain for %s.\n",$ucs,$encoding);
 152                 }
 153             }
 154         }
 155     }
 156     if($debug){
 157         print STDERR sprintf("%X:%d\n",unpack("U",$char),$cid);
 158     }
 159     $cid{$char}=$cid;
 160 }
 161
 162 sub replace_char_id{
 163     my($ucs,$encoding)=@_;
 164     my($char);
 165
 166     if(($char)=&get_chars_matching($encoding,$ucs)){
 167         return unpack("U",$char);
 168     }else{
 169         return undef;
 170     }
 171 }
 172
 173 sub have_glyph{
 174     my($char_id,$cs)=@_;
 175     my($cs_var,$char);
 176     $char=pack("U",$char_id);
 177     foreach $cs_var (@{$cs_var{$cs}}){
 178         if(&get_char_attribute($char,$cs_var)){
 179             return 1;
 180         }
 181     }
 182     return undef;
 183 }
 184
 185 sub get_char_id_unified{
 186     my($char_id)=@_;
 187     my($chars);
 188     if($chars=&get_char_attribute(pack("U",$char_id),'->ucs-unified')){
 189         $chars=~s/^\((.*)\)$/$1/;
 190         return map {unpack("U",$_)} (split(/\s*\?/,$chars));
 191     }else{
 192         return ();
 193     }
 194 }