projects / chise / perl.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
fix bug in &de_er(). treat $value as decimal explicitly in case of daikanwa and gt.
[chise/perl.git] / CHISE.pm
diff --git a/CHISE.pm b/CHISE.pm
index cff017e..3eec0ee 100644 (file)
--- a/CHISE.pm
+++ b/CHISE.pm
@@ -1,22 +1,54 @@
 #
 # CHISE.pm by Shigeki Moro
-# $Id: CHISE.pm,v 1.2 2003-02-23 09:17:19 moro Exp $
+# $Id: CHISE.pm,v 1.6 2003-10-08 13:30:28 moro Exp $
 #
 package CHISE;
 
 use strict;
-use BerkeleyDB;
+use warnings;
+use utf8;
+use DB_File;
 
-my $DB_HOME = '/usr/local/lib/xemacs-21.4.10/i686-pc-linux/char-db';
+our ($EXCLUSIVE, $HAVE_INTERSECTION, $PROPER_SUBSET, $PROPER_SUPERSET, $EQSET);
+($EXCLUSIVE, $HAVE_INTERSECTION, $PROPER_SUBSET, $PROPER_SUPERSET, $EQSET)
+  = (1, 2, 3, 4, 5);
+
+# データベースの場を指。いずれはlibchiseに...
+# データベースの全ファイルをchownしないとえないかも
+my $DB_HOME='';
+if (-e '/usr/local/lib/chise/char-db') {
+  $DB_HOME = '/usr/local/lib/chise/char-db';
+} elsif (-e '/sw/lib/xemacs-21.4.11/powerpc-apple-darwin6.6/char-db') {
+  $DB_HOME = '/sw/lib/xemacs-21.4.11/powerpc-apple-darwin6.6/char-db';
+} elsif (-e '/usr/local/lib/xemacs-21.4.11/i686-pc-linux/char-db') {
+  $DB_HOME = '/usr/local/lib/xemacs-21.4.11/i686-pc-linux/char-db';
+} elsif (-e '/usr/local/lib/xemacs-21.4.11/powerpc-apple-darwin6.4/char-db') {
+  $DB_HOME = '/usr/local/lib/xemacs-21.4.11/powerpc-apple-darwin6.4/char-db';
+} elsif (-e '/usr/local/xemacs-utf2000/lib/xemacs-21.4.11/powerpc-apple-darwin6.4/char-db'){
+  $DB_HOME = '/usr/local/xemacs-utf2000/lib/xemacs-21.4.11/powerpc-apple-darwin6.4/char-db';
+} elsif (-e '/usr/local/lib/xemacs-21.4.10/i686-pc-linux/char-db') {
+  $DB_HOME = '/usr/local/lib/xemacs-21.4.10/i686-pc-linux/char-db';
+} elsif (-e '/usr/local/lib/xemacs-21.4.10/powerpc-apple-darwin6.4/char-db') {
+  $DB_HOME = '/usr/local/lib/xemacs-21.4.10/powerpc-apple-darwin6.4/char-db';
+} elsif (-e '/usr/local/xemacs-utf2000/lib/xemacs-21.4.10/powerpc-apple-darwin6.4/char-db'){
+  $DB_HOME = '/usr/local/xemacs-utf2000/lib/xemacs-21.4.10/powerpc-apple-darwin6.4/char-db';
+} elsif (-e 'd:/work/chise/char-db'){
+  $DB_HOME = 'd:/work/chise/char-db';
+} else {
+  print STDERR "CHISE.pm: No database found.\n";
+  print STDERR "CHISE.pm: Please set \$DB_HOME to CHISE.pm.\n";
+  exit 1;
+}
 
 my %alias = ();
 my %alias_reverse = ();
 for (glob "$DB_HOME/system-char-id/*") {
   s/^.*\/([^\/]+)$/$1/;
   my $i = $_;
-  s/\->/to_/;
-  s/<\-/from_/;
-  s/=>/map_/;
+  s/^\->/to_/;    # Perlではリファレンスに
+  s/^<\-/from_/;  # "-" などがえないため、しておく。
+  s/^=>/mapto/;
+  s/^=//;
   s/\-/_/g;
   $alias{$_} = $i;
   $alias_reverse{$i} = $_;
@@ -29,7 +61,7 @@ for (glob "$DB_HOME/system-char-id/*") {
 
 #--- exportする予の関数 -------------------------------------#
 
-sub new {
+sub new (@) {
   # 既存の字オブジェクトの生成
   my $invocant = shift;
   my $class = ref($invocant) || $invocant;
@@ -111,7 +143,38 @@ for my $attrname (keys %alias) {
 #}
 
 sub compare {
-  # 字オブジェクトと比
+  # 字オブジェクトどうしを比して、
+  # 合の重なり具合をす。
+  my($a, $b) = @_;
+  my($aonly, $bonly, $common) = (0, 0, 0);
+  for my $i (&cup(keys %$a, keys %$b)) {
+    if (exists $a->{$i} and exists $b->{$i}) {
+      if ($a->{$i} eq $b->{$i}) {
+       $common++;
+      } else {
+       $aonly++ if (exists $a->{$i});
+       $bonly++ if (exists $b->{$i});
+      }
+    } else {
+      $aonly++ if (exists $a->{$i});
+      $bonly++ if (exists $b->{$i});
+    }
+  }
+  if ($common == 0) {
+    return $EXCLUSIVE; # 他
+  } elsif ($aonly == 0 and $bonly == 0) {
+    return $EQSET; # 全一致
+  } elsif ($aonly == 0) {
+    return $PROPER_SUBSET; # $aは$bの合
+  } elsif ($bonly == 0) {
+    return $PROPER_SUPERSET; # $bは$aの合
+  } else {
+    return $HAVE_INTERSECTION;
+  }
+}
+
+sub rate_of_coincidence {
+  # 字オブジェクトどうしの属性の一致を出す。
   my($a, $b) = @_;
   my($all_attr, $common_attr) = (0, 0);
   for my $i (&cup(keys %$a, keys %$b)) {
@@ -196,10 +259,10 @@ sub chars {
     my @tmp = ();
     my $dbname = exists $alias{$attrname} ? $alias{$attrname} : $attrname;
     if (-f "$DB_HOME/$dbname/system-char-id") {
-      @tmp = (&getvalue("$DB_HOME/$dbname/system-char-id", $$self{$attrname}));
+      @tmp = (&getvalue("$DB_HOME/$dbname/system-char-id", $self->{$attrname}));
       @result = &cap(\@result, \@tmp);
     } elsif (-f "$DB_HOME/system-char-id/$dbname") {
-      @tmp = &getkeys("$DB_HOME/system-char-id/$dbname", $$self{$attrname});
+      @tmp = &getkeys("$DB_HOME/system-char-id/$dbname", $self->{$attrname});
       @result = &cap(\@result, \@tmp);
     } else {
       die "cannot find $attrname: $! $BerkeleyDB::Error\n";
@@ -222,27 +285,30 @@ sub utf8 {
 
 sub getvalue ($$) {
   # キーから値をり出す
-  my($dbname, $key) = @_;
-  tie my %h, "BerkeleyDB::Hash",
-    -Filename => $dbname;
-  my $value = $h{$key};
+  my ($chise_dbname, $key) = @_;
+  my $value = '';
+  tie (my %h, "DB_File", $chise_dbname, O_RDWR)
+    or die "Cannot open file $chise_dbname: $!\n";
+  $value = $h{$key};
   untie %h;
   return $value;
 }
 
 sub getkeys ($$) {
   # 値からキーの配列をり出す
-  my($dbname, $value) = @_;
-  tie my %h, "BerkeleyDB::Hash",
-    -Filename => $dbname;
+  my ($chise_dbname, $value) = @_;
+  tie (my %h, "DB_File", $chise_dbname, O_RDWR, , $DB_BTREE)
+    or die "Cannot open file $chise_dbname: $!\n";
   my @keys = ();
   for my $key (keys %h) {
+    next unless (exists $h{$key});
     push @keys, $key if ($h{$key} eq $value);
   }
   untie %h;
   return @keys;
 }
 
+
 sub cap {
   # 2つの配列の積合を求める
   my($a, $b) = @_;