--- /dev/null
+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
--- /dev/null
+#!/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;
projects / chise / perl.git / commitdiff