'new' has been devided into 'new' and 'newchar'.

diff --git a/UTF2000.pm b/UTF2000.pm
index a7b6591..f32b6b9 100644 (file)
--- a/UTF2000.pm
+++ b/UTF2000.pm
@@ -1,6 +1,6 @@
 #
 # UTF2000.pm by Shigeki Moro
-# UTF2000.pm,v 1.5 2003-01-28 07:16:02 moro Exp
+# UTF2000.pm,v 1.6 2003-01-31 18:25:24 moro Exp
 #
 package UTF2000;
 
@@ -10,6 +10,7 @@ use BerkeleyDB;
 my $DB_HOME = '/usr/local/lib/xemacs-21.4.10/i686-pc-linux/char-db';
 
 my %alias = ();
+my %alias_reverse = ();
 for (glob "$DB_HOME/system-char-id/*") {
   s/^.*\/([^\/]+)$/$1/;
   my $i = $_;
@@ -18,16 +19,36 @@ for (glob "$DB_HOME/system-char-id/*") {
   s/=>/map_/;
   s/\-/_/g;
   $alias{$_} = $i;
+  $alias_reverse{$i} = $_;
 }
 %alias = (
          %alias,
          'radical','ideographic-radical',
-         'strokes','ideographic-strokes',
+         'strokes','total-strokes',
 );
 
 #--------------------------------------------------------#
 
 sub new {
+  # 既存の�����字オブジェクトの生成
+  my $invocant = shift;
+  my $class = ref($invocant) || $invocant;
+  my $self  = { @_ };
+  bless $self, $class;
+  my $key = ($self->chars)[0]; # 要エラーチェック
+  my($value, $result);
+  for my $dbname (glob "$DB_HOME/system-char-id/*") {
+    $value = &getvalue($dbname, $key);
+    if ($value) {
+      $dbname =~ s/^.*\/([^\/]+)$/$1/;
+      $result->{$alias_reverse{$dbname}} = $value;
+    }
+  }
+  return bless $result, $class;
+}
+
+sub newchar {
+  # �����しい�����字オブジェクトの生成
   my $invocant = shift;
   my $class = ref($invocant) || $invocant;
   my $self  = { @_ };
@@ -35,6 +56,7 @@ sub new {
 }
 
 sub dumpAttr {
+  # �����字オブジェクトが持っている全属性を表示
   my $self = shift;
   for my $i (keys %$self) {
     print "$i => $$self{$i}\n";
@@ -42,19 +64,22 @@ sub dumpAttr {
 }
 
 sub addAttr {
+  # �����字オブジェクトに属性を追加
   my $model = shift;
-  my $self = $model->new(%$model, @_);
+  my $self = $model->newchar(%$model, @_);
   return $self;
 }
 
 sub delAttr (@) {
+  # �����字オブジェクトから属性を削除
   my $model = shift;
   delete $$model{$_} foreach (@_);
-  my $self = $model->new(%$model);
+  my $self = $model->newchar(%$model);
   return $self;
 }
 
-# 
+# 属性名で属性値を�����す
+# 例: $s->morohashi_daikanwa
 for my $attrname (keys %alias) {
   my $slot = __PACKAGE__ . "::$attrname";
   no strict "refs";
@@ -84,7 +109,7 @@ sub utf8 {
 #--------------------------------------------------------#
 
 sub chars {
-  # ?... を�����す
+  # ?... の配列を�����す
   my $self = shift;
   my @result = ('*');
   for my $attrname (keys %$self) {