X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=CHISE.pm;h=3eec0ee1a7e41651bea059a47549ce32fd03dfbd;hb=132564cd4179de9403eab3d4585e8bca955cbfd7;hp=57b5b91bbd813948d2a9c35de7b7e36145e2d070;hpb=0378b21385a2a9801c80814bd91aa28effdf8296;p=chise%2Fperl.git diff --git a/CHISE.pm b/CHISE.pm index 57b5b91..3eec0ee 100644 --- 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) = @_;