From fff9665741faa5bfde00334cb7a83c05be12f73f Mon Sep 17 00:00:00 2001
From: moro <moro>
Date: Sun, 23 Feb 2003 09:17:19 +0000
Subject: [PATCH] method 'ph2char'

---
 CHISE.pm |   94 +++++++++++++++++++++++++++++++++++++++++++++++++++-----------
 1 file changed, 78 insertions(+), 16 deletions(-)

diff --git a/CHISE.pm b/CHISE.pm
index f4eca2f..cff017e 100644
--- 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) = @_;
-- 
1.7.10.4