method 'ph2char'

diff --git a/CHISE.pm b/CHISE.pm
index f4eca2f..cff017e 100644 (file)
--- a/CHISE.pm
+++ b/CHISE.pm
@@ -1,6 +1,6 @@
 #
 # CHISE.pm by Shigeki Moro
-# $Id: CHISE.pm,v 1.1 2003-02-02 12:25:10 moro Exp $
+# $Id: CHISE.pm,v 1.2 2003-02-23 09:17:19 moro Exp $
 #
 package CHISE;
 
@@ -27,7 +27,7 @@ for (glob "$DB_HOME/system-char-id/*") {
          'strokes','total-strokes',
 );
 
-#--------------------------------------------------------#
+#--- exportする予�����の関数 -------------------------------------#
 
 sub new {
   # 既存の�����字オブジェクトの生成
@@ -60,7 +60,7 @@ sub define_char {
 }
 
 sub dumpAttr {
-  # �����字オブジェクトが持っている全属性を表示
+  # �����字オブジェクトが持っている全属性をprint
   my $self = shift;
   for my $i (keys %$self) {
     print "$i => $$self{$i}\n";
@@ -84,6 +84,7 @@ sub delAttr (@) {
 
 # 属性名で属性値を�����す
 # 例: $s->morohashi_daikanwa
+# cf. get_char_attribute
 for my $attrname (keys %alias) {
   my $slot = __PACKAGE__ . "::$attrname";
   no strict "refs";
@@ -109,19 +110,8 @@ for my $attrname (keys %alias) {
 #  }
 #}
 
-sub utf8 {
-  # UTF-8を�����す
-  my $self = shift;
-  my @result;
-  for my $i ($self->chars) {
-    $i =~ s/^\?//;
-    # To Do: 私用�����域のは�����さないようにしないと。
-    push @result, $i;
-  }
-  return @result;
-}
-
 sub compare {
+  # �����字オブジェクトと比�����
   my($a, $b) = @_;
   my($all_attr, $common_attr) = (0, 0);
   for my $i (&cup(keys %$a, keys %$b)) {
@@ -136,7 +126,67 @@ sub compare {
   return $all_attr ? ($common_attr / $all_attr) : 0;
 }
 
-#--------------------------------------------------------#
+sub ph2char ($) {
+  # �����体参照から?xを得る
+  my $ph = shift;
+  my %alias = (
+              'C1','chinese-cns11643-1',
+              'C2','chinese-cns11643-2',
+              'C3','chinese-cns11643-3',
+              'C4','chinese-cns11643-4',
+              'C5','chinese-cns11643-5',
+              'C6','chinese-cns11643-6',
+              'C7','chinese-cns11643-7',
+              'CB','ideograph-cbeta',
+              'CDP','chinese-big5-cdp',
+              'GT','ideograph-gt',
+              'GT-K','ideograph-gt',
+              'HZK1','ideograph-hanziku-1',
+              'HZK2','ideograph-hanziku-2',
+              'HZK3','ideograph-hanziku-3',
+              'HZK4','ideograph-hanziku-4',
+              'HZK5','ideograph-hanziku-5',
+              'HZK6','ideograph-hanziku-6',
+              'HZK7','ideograph-hanziku-7',
+              'HZK8','ideograph-hanziku-8',
+              'HZK9','ideograph-hanziku-9',
+              'HZK10','ideograph-hanziku-10',
+              'HZK11','ideograph-hanziku-11',
+              'HZK12','ideograph-hanziku-12',
+              'J78','japanese-jisx0208-1978',
+              'J83','japanese-jisx0208',
+              'J90','japanese-jisx0208-1990',
+              'JSP','japanese-jisx0212',
+              'JX1','japanese-jisx0213-1',
+              'JX2','japanese-jisx0213-2',
+              'K0','korean-ksc5601',
+              'M','ideograph-daikanwa',
+             );
+  my $keys = join '|', sort keys %alias;
+  my($phname, $phvalue) = ($ph =~ /^\&(?:I\-)?($keys)\-?([0-9a-f]+);$/i);
+  if (exists $alias{$phname}) {
+    if ($alias{$phname} =~ /daikanwa|gt/) {
+      $phvalue =~ s/^0+//;
+    } else {
+      $phvalue = "0x$phvalue";
+    }
+    tie my %h, "BerkeleyDB::Hash",
+      -Filename => "$DB_HOME/$alias{$phname}/system-char-id"
+      or die "Cannot open file $alias{$phname}: $! $BerkeleyDB::Error\n";
+    if (exists $h{$phvalue}) {
+      return $h{$phvalue};
+    } else {
+      #print STDERR "\tCan't convert $phname - $phvalue (no value in db).\n";
+      return $ph;
+    }
+    untie %h;
+  } else {
+    #print STDERR "\tCan't convert $phname - $phvalue.\n";
+    return $ph;
+  }
+}
+
+#--- モジュール内のみで�����う予�����の関数 ----------------------#
 
 sub chars {
   # ?... の配列を�����す
@@ -158,6 +208,18 @@ sub chars {
   return @result;
 }
 
+sub utf8 {
+  # UTF-8を�����す
+  my $self = shift;
+  my @result;
+  for my $i ($self->chars) {
+    $i =~ s/^\?//;
+    # To Do: 私用�����域のは�����さないようにしないと。
+    push @result, $i;
+  }
+  return @result;
+}
+
 sub getvalue ($$) {
   # キーから値を�����り出す
   my($dbname, $key) = @_;