add $

[chise/perl.git] / CHISE.pm

diff --git a/CHISE.pm b/CHISE.pm
index 57b5b91..3eec0ee 100644 (file)
--- a/CHISE.pm
+++ b/CHISE.pm
@@ -1,22 +1,13 @@
 #
 # CHISE.pm by Shigeki Moro
-# $Id: CHISE.pm,v 1.5 2003-08-10 15:52:15 moro Exp $
+# $Id: CHISE.pm,v 1.6 2003-10-08 13:30:28 moro Exp $
 #
 package CHISE;
 
 use strict;
 use warnings;
 use utf8;
-use BerkeleyDB;
-use overload;
-
-sub import {
-  overload::constant ( 'qr' => \&ChiseLikeRegex )
-}
-
-sub unimport {
-  overload::remove_constant
-}
+use DB_File;
 
 our ($EXCLUSIVE, $HAVE_INTERSECTION, $PROPER_SUBSET, $PROPER_SUPERSET, $EQSET);
 ($EXCLUSIVE, $HAVE_INTERSECTION, $PROPER_SUBSET, $PROPER_SUPERSET, $EQSET)
@@ -49,8 +40,6 @@ if (-e '/usr/local/lib/chise/char-db') {
   exit 1;
 }
 
-#my $cache_size = 1024 * 1024 * 64;
-
 my %alias = ();
 my %alias_reverse = ();
 for (glob "$DB_HOME/system-char-id/*") {
@@ -166,6 +155,9 @@ sub compare {
        $aonly++ if (exists $a->{$i});
        $bonly++ if (exists $b->{$i});
       }
+    } else {
+      $aonly++ if (exists $a->{$i});
+      $bonly++ if (exists $b->{$i});
     }
   }
   if ($common == 0) {
@@ -257,31 +249,6 @@ sub ph2char ($) {
   }
 }
 
-#--- 正規表現のCHISE的拡張 ------------------------------------#
-
-sub ChiseLikeRegex ($) {
-  my ($RegexLiteral) = @_;
-  #print STDERR "BEFORE: $RegexLiteral\n"; # for debug
-  $RegexLiteral =~ s/\\same_strokes_(\d)/(??{CHISE->same_strokes(\$$1)})/g;
-  #$RegexLiteral =~ s/\\same_strokes_(\d)/[川山三]/g;
-  #print STDERR "AFTER:  $RegexLiteral\n"; # for debug
-  return $RegexLiteral;
-}
-
-sub same_strokes {
-  my $self = shift;
-  my $backtrace = shift;
-  my $db = "$DB_HOME/system-char-id/total-strokes";
-  my $temp = &getvalue($db, "?$backtrace");
-  my $result = '';
-  for my $i (&getkeys($db, $temp)) {
-    $i =~ s/^\?//;
-    $result .= $i;
-  }
-  #print STDERR $result, "\n";
-  return "[$result]";
-}
-
 #--- モジュール内のみで�����う予�����の関数 ----------------------#
 
 sub chars {
@@ -318,38 +285,30 @@ sub utf8 {
 
 sub getvalue ($$) {
   # キーから値を�����り出す
-  my($dbname, $key) = @_;
+  my ($chise_dbname, $key) = @_;
   my $value = '';
-  my $db = new BerkeleyDB::Hash
-  #tie my %h, "BerkeleyDB::Hash",
-    -Filename => $dbname;
-  #$value = $h{$key};
-  #untie %h;
-  $db->db_get($key, $value);
-  undef $db;
+  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) = @_;
-  my $db = new BerkeleyDB::Hash
-  #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 = ();
-  my ($k, $v) = ("", "") ;
-  my $cursor = $db->db_cursor() ;
-  #for my $k (keys %h) {
-  while ($cursor->c_get($k, $v, DB_NEXT) == 0) {
-    push @keys, $k if ($v eq $value);
-    #push @keys, $key if ($h{$key} eq $value);
+  for my $key (keys %h) {
+    next unless (exists $h{$key});
+    push @keys, $key if ($h{$key} eq $value);
   }
-  undef $cursor ;
-  undef $db ;
-  #untie %h;
+  untie %h;
   return @keys;
 }
 
+
 sub cap {
   # 2つの配列の積�����合を求める
   my($a, $b) = @_;