From: imiyazaki <imiyazaki>
Date: Sat, 22 Feb 2003 04:50:13 +0000 (+0000)
Subject: created.
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=68f33c220db66e047d2686f4ae87040a50bef2f3;p=chise%2Fperl.git

created.
---

diff --git a/Chise_utils/Changes b/Chise_utils/Changes
new file mode 100644
index 0000000..51567b1
--- /dev/null
+++ b/Chise_utils/Changes
@@ -0,0 +1,6 @@
+Revision history for Perl extension Chise_utils.
+
+0.01  Sat Feb 22 00:30:24 2003
+	- original version; created by h2xs 1.2 with options
+		-X Chise_utils
+
diff --git a/Chise_utils/Chise_utils.pm b/Chise_utils/Chise_utils.pm
new file mode 100644
index 0000000..3338922
--- /dev/null
+++ b/Chise_utils/Chise_utils.pm
@@ -0,0 +1,204 @@
+package Chise_utils;
+
+require 5.005;
+use strict;
+use warnings;
+
+require Exporter;
+
+use utf8;
+use BerkeleyDB;
+use vars qw(%db %chardb $atr
+	);
+
+our @ISA = qw(Exporter);
+
+# Items to export into callers namespace by default. Note: do not export
+# names by default without a very good reason. Use EXPORT_OK instead.
+# Do not simply export all your public functions/methods/constants.
+
+# This allows declaration	use Chise_utils ':all';
+# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
+# will save memory.
+our %EXPORT_TAGS = ( 'all' => [ qw(
+				   %db %chardb
+				   &get_char_attribute
+				   &get_chars_matching
+				   &get_chars_containing
+				   &get_chars_matching
+				   &get_chars_for
+				   &de_er
+) ] );
+
+our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
+
+our @EXPORT = qw(
+);
+our $VERSION = '0.01';
+
+
+# Preloaded methods go here.
+
+my $DB_HOME="";
+if(-e '/usr/local/lib/xemacs-21.4.10/i686-pc-linux/char-db/system-char-id'){
+    $DB_HOME='/usr/local/lib/xemacs-21.4.10/i686-pc-linux/char-db/system-char-id';
+}elsif(-e 'd:/work/chise/char-db/system-char-id'){
+    $DB_HOME='d:/work/chise/char-db/system-char-id';
+}elsif(-e '/usr/local/lib/xemacs-21.4.10/powerpc-apple-darwin6.4/char-db/system-char-id'){
+    $DB_HOME='/usr/local/lib/xemacs-21.4.10/powerpc-apple-darwin6.4/char-db/system-char-id';
+}elsif(-e '/usr/local/xemacs-utf2000/lib/xemacs-21.4.10/powerpc-apple-darwin6.4/char-db/system-char-id'){
+    $DB_HOME='/usr/local/xemacs-utf2000/lib/xemacs-21.4.10/powerpc-apple-darwin6.4/char-db/system-char-id';
+}else{
+    print STDERR "No database found.\n";
+    print STDERR "Pleas set \$DB_HOME to Chise_utils.pm.\n";
+    exit 1;
+}
+
+for (<$DB_HOME/*>){
+    next if(/\.txt$/);
+    $atr=$_;
+    $atr=~s!$DB_HOME/!!;
+    $db{$atr}=$_;
+}
+
+foreach $atr (keys %db){
+    if(defined($db{$atr}) and -f $db{$atr}){
+	tie %{$chardb{$atr}}, "BerkeleyDB::Hash",
+	-Filename => $db{$atr};
+    }else{
+	print STDERR "no target\n";
+	exit 1;
+    }
+}
+
+
+sub get_char_attribute{
+    my($char,$atr)=@_;
+    if($chardb{$atr}->{"?$char"}){
+	return $chardb{$atr}->{"?$char"};
+    }else{
+	return "no attribute for $char";
+    }
+}
+
+sub get_chars_containing{
+    my($atr,$value)=@_;
+    my($char,@res);
+    if(defined(%{$chardb{$atr}})){
+	foreach $char (keys %{$chardb{$atr}}){
+	    if($chardb{$atr}->{$char}=~/$value/){
+		push @res,$char;
+	    }
+	}
+    }
+    return @res;
+}
+
+sub get_chars_matching{
+    my($atr,$value)=@_;
+    my($char,@res);
+    if(defined(%{$chardb{$atr}})){
+	foreach $char (keys %{$chardb{$atr}}){
+	    if($chardb{$atr}->{$char}=~/^$value$/){
+		push @res,$char;
+	    }
+	}
+    }
+    return @res;
+}
+
+sub get_chars_for{
+    my($query)=@_;
+    my @q=split(",",$query);
+    my(%res,@res,$atr,$value);
+    my $i=0;
+    foreach $query (@q){
+	if($query=~/==/){
+	    ($atr,$value)=split("==",$query,2);
+	    $i++;
+	    foreach (&get_chars_matching($atr,$value)){
+		$res{$_}++;
+	    }
+	}elsif($query=~/=~/){
+	    ($atr,$value)=split("=~",$query,2);
+	    $i++;
+	    foreach (&get_chars_containing($atr,$value)){
+		$res{$_}++;
+	    }
+	}
+    }
+    foreach (keys %res){
+	if($res{$_}==$i){
+	    push @res,$_;
+	}
+    }
+    return @res;
+}
+
+sub de_er{
+    my($char)=@_;
+    if($char=~/^\d+$/){
+	$char=pack("U",$char);
+    }elsif($char=~/U[\+\-](\d+)/){
+	$char=pack("U",$1);
+    }elsif($char=~m/CDP\-(\d+)/){
+	# chinese-big5-cdp	CDP- 4 X),
+	# ideograph-daikanwa	M-   5 d),
+	# ideograph-cbeta	CB   5 d),
+	# ideograph-gt		GT-  5 d),
+	# ideograph-gt-k	GT-K 5 d),
+	# japanese-jisx0208-1990 J90- 4 X),
+	# japanese-jisx0208	J83- 4 X),
+	# japanese-jisx0213-1	JX1- 4 X),
+	# japanese-jisx0213-2	JX2- 4 X),
+	# japanese-jisx0212	JSP- 4 X),
+	# japanese-jisx0208-1978 J78- 4 X),
+	# chinese-cns11643-1	C1-  4 X),
+	# chinese-cns11643-2	C2-  4 X),
+	# chinese-cns11643-3	C3-  4 X),
+	# chinese-cns11643-4	C4-  4 X),
+	# chinese-cns11643-5	C5-  4 X),
+	# chinese-cns11643-6	C6-  4 X),
+	# chinese-cns11643-7	C7-  4 X),
+	# korean-ksc5601	K0- 4 X),
+    }
+    return $char;
+}
+
+# Autoload methods go after =cut, and are processed by the autosplit program.
+
+1;
+__END__
+# Below is stub documentation for your module. You better edit it!
+
+=head1 NAME
+
+Chise_utils - Perl extension for blah blah blah
+
+=head1 SYNOPSIS
+
+  use Chise_utils;
+  blah blah blah
+
+=head1 DESCRIPTION
+
+Stub documentation for Chise_utils, created by h2xs. It looks like the
+author of the extension was negligent enough to leave the stub
+unedited.
+
+Blah blah blah.
+
+=head2 EXPORT
+
+None by default.
+
+
+=head1 AUTHOR
+
+A. U. Thor, a.u.thor@a.galaxy.far.far.away
+
+=head1 SEE ALSO
+
+perl(1).
+
+=cut
diff --git a/Chise_utils/MANIFEST b/Chise_utils/MANIFEST
new file mode 100644
index 0000000..c6496cc
--- /dev/null
+++ b/Chise_utils/MANIFEST
@@ -0,0 +1,5 @@
+Changes
+Chise_utils.pm
+MANIFEST
+Makefile.PL
+test.pl
diff --git a/Chise_utils/Makefile.PL b/Chise_utils/Makefile.PL
new file mode 100644
index 0000000..6f484a4
--- /dev/null
+++ b/Chise_utils/Makefile.PL
@@ -0,0 +1,8 @@
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+    'NAME'		=> 'Chise_utils',
+    'VERSION_FROM'	=> 'Chise_utils.pm', # finds $VERSION
+    'PREREQ_PM'		=> {}, # e.g., Module::Name => 1.1
+);
diff --git a/Chise_utils/sample.pl b/Chise_utils/sample.pl
new file mode 100644
index 0000000..27d5cf5
--- /dev/null
+++ b/Chise_utils/sample.pl
@@ -0,0 +1,92 @@
+#!/usr/bin/perl -w
+
+use Getopt::Long;  
+use strict;
+use vars qw($atr $value $char
+	    $opt_map $opt_mapfrom $opt_mapto
+	    $opt_atr $opt_allatr $opt_showatr
+	    $opt_query
+	    $opt_help
+	    );
+use Chise_utils ':all';
+
+my $usage=<<EOF;
+Usage: perl $0 [-m <map> | --map <map> |
+		--mapfrom <map> |
+		--mapto <map> |
+                -q <expression> |
+		--show-attribute |
+                -h | --help |
+		-a=<atribuite> <char> |
+		-aa <char>]
+    -q  <expression>
+      ex. of <expression>
+         total-strokes==8 means
+           the attribute of total-strokes exactly matches to 8.
+         ids-parts=~矢 means
+           the attribute of ids-parts contains the string 矢.
+         total-strokes==8,ids-parts=~矢 means both at the same time.
+    -a  get <attribute> of <char>
+    -aa get all attributes of <char>
+EOF
+
+&GetOptions("mapto=s"=>\$opt_mapto,
+	    "mapfrom=s"=>\$opt_mapfrom,
+	    "m=s"=>\$opt_map,
+	    "a=s"=>\$opt_atr,
+	    "aa"=>\$opt_allatr,
+	    "show-attribute"=>\$opt_showatr,
+	    "q"=>\$opt_query,
+	    "help",\$opt_help,
+	    "h",\$opt_help);
+
+if($opt_help
+   or !((($opt_map or $opt_mapfrom or $opt_mapto) and @ARGV==0)
+	or($opt_showatr and @ARGV==0)
+	or @ARGV==1
+	)
+   ){
+    print $usage;
+    exit 1;
+}else{
+    $char=shift or $char="";
+}
+
+if($opt_mapfrom){
+    $opt_map="<=".$opt_mapfrom;
+}elsif($opt_mapto){
+    $opt_map="=>".$opt_mapto;
+}
+
+if($opt_map){
+    if(defined(%{$chardb{$opt_map}})){
+	foreach $char (sort keys %{$chardb{$opt_map}}){
+	    if($chardb{$opt_map}->{$char}){
+		print $char,"\t",$chardb{$opt_map}->{$char},"\n";
+	    }
+	}
+    }else{
+	print STDERR "No map for $opt_map.\n";
+    }
+}elsif($opt_allatr){
+    $char=&de_er($char) if($char=~/\d/);
+    print $char,"\n";
+    foreach $atr (sort keys %db){
+	if($chardb{$atr}->{"?$char"}){
+	    print "  ",$atr,":",$chardb{$atr}->{"?$char"},"\n";
+	}
+    }
+}elsif($opt_atr){
+    $char=&de_er($char) if($char=~/\d/);
+    print $char,"\n";
+    print "  ",$opt_atr,":",&get_char_attribute($char,$opt_atr),"\n";
+}elsif($opt_showatr){
+    foreach $atr (sort keys %db){
+	print $atr,"\n";
+    }
+}elsif($opt_query){
+    my $query=$char;
+    print join "\n",&get_chars_for($query),"\n";
+}
+
+exit 0;
diff --git a/Chise_utils/test.pl b/Chise_utils/test.pl
new file mode 100644
index 0000000..6cb7b3a
--- /dev/null
+++ b/Chise_utils/test.pl
@@ -0,0 +1,20 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+# Change 1..1 below to 1..last_test_to_print .
+# (It may become useful if the test is moved to ./t subdirectory.)
+
+BEGIN { $| = 1; print "1..1\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Chise_utils;
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+# Insert your test code below (better if it prints "ok 13"
+# (correspondingly "not ok 13") depending on the success of chunk 13
+# of the test code):
+