+#!/usr/bin/perl
+
+use strict;
+use vars qw($opt_in_cs $opt_out_cs $opt_help $usage
+ $in_cs $out_cs
+ $char $char_id $out_char $omegadb_home
+ $ids $ids_argc %ids $idsdb
+ $idsdata_file $ids_start $font_start
+ %utf8mcs_map_from
+ %cmap_to
+ $inotp $perl56 $perl58
+ $useCDP $useHZK $useGT
+ @CDP @HZK @GT
+ );
+use Getopt::Long;
+use utf8;
+use Chise_utils ':all';
+
+$useGT=1;
+$useHZK=0;
+$useCDP=0;
+
+if($^V and $^V ge v5.8){
+ $perl58=1;
+}elsif($^V and $^V ge v5.6){
+ $perl56=1;
+}else{
+ print STDERR "This versin is not supported.";
+}
+if($perl58){
+ eval "use Encode";
+ binmode(STDIN, ':encoding(utf8)');
+ binmode(STDOUT, ':encoding(utf8)');
+}
+
+#$omegadb_home="/home/ttomabec/.chise";
+$omegadb_home="/Users/izumi/.chise";
+
+&GetOptions("in=s"=>\$opt_in_cs,
+ "i=s"=>\$opt_in_cs,
+ "out=s"=>\$opt_out_cs,
+ "o=s"=>\$opt_out_cs,
+ "help",\$opt_help,
+ "h",\$opt_help);
+
+$usage=<<EOF;
+Usage: $0 -i <input coding system> -o <cmap encoding>
+ input coding system:
+ Utf8mcs, Utf8cns, Utf8gb, Utf8jis, Utf8ks
+ cmap encoding:
+ UniCNS, UniGB, UniJIS, UniKS
+EOF
+
+if($opt_in_cs or $opt_out_cs){
+ $in_cs=$opt_in_cs;
+ $out_cs=$opt_out_cs;
+}elsif(@ARGV==0){
+ ($in_cs,$out_cs)=($0=~/(Utf8.+)To(\w+)/);
+ $inotp=1;
+}
+
+# $in_cs:
+# utf-8-mcs,utf-8-cns,utf-8-gb,utf-8-jis,utf-8-ks,
+# $out_cs:
+# UniCNS,UniGB,UniJIS,UniKS
+
+if($opt_help
+ or not defined($in_cs)
+ or not defined($out_cs)){
+ print $usage;
+ exit 1;
+}
+
+$idsdata_file="idsdata.pl";
+$ids_start=0x00;
+$font_start=0;
+
+if(-e $idsdata_file){
+ require $idsdata_file;
+}
+
+$ids_argc=0;
+$ids="";
+
+@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","=gt-pj-11"
+ #,"=gt-pj-k1","=gt-pj-k2"
+ );
+@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");
+@CDP=("=big5-cdp");
+
+while(<>){
+ # temporary fix for using in OTP for perl 5.6.
+ s/(.)/pack("c",unpack("U",$1))/ge if($inotp
+ and $in_cs=~/utf8/i
+ and $perl56);
+ # for perl 5.8.
+ $_=decode('utf8', $_) if ($inotp and $in_cs=~/utf8/i
+ and $perl58);
+ s/(amp.+?;)/&tex_de_er($1)/ge;
+# s/(&.+?;)/&tex_de_er($1)/ge;
+ while(m/(.)/g){
+ $char=&get_char_in_utf8mcs($1,$in_cs);
+ $char_id=unpack("U",$char);
+ if($ids_argc>0){
+ ($ids,$ids_argc)=&ids_rest($ids,$ids_argc,$char);
+ if($ids_argc==0){
+ if(($char_id=&get_char_id_for_ids($ids))
+ and(($out_char=&get_output_char($char_id,$out_cs)))){
+ print $out_char;
+ }else{
+ print &replace_ids($ids) if($perl56);
+ print encode('utf8', &replace_ids($ids)) if($perl58);
+ }
+ $ids="";
+ }
+ }elsif($char_id>=0x2ff0 and $char_id<=0x2fff){
+ ($ids,$ids_argc)=&ids_rest("",0,$char);
+ next;
+ }else{
+ if($char_id<=0xff){
+ print $char;
+ next;
+ }
+ if(($out_char=&get_output_char($char_id,$out_cs))){
+ print $out_char;
+ }elsif($char_id >= 0x20000 && $char_id <=0x2a6df){
+ unless(defined($ids{$char}) and $ids{$char}[1]>=0){
+ $ids{$char}[0]=$font_start;
+ $ids{$char}[1]=$ids_start;
+ $ids_start++;
+ if($ids_start>255){
+ $ids_start=0;
+ $font_start++;
+ }
+ }
+ print "{\\fontencoding{OT1}\\fontfamily{" .
+ sprintf("chise%03d",$ids{$char}[0]) .
+ "}\\selectfont\\char$ids{$char}[1]}";
+ next;
+ }else{
+ print &replace_ids(&get_ids($char));
+ }
+ }
+ }
+ if($ids_argc>0){
+ print STDERR "IDS parse error: $ids\n";
+# print pack("U",0xfffd);
+ print pack("U",0x3013) if($perl56);
+ print encode('utf8',pack("U",0x3013)) if($perl58);
+ $ids="";
+ $ids_argc=0;
+ }
+}
+
+open(IDSDATA,">$idsdata_file") or die;
+print IDSDATA 'use utf8;',"\n";
+foreach $ids (keys %ids){
+ print IDSDATA '$ids{\'',$ids,'\'}=[',join ",",@{$ids{$ids}},"];\n" if($perl56);
+ print IDSDATA '$ids{\'',encode('utf8',$ids),'\'}=[',join ",",@{$ids{$ids}},"];\n" if($perl58);
+}
+print IDSDATA '$font_start=',$font_start,";\n";
+print IDSDATA '$ids_start=',$ids_start,";\n";
+print IDSDATA "1;";
+
+exit 0;
+
+sub tex_de_er{
+ my($er)=@_;
+ my($out);
+ $er=~s/^amp(.*);$/$1/;
+# $er=~s/^&(.*);$/$1/;
+ $out=&de_er($er);
+ if($out){
+ return $out;
+ }else{
+ return "amp$er;";
+ }
+}
+
+sub ids_rest{
+ my($ids,$ids_argc,$char)=@_;
+ my($argc);
+ $argc=&ids_argc($char);
+ if($argc){
+ $ids_argc+= $ids_argc==0 ? $argc : $argc-1;
+ }else{
+ $ids_argc--;
+ }
+ $ids.=$char if($perl56);
+ $ids.=encode('utf8',$char) if($perl58);
+ return ($ids,$ids_argc);
+}
+
+sub replace_ids{
+ 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}-]/));
+ #irregular for KAGE.
+ unless(defined($ids{$ids}) and $ids{$ids}[1]>=0){
+ $ids{$ids}[0]=$font_start;
+ $ids{$ids}[1]=$ids_start;
+ $ids_start++;
+ }
+ if($ids_start>255){
+ $ids_start=0;
+ $font_start++;
+ }
+ return "{\\fontencoding{OT1}\\fontfamily{".sprintf("chise%03d",$ids{$ids}[0])."}\\selectfont\\char$ids{$ids}[1]}";
+}
+
+sub normalize_ids{
+ my($ids,$out_cs)=@_;
+ $ids = decode('utf8', $ids) if $perl58;
+ $out_cs=~s/Uni(.+)/"ucs-".lc($1)/e;
+ my $output_ids="";
+ my($char,$char_id,$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,"ucs")){
+ $output_ids.=pack("U",$output_char_id);
+ }else{
+ return pack("U",0xfffe);
+ }
+ }
+ return $output_ids;
+}
+
+sub get_output_char{
+ my($char_id,$out_cs)=@_;
+ my($out_char_id,$suffix);
+ my($gt,$hzk,$cdp);
+ if(not defined($cmap_to{$out_cs})){
+ &get_cmap($out_cs);
+ }
+ if($out_char_id=$cmap_to{$out_cs}->{$char_id}){
+ return pack("U",$out_char_id);
+ }else{
+ return $gt if($useGT and $gt=&get_macro_for_GT($char_id));
+ return $hzk if($useHZK and $hzk=&get_macro_for_HZK($char_id));
+ return $cdp if($useCDP and $cdp=&get_macro_for_CDP($char_id));
+ return undef;
+ }
+}
+
+sub get_cmap{
+ my($out_cs)=@_;
+ tie %{$cmap_to{$out_cs}}, "BerkeleyDB::Hash",
+ -Filename => "$omegadb_home/$out_cs" or die $!;
+}
+
+sub get_ids{
+ my($char)=@_;
+ my $ids="";
+ $ids=&get_char_attribute($char,"ids-aggregated")
+ or &get_char_attribute($char,"ids");
+# or &get_char_attribute($char,"ideographic-structure");
+ $ids=decode('utf8', $ids) if($perl58);
+# $ids=~s/[? ()]//g;
+ return $ids;
+}
+
+sub get_char_id_for_ids{
+ my($ids)=@_;
+ my($char_id,$char);
+ $ids=decode('utf8', $ids) if($perl58);
+# $ids="(?".(join " ?",(split(//,$ids))).")";
+ &get_idsdb if(not defined($idsdb));
+ $char=$idsdb->{$ids};
+ $char=decode('utf8',$char) if($perl58);
+ if($char){
+ return unpack("U",$char);
+ }else{
+ return undef;
+ }
+}
+
+sub get_idsdb{
+ tie %{$idsdb}, "BerkeleyDB::Hash",
+ -Filename => "$omegadb_home/idsdb" or die $!;
+}
+
+sub get_char_in_utf8mcs_bak{
+ my($char,$in_cs)=@_;
+ return $char if($in_cs eq "Utf8mcs");
+ my($char_id,$output_char);
+ $in_cs=~s/Utf8/ucs-/;
+ $char_id=unpack("U",$char);
+ if(($output_char)=&get_chars_matching("$in_cs",$char_id)){
+ $output_char=decode('utf8', $output_char) if($perl58);
+ return $output_char;
+ }else{
+ return $char;
+ }
+}
+
+sub get_char_in_utf8mcs{
+ # argument: <character>, <input coding system>
+ # return: character in UTF-8mcs.
+ my($char,$in_cs)=@_;
+ my($char_id,$output_char_id);
+ return $char if($in_cs eq "Utf8mcs");
+ $char_id=unpack("U",$char);
+ &get_utf8mcs_map($in_cs) if(not defined($utf8mcs_map_from{$in_cs}));
+ if($output_char_id=$utf8mcs_map_from{$in_cs}->{$char_id}){
+ return pack("U",$output_char_id);
+ }else{
+ return $char;
+ }
+}
+
+sub get_utf8mcs_map{
+ my($in_cs)=@_;
+ my($suffix);
+ ($suffix=$in_cs)=~s/^Utf8//;
+ tie %{$utf8mcs_map_from{$in_cs}}, "BerkeleyDB::Hash",
+ -Filename => "$omegadb_home/ucs-$suffix" or die $!;
+}
+
+sub get_macro_for_GT{
+ my($char_id)=@_;
+ my($char,$gt,$GT);
+ $char=pack("U",$char_id);
+ foreach (@GT){
+ if($gt=&get_char_attribute($char,$_)){
+ m/gt\-pj\-(\d+)/ and $GT=$1;
+ last;
+ }
+ }
+ if($gt){
+ return "{\\fontencoding{OT1}\\fontfamily{".sprintf("gt%02d",$GT)."}\\selectfont\\char".($gt|0x8080)."}";
+ }else{
+ return undef;
+ }
+}
+
+sub get_macro_for_HZK{
+ my($char_id)=@_;
+ my($char,$hzk,$HZK);
+ $char=pack("U",$char_id);
+ foreach (@HZK){
+ if($hzk=&get_char_attribute($char,$_)){
+ m/hanziku\-(\d+)/ and $HZK=$1;
+ last;
+ }
+ }
+ if($hzk){
+ return "{\\fontencoding{OT1}\\fontfamily{".sprintf("hzk%02d",$HZK)."}\\selectfont\\char".($hzk|0x8080)."}";
+ }else{
+ return undef;
+ }
+}
+
+sub get_macro_for_CDP{
+ my($char_id)=@_;
+ my($char,$cdp);
+ $char=pack("U",$char_id);
+ foreach (@CDP){
+ if($cdp=&get_char_attribute($char,$_)){
+ last;
+ }
+ }
+ if($cdp){
+ return "{\\fontencoding{OT1}\\fontfamily{cdp}\\selectfont\\char".($cdp|0x8080)."}";
+ }else{
+ return undef;
+ }
+}
projects / chise / omega.git / commitdiff