File removal test

diff --git a/UTF2000.pm b/UTF2000.pm
deleted file mode 100644 (file)
index bc7f123..0000000
--- a/UTF2000.pm
+++ /dev/null
@@ -1,150 +0,0 @@
-package UTF2000;
-
-use strict;
-use BerkeleyDB;
-
-my $DB_HOME = '/usr/local/lib/xemacs-21.4.10/i686-pc-linux/char-db';
-
-my %alias = ();
-for (glob "$DB_HOME/system-char-id/*") {
-  s/^.*\/([^\/]+)$/$1/;
-  my $i = $_;
-  s/\->/to_/;
-  s/<\-/from_/;
-  s/=>/map_/;
-  s/\-/_/g;
-  $alias{$_} = $i;
-}
-%alias = (
-         %alias,
-         'radical','ideographic-radical',
-         'strokes','ideographic-strokes',
-);
-
-#--------------------------------------------------------#
-
-sub new {
-  my $invocant = shift;
-  my $class = ref($invocant) || $invocant;
-  my $self  = { @_ };
-  return bless $self, $class;
-}
-
-sub dumpAttr {
-  my $self = shift;
-  for my $i (keys %$self) {
-    print "$i => $$self{$i}\n";
-  }
-}
-
-sub addAttr {
-  my $model = shift;
-  my $self = $model->new(%$model, @_);
-  return $self;
-}
-
-sub delAttr (@) {
-  my $model = shift;
-  delete $$model{$_} foreach (@_);
-  my $self = $model->new(%$model);
-  return $self;
-}
-
-# 
-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を�����す
-  my $self = shift;
-  my @result;
-  for my $i ($self->chars) {
-    $i =~ s/^\?//;
-    # To Do: 私用�����域のは�����さないようにしないと。
-    push @result, $i;
-  }
-  return @result;
-}
-
-#--------------------------------------------------------#
-
-sub chars {
-  # ?... を�����す
-  my $self = shift;
-  my @result = ('*');
-  for my $attrname (keys %$self) {
-    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}));
-      @result = &cap(\@result, \@tmp);
-    } elsif (-f "$DB_HOME/system-char-id/$dbname") {
-      @tmp = &getkeys("$DB_HOME/system-char-id/$dbname", $$self{$attrname});
-      @result = &cap(\@result, \@tmp);
-    } else {
-      die "cannot find $attrname: $! $BerkeleyDB::Error\n";
-    }
-  }
-  return @result;
-}
-
-sub getvalue ($$) {
-  # キーから値を�����り出す
-  my($dbname, $key) = @_;
-  tie my %h, "BerkeleyDB::Hash",
-    -Filename => $dbname;
-  my $value = $h{$key};
-  untie %h;
-  return $value;
-}
-
-sub getkeys ($$) {
-  # 値からキーの配列を�����り出す
-  my($dbname, $value) = @_;
-  tie my %h, "BerkeleyDB::Hash",
-    -Filename => $dbname;
-  my @keys = ();
-  for my $key (keys %h) {
-    push @keys, $key if ($h{$key} eq $value);
-  }
-  untie %h;
-  return @keys;
-}
-
-sub cap {
-  # 2つの配列の積�����合を求める
-  my($a, $b) = @_;
-  if (!@$a or !@$b) {
-    return ();
-  } elsif ($$a[0] eq '*') { # '*'は全体�����合
-    return @$b;
-  } elsif ($$b[0] eq '*') {
-    return @$a;
-  } else {
-    my %result = ();
-    my @result = ();
-    for my $i (@$a, @$b) {
-      $result{$i}++;
-      push @result, $i if ($result{$i} == 2);
-    }
-    return @result;
-    #return grep {
-    #  my $c = $_;
-    #  grep /^$c$/, @$b;
-    #} @$a;
-  }
-}
-
-#--------------------------------------------------------#
-1;