From 68f33c220db66e047d2686f4ae87040a50bef2f3 Mon Sep 17 00:00:00 2001 From: imiyazaki Date: Sat, 22 Feb 2003 04:50:13 +0000 Subject: [PATCH] created. --- Chise_utils/Changes | 6 ++ Chise_utils/Chise_utils.pm | 204 ++++++++++++++++++++++++++++++++++++++++++++ Chise_utils/MANIFEST | 5 ++ Chise_utils/Makefile.PL | 8 ++ Chise_utils/sample.pl | 92 ++++++++++++++++++++ Chise_utils/test.pl | 20 +++++ 6 files changed, 335 insertions(+) create mode 100644 Chise_utils/Changes create mode 100644 Chise_utils/Chise_utils.pm create mode 100644 Chise_utils/MANIFEST create mode 100644 Chise_utils/Makefile.PL create mode 100644 Chise_utils/sample.pl create mode 100644 Chise_utils/test.pl 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=< | --map | + --mapfrom | + --mapto | + -q | + --show-attribute | + -h | --help | + -a= | + -aa ] + -q + ex. of + 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 of + -aa get all attributes of +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): + -- 1.7.10.4