chisereg.pl

   1 #!/usr/bin/perl
   2 #
   3 #
   4
   5 use strict;
   6 use warnings;
   7 use DB_File;
   8
   9 my ($key, $DB_HOME, $feature_name) = @ARGV;
  10 my $target = "$DB_HOME/system-char-id/$feature_name";
  11 my $value = &getvalue($target, "?$key");
  12 if ($value) {
  13   #print STDERR "value: $value\n"; # for debug
  14   my $result = '';
  15   for $key (&getkeys($target, $value)) {
  16     my $ucs_value = &getvalue("$DB_HOME/system-char-id/=ucs", $key);
  17     if ($ucs_value) {
  18       $key = sprintf "\\x\{%x\}", $ucs_value;
  19       $result .= $key;
  20     }
  21   }
  22   if ($result ne '') {
  23     print STDOUT $result;
  24   } else {
  25     print STDOUT $key;
  26   }
  27 } else {
  28   #print STDERR "no values\n"; # for debug
  29 }
  30
  31 sub getvalue ($$) {
  32   # キーから値を�����り出す
  33   my ($chise_dbname, $key) = @_;
  34   my $value = '';
  35   tie (my %h, "DB_File", $chise_dbname, O_RDWR)
  36     or die "Cannot open file $chise_dbname: $!\n";
  37   $value = $h{$key};
  38   untie %h;
  39   return $value;
  40 }
  41
  42 sub getkeys ($$) {
  43   # 値からキーの配列を�����り出す
  44   my ($chise_dbname, $value) = @_;
  45   tie (my %h, "DB_File", $chise_dbname, O_RDWR, , $DB_BTREE)
  46     or die "Cannot open file $chise_dbname: $!\n";
  47   my @keys = ();
  48   for my $key (keys %h) {
  49     next unless (exists $h{$key});
  50     push @keys, $key if ($h{$key} eq $value);
  51   }
  52   untie %h;
  53   return @keys;
  54 }