#
# CHISE.pm by Shigeki Moro
-# $Id: CHISE.pm,v 1.3 2003-03-12 16:53:59 moro Exp $
+# $Id: CHISE.pm,v 1.4 2003-08-10 09:11:56 moro Exp $
#
package CHISE;
use strict;
+use warnings;
use BerkeleyDB;
our ($EXCLUSIVE, $HAVE_INTERSECTION, $PROPER_SUBSET, $PROPER_SUPERSET, $EQSET);
($EXCLUSIVE, $HAVE_INTERSECTION, $PROPER_SUBSET, $PROPER_SUPERSET, $EQSET)
= (1, 2, 3, 4, 5);
-my $DB_HOME = '/usr/local/lib/xemacs-21.4.10/i686-pc-linux/char-db';
+# データベースの場を指。いずれは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 "No database found.\n";
+ print STDERR "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} = $_;
#--- exportする予の関数 -------------------------------------#
-sub new {
+sub new (@) {
# 既存の字オブジェクトの生成
my $invocant = shift;
my $class = ref($invocant) || $invocant;
my($a, $b) = @_;
my($aonly, $bonly, $common) = (0, 0, 0);
for my $i (&cup(keys %$a, keys %$b)) {
- if ($a->{$i} eq $b->{$i}) {
- $common++;
- } else {
- $aonly++ if (exists $a->{$i});
- $bonly++ if (exists $b->{$i});
+ 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});
+ }
}
}
if ($common == 0) {
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";
-Filename => $dbname;
my @keys = ();
for my $key (keys %h) {
- push @keys, $key if ($h{$key} eq $value);
+ push @keys, $key if ($h{$key} =~ /\b$value\b/);
}
untie %h;
return @keys;