11 use vars qw(%db %chardb %db_opened
12 %reverse_db %reverse_chardb %rdb_opened
13 %er_alias $er_prefix_re
18 our @ISA = qw(Exporter);
20 # Items to export into callers namespace by default. Note: do not export
21 # names by default without a very good reason. Use EXPORT_OK instead.
22 # Do not simply export all your public functions/methods/constants.
24 # This allows declaration use Chise_utils ':all';
25 # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
27 our %EXPORT_TAGS = ( 'all' => [ qw(
29 %reverse_db %reverse_chardb
31 %er_alias $er_prefix_re
43 our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
47 our $VERSION = '0.02';
50 # Preloaded methods go here.
53 unless($omegadb_path){
54 if(-w '/usr/local/share/chise/omega'){
55 $omegadb_path='/usr/local/share/chise/omega';
56 }elsif(-w '/usr/share/chise/omega'){
57 $omegadb_path='/usr/share/chise/omega';
58 }elsif(-w '/sw/share/chise/omega'){
59 $omegadb_path='/sw/share/chise/omega';
60 }elsif(-w '/usr/local/lib/chise/omega'){
61 $omegadb_path='/usr/local/lib/chise/omega';
69 if(-e '/usr/local/share/chise/0.3/db'){
70 $DB_HOME='/usr/local/share/chise/0.3/db';
71 }elsif(-e '/usr/share/chise/0.3/db'){
72 $DB_HOME='/usr/share/chise/0.3/db';
73 }elsif(-e '/sw/share/chise/0.3/db'){
74 $DB_HOME='/sw/share/chise/0.3/db';
75 }elsif(-e '/usr/local/lib/chise/chise-db'){
76 $DB_HOME='/usr/local/lib/chise/chise-db';
77 }elsif(-e '/usr/lib/chise/chise-db'){
78 $DB_HOME='/usr/lib/chise/chise-db';
79 }elsif(-e '/usr/local/lib/chise/char-db'){
80 $DB_HOME='/usr/local/lib/chise/char-db';
81 }elsif(-e 'd:/work/chise/char-db'){
82 $DB_HOME='d:/work/chise/char-db';
84 print STDERR "No database found.\n";
85 print STDERR "Pleas set \$DB_HOME to Chise_utils.pm.\n";
90 $idc="\x{2ff0}-\x{2fff}";
113 'HZK10','=hanziku-10',
114 'HZK11','=hanziku-11',
115 'HZK12','=hanziku-12',
116 'J78','=jisx0208-1978',
118 'J90','=jisx0208-1990',
126 $er_prefix_re=join '|', keys %er_alias;
128 if(-d "$DB_HOME/character"){
129 for (glob "$DB_HOME/character/feature/*"){
132 $atr=~s!$DB_HOME/character/feature/!!;
135 for (glob "$DB_HOME/character/by_feature/*"){
138 $atr=~s!$DB_HOME/character/by_feature/!!;
139 $reverse_db{$atr}=$_;
141 }elsif(-d "$DB_HOME/system-char-id"){
142 for (glob "$DB_HOME/system-char-id/*"){
145 $atr=~s!$DB_HOME/system-char-id/!!;
148 for (glob "$DB_HOME/*"){
149 next if(/\.txt$/ or /system-char-id/);
152 $reverse_db{$atr}=$_."/system-char-id";
155 print STDERR "No database found.\n";
156 print STDERR "Pleas set \$DB_HOME to Chise_utils.pm correctly.\n";
162 return 1 if($db_opened{$atr});
163 if(defined($db{$atr}) and -f $db{$atr}){
164 if(tie %{$chardb{$atr}}, 'BerkeleyDB::Hash',
165 -Filename => $db{$atr},
166 -Flags => DB_RDONLY){
178 return 1 if($rdb_opened{$atr});
179 if(defined($reverse_db{$atr}) and -f $reverse_db{$atr}){
180 if(tie %{$reverse_chardb{$atr}}, "BerkeleyDB::Hash",
181 -Filename => $reverse_db{$atr},
182 -Flags => DB_RDONLY){
193 sub get_char_attribute{
196 unless($db_opened{$atr}){
197 &get_db($atr) or return "";
199 if($res=$chardb{$atr}->{"?$char"}){
207 sub get_chars_containing{
210 unless($db_opened{$atr}){
211 &get_db($atr) or return ();
213 utf8::encode($value);
214 foreach $char (keys %{$chardb{$atr}}){
215 if($chardb{$atr}->{$char}=~/$value/){
224 sub get_chars_matching{
227 if(defined($reverse_db{$atr})){
228 unless($rdb_opened{$atr}){
229 &get_reverse_db($atr) or return ();
231 utf8::encode($value);
232 if($char=$reverse_chardb{$atr}->{$value}){
241 # # fall back if DB inconsistency exists.
242 unless($db_opened{$atr}){
243 &get_db($atr) or return ();
245 foreach $char (keys %{$chardb{$atr}}){
246 if($chardb{$atr}->{$char} eq $value){
258 my @q=split(",",$query);
259 my(%res,@res,$atr,$value);
263 ($atr,$value)=split("=~",$query,2);
265 foreach (&get_chars_containing($atr,$value)){
268 }elsif($query=~/==/){
269 ($atr,$value)=split(/==/,$query,2);
271 foreach (&get_chars_matching($atr,$value)){
276 return grep {defined($res{$_}) and $res{$_}==$i} (keys %res);
281 my($output_char,$atr,$value);
283 $er=~/^(amp|&)?(.+?)(;)?$/
284 and $prefix=$1,$er=$2,$suffix=$3;
285 $prefix or $prefix="",$suffix or $suffix="";
286 if($prefix eq 'amp'){$prefix="",$suffix="";}
288 $output_char=pack("U",$er);
289 }elsif($er=~/^U[\+\-]([a-fA-F\d]+)/){
290 $output_char=pack("U",hex($1));
291 }elsif($er=~/^(?:I\-)?($er_prefix_re)\-?([0-9a-fA-F]+)$/){
292 ($atr,$value)=($1,$2);
293 if($er_alias{$atr}=~/daikanwa|gt/){
298 ($output_char)=&get_chars_matching($er_alias{$atr},$value);
303 return $prefix.$er.$suffix;
309 my $char_id=unpack("U",$char);
310 if($char_id==0x2ff2 or $char_id==0x2ff3){
312 }elsif($char_id>=0x2ff0 and $char_id<=0x2fff){
319 # Autoload methods go after =cut, and are processed by the autosplit program.
323 # Below is stub documentation for your module. You better edit it!
327 Chise_utils - Perl extension for blah blah blah
336 Stub documentation for Chise_utils, created by h2xs. It looks like the
337 author of the extension was negligent enough to leave the stub
349 A. U. Thor, a.u.thor@a.galaxy.far.far.away