add 'compare' method.

diff --git a/UTF2000.pm b/UTF2000.pm
index f32b6b9..fb430a1 100644 (file)
--- a/UTF2000.pm
+++ b/UTF2000.pm
@@ -1,6 +1,6 @@
 #
 # UTF2000.pm by Shigeki Moro
-# UTF2000.pm,v 1.6 2003-01-31 18:25:24 moro Exp
+# UTF2000.pm,v 1.6 2003/01/31 18:25:24 moro Exp
 #
 package UTF2000;
 
@@ -47,7 +47,7 @@ sub new {
   return bless $result, $class;
 }
 
-sub newchar {
+sub define_char {
   # �����しい�����字オブジェクトの生成
   my $invocant = shift;
   my $class = ref($invocant) || $invocant;
@@ -66,7 +66,7 @@ sub dumpAttr {
 sub addAttr {
   # �����字オブジェクトに属性を追加
   my $model = shift;
-  my $self = $model->newchar(%$model, @_);
+  my $self = $model->define_char(%$model, @_);
   return $self;
 }
 
@@ -74,7 +74,7 @@ sub delAttr (@) {
   # �����字オブジェクトから属性を削除
   my $model = shift;
   delete $$model{$_} foreach (@_);
-  my $self = $model->newchar(%$model);
+  my $self = $model->define_char(%$model);
   return $self;
 }
 
@@ -85,14 +85,25 @@ for my $attrname (keys %alias) {
   no strict "refs";
   *$slot = sub {
     my $self = shift;
-    my @result;
-    for my $i ($self->chars) {
-      my $j = &getvalue("$DB_HOME/system-char-id/$alias{$attrname}", $i);
-      push @result, $j if $j;
-    }
-    return @result;
+    my $dbname = exists $alias{$attrname}
+      ? $alias_reverse{$alias{$attrname}}
+       : $attrname;
+    return $self->{$dbname};
   }
 }
+#for my $attrname (keys %alias) {
+#  my $slot = __PACKAGE__ . "::$attrname";
+#  no strict "refs";
+#  *$slot = sub {
+#    my $self = shift;
+#    my @result;
+#    for my $i ($self->chars) {
+#      my $j = &getvalue("$DB_HOME/system-char-id/$alias{$attrname}", $i);
+#      push @result, $j if $j;
+#    }
+#    return @result;
+#  }
+#}
 
 sub utf8 {
   # UTF-8を�����す
@@ -106,6 +117,21 @@ sub utf8 {
   return @result;
 }
 
+sub compare {
+  my($a, $b) = @_;
+  my($all_attr, $common_attr) = (0, 0);
+  for my $i (&cup(keys %$a, keys %$b)) {
+    if ($a->{$i} eq $b->{$i}) {
+      $all_attr++;
+      $common_attr++;
+    } else {
+      $all_attr++ if (exists $a->{$i});
+      $all_attr++ if (exists $b->{$i});
+    }
+  }
+  return $all_attr ? ($common_attr / $all_attr) : 0;
+}
+
 #--------------------------------------------------------#
 
 sub chars {
@@ -175,5 +201,12 @@ sub cap {
   }
 }
 
+sub cup {
+  # 2つの配列の和�����合を求める
+  my %result = ();
+  for my $i (@_) { $result{$i}++; }
+  return keys %result;
+}
+
 #--------------------------------------------------------#
 1;