11 use vars qw(%db %chardb
12 %reverse_db %reverse_chardb
13 %er_alias $er_prefix_re
17 our @ISA = qw(Exporter);
19 # Items to export into callers namespace by default. Note: do not export
20 # names by default without a very good reason. Use EXPORT_OK instead.
21 # Do not simply export all your public functions/methods/constants.
23 # This allows declaration use Chise_utils ':all';
24 # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
26 our %EXPORT_TAGS = ( 'all' => [ qw(
28 %reverse_db %reverse_chardb
30 %er_alias $er_prefix_re
41 our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
45 our $VERSION = '0.01';
48 # Preloaded methods go here.
52 if(-e '/usr/local/lib/chise/chise-db'){
53 $DB_HOME='/usr/local/lib/chise/chise-db';
54 }elsif(-e '/usr/lib/chise/chise-db'){
55 $DB_HOME='/usr/lib/chise/chise-db';
56 }elsif(-e '/usr/local/lib/chise/char-db'){
57 $DB_HOME='/usr/local/lib/chise/char-db';
58 }elsif(-e 'd:/work/chise/char-db'){
59 $DB_HOME='d:/work/chise/char-db';
61 print STDERR "No database found.\n";
62 print STDERR "Pleas set \$DB_HOME to Chise_utils.pm.\n";
67 $idc="\x{2ff0}-\x{2fff}";
90 'HZK10','=hanziku-10',
91 'HZK11','=hanziku-11',
92 'HZK12','=hanziku-12',
93 'J78','=jisx0208-1978',
95 'J90','=jisx0208-1990',
103 $er_prefix_re=join '|', keys %er_alias;
105 if(-d "$DB_HOME/character"){
106 for (glob "$DB_HOME/character/feature/*"){
109 $atr=~s!$DB_HOME/character/feature/!!;
112 for (glob "$DB_HOME/character/by_feature/*"){
115 $atr=~s!$DB_HOME/character/by_feature/!!;
116 $reverse_db{$atr}=$_;
118 }elsif(-d "$DB_HOME/system-char-id"){
119 for (glob "$DB_HOME/system-char-id/*"){
122 $atr=~s!$DB_HOME/system-char-id/!!;
125 for (glob "$DB_HOME/*"){
126 next if(/\.txt$/ or /system-char-id/);
129 $reverse_db{$atr}=$_."/system-char-id";
132 print STDERR "No database found.\n";
133 print STDERR "Pleas set \$DB_HOME to Chise_utils.pm correctly.\n";
139 return 1 if(defined(%{$chardb{$atr}}));
140 if(defined($db{$atr}) and -f $db{$atr}){
141 tie %{$chardb{$atr}}, "BerkeleyDB::Hash",
142 -Filename => $db{$atr};
150 return 1 if(defined(%{$reverse_chardb{$atr}}));
151 if(defined($reverse_db{$atr}) and -f $reverse_db{$atr}){
152 tie %{$reverse_chardb{$atr}}, "BerkeleyDB::Hash",
153 -Filename => $reverse_db{$atr};
160 sub get_char_attribute{
162 &get_db($atr) or return "";
163 if($chardb{$atr}->{"?$char"}){
164 return $chardb{$atr}->{"?$char"};
170 sub get_chars_containing{
174 foreach $char (keys %{$chardb{$atr}}){
175 if($chardb{$atr}->{$char}=~/$value/){
184 sub get_chars_matching{
187 if(defined($reverse_db{$atr})){
188 if(&get_reverse_db($atr)){
189 if($char=$reverse_chardb{$atr}->{$value}){
198 # # fall back if DB inconsistency exists.
200 foreach $char (keys %{$chardb{$atr}}){
201 if($chardb{$atr}->{$char} eq $value){
213 my @q=split(",",$query);
214 my(%res,@res,$atr,$value);
218 ($atr,$value)=split("=~",$query,2);
220 foreach (&get_chars_containing($atr,$value)){
223 }elsif($query=~/==/){
224 ($atr,$value)=split(/==/,$query,2);
226 foreach (&get_chars_matching($atr,$value)){
231 return grep {defined($res{$_}) and $res{$_}==$i} (keys %res);
236 my($output_char,$atr,$value);
238 $er=~/^(amp|&)?(.+?)(;)?$/
239 and $prefix=$1,$er=$2,$suffix=$3;
240 $prefix or $prefix="",$suffix or $suffix="";
241 if($prefix eq 'amp'){$prefix="",$suffix="";}
243 $output_char=pack("U",$er);
244 }elsif($er=~/^U[\+\-]([a-fA-F\d]+)/){
245 $output_char=pack("U",hex($1));
246 }elsif($er=~/^(?:I\-)?($er_prefix_re)\-?([0-9a-fA-F]+)$/){
247 ($atr,$value)=($1,$2);
248 if($er_alias{$atr}=~/daikanwa|gt/){
253 ($output_char)=&get_chars_matching($er_alias{$atr},$value);
258 return $prefix.$er.$suffix;
264 my $char_id=unpack("U",$char);
265 if($char_id==0x2ff2 or $char_id==0x2ff3){
267 }elsif($char_id>=0x2ff0 and $char_id<=0x2fff){
274 # Autoload methods go after =cut, and are processed by the autosplit program.
278 # Below is stub documentation for your module. You better edit it!
282 Chise_utils - Perl extension for blah blah blah
291 Stub documentation for Chise_utils, created by h2xs. It looks like the
292 author of the extension was negligent enough to leave the stub
304 A. U. Thor, a.u.thor@a.galaxy.far.far.away