Moved functions into chise module. Removed .pl file. Added sample script.

diff --git a/tools/chise.i b/tools/chise.i
index ff6facc..54a1161 100644 (file)
--- a/tools/chise.i
+++ b/tools/chise.i
@@ -1,105 +1,197 @@
-// chise.i\r
-//\r
-// Copyright (C) 2005,2006 KAMICHI Koichi.\r
-//\r
-// reference : http://www.swig.org/Doc1.3/Perl5.html\r
-//             sample.c included to libchise\r
-\r
-%module chise\r
-\r
-%{\r
-#include <concord.h>\r
-#include <chise.h>\r
-%}\r
-\r
-// This tells SWIG to treat char ** as a special case\r
-%typemap(in) char ** {\r
-       AV *tempav;\r
-       I32 len;\r
-       int i;\r
-       SV  **tv;\r
-       if (!SvROK($input))\r
-           croak("Argument $argnum is not a reference.");\r
-        if (SvTYPE(SvRV($input)) != SVt_PVAV)\r
-           croak("Argument $argnum is not an array.");\r
-        tempav = (AV*)SvRV($input);\r
-       len = av_len(tempav);\r
-       $1 = (char **) malloc((len+2)*sizeof(char *));\r
-       for (i = 0; i <= len; i++) {\r
-           tv = av_fetch(tempav, i, 0);        \r
-           $1[i] = (char *) SvPV(*tv,PL_na);\r
-        }\r
-       $1[i] = NULL;\r
-};\r
-\r
-// This cleans up the char ** array after the function call\r
-%typemap(freearg) char ** {\r
-       free($1);\r
-}\r
-\r
-// Creates a new Perl array and places a NULL-terminated char ** into it\r
-%typemap(out) char ** {\r
-       AV *myav;\r
-       SV **svs;\r
-       int i = 0,len = 0;\r
-       /* Figure out how many elements we have */\r
-       while ($1[len])\r
-          len++;\r
-       svs = (SV **) malloc(len*sizeof(SV *));\r
-       for (i = 0; i < len ; i++) {\r
-           svs[i] = sv_newmortal();\r
-           sv_setpv((SV*)svs[i],$1[i]);\r
-       };\r
-       myav =  av_make(len,svs);\r
-       free(svs);\r
-        $result = newRV((SV*)myav);\r
-        sv_2mortal($result);\r
-        argvi++;\r
-}\r
-\r
-%include concord.h\r
-%include chise.h\r
-\r
-%inline %{\r
-\r
-#include <concord.h>\r
-#include <chise.h>\r
-\r
-unsigned char *get_uchar(char *argv){\r
-  return (unsigned char *)argv;\r
-}\r
-\r
-char *get_char(unsigned char *argv){\r
-  return (char *)argv;\r
-}\r
-\r
-unsigned char buffer[1024];\r
-int buffer_size = 1024;\r
-\r
-void clear_buffer(){\r
-  int i;\r
-  for(i = 0; i < buffer_size; i++){\r
-    buffer[i] = 0;\r
-  }\r
-}\r
-\r
-unsigned char feature[102400];\r
-int feature_size = 102400;\r
-\r
-static int\r
-name_map_func (CHISE_DS *ds, unsigned char *name)\r
-{\r
-  strcat((char *)feature, (char *)name);\r
-  strcat((char *)feature, (char *)"\n");\r
-  return 0;\r
-}\r
-\r
-void listup_feature(CHISE_DS *ds){\r
-  int i;\r
-  for(i = 0; i < feature_size; i++){\r
-    feature[i] = 0;\r
-  }\r
-  chise_ds_foreach_char_feature_name (ds, &name_map_func);\r
-}\r
-\r
-%}\r
+// chise.i
+//
+// Copyright (C) 2005,2006 KAMICHI Koichi.
+//
+// reference : http://www.swig.org/Doc1.3/Perl5.html
+//             sample.c included to libchise
+
+%module chise
+
+%{
+#include <concord.h>
+#include <chise.h>
+%}
+
+%include concord.h
+%include chise.h
+
+%inline %{
+
+#include <concord.h>
+#include <chise.h>
+
+unsigned char *get_uchar(char *argv){
+  return (unsigned char *)argv;
+}
+
+char *get_char(unsigned char *argv){
+  return (char *)argv;
+}
+
+unsigned char *feature;
+int feature_size = 102400;
+unsigned char *buffer;
+int buffer_size = 1024;
+
+void clear_buffer(){
+  int i;
+  for(i = 0; i < buffer_size; i++){
+    buffer[i] = 0;
+  }
+}
+
+void allocate_buffer(){
+  feature = (unsigned char *)malloc(feature_size * sizeof(unsigned char));
+  buffer = (unsigned char *)malloc(buffer_size * sizeof(unsigned char));
+}
+void free_buffer(){
+  free(feature);
+  free(buffer);
+}
+
+static int
+name_map_func (CHISE_DS *ds, unsigned char *name)
+{
+  strcat((char *)feature, (char *)name);
+  strcat((char *)feature, (char *)"\n");
+  return 0;
+}
+void listup_feature(CHISE_DS *ds){
+  int i;
+  for(i = 0; i < feature_size; i++){
+    feature[i] = 0;
+  }
+  chise_ds_foreach_char_feature_name (ds, &name_map_func);
+}
+
+%}
+
+%perlcode %{
+sub new{
+  my $class = shift;
+  chise::allocate_buffer();
+  my $chise_ds = chise::CHISE_DS_open($chise::CHISE_DS_Berkeley_DB,
+                                      $chise::chise_system_db_dir,
+                                      0,
+                                      0755);
+  chise::listup_feature($chise_ds);
+  my @chise_feature = split(/\n/, chise::get_char($chise::feature));
+  my $chise_newid = -1;
+  return bless {
+    chise_ds => $chise_ds,
+    chise_feature => \@chise_feature,
+    chise_newid => $chise_newid}, $class;
+}
+sub DESTROY{
+  my $self = shift;
+  chise::free_buffer();
+  if(define($self->{chise_ds})){ # Strange to say, chise_ds has already unavailable
+    chise::CHISE_DS_close($self->{chise_ds});
+  }
+}
+sub get_feature_list{ # original
+  my $self = shift;
+  my $hash = $self->{chise_feature};
+  return @$hash;
+}
+sub ds_get_ccs{
+  my $self = shift;
+  return chise::chise_ds_get_ccs($self->{chise_ds},
+                                 chise::get_uchar($_[0]));
+}
+sub ds_get_feature{
+  my $self = shift;
+  return chise::chise_ds_get_feature($self->{chise_ds},
+                                     chise::get_uchar($_[0]));
+}
+sub ds_get_property{
+  my $self = shift;
+  return chise::chise_ds_get_property($self->{chise_ds},
+                                      chise::get_uchar($_[0]));
+}
+sub ds_decode_char{
+  my $self = shift;
+  return chise::chise_ds_decode_char($self->{chise_ds},
+                                     chise::get_uchar($_[0]),
+                                     $_[1]);
+}
+sub ccs_decode{
+  my $self = shift;
+  return chise::chise_ccs_decode($_[0],
+                                 $_[1]);
+}
+sub feature_gets_property_value{ # use feature/property strings directly
+  my $self = shift;
+  chise::clear_buffer();
+  chise::chise_feature_gets_property_value($self->ds_get_feature($_[0]),
+                                           $self->ds_get_property($_[1]),
+                                           $chise::buffer,
+                                           $chise::buffer_size);
+  return chise::get_char($chise::buffer);
+}
+sub feature_gets_property_value_by_handle{
+  my $self = shift;
+  chise::clear_buffer();
+  chise::chise_feature_gets_property_value($_[0],
+                                           $_[1],
+                                           $chise::buffer,
+                                           $chise::buffer_size);
+  return chise::get_char($chise::buffer);
+}
+sub char_gets_feature_value{ # use feature string directly
+  my $self = shift;
+  chise::clear_buffer();
+  chise::chise_char_gets_feature_value($_[0],
+                                       $self->ds_get_feature($_[1]),
+                                       $chise::buffer,
+                                       $chise::buffer_size);
+  return chise::get_char($chise::buffer);
+}
+sub char_gets_feature_value_by_handle{
+  my $self = shift;
+  chise::clear_buffer();
+  chise::chise_char_gets_feature_value($_[0],
+                                       $_[1],
+                                       $chise::buffer,
+                                       $chise::buffer_size);
+  return chise::get_char($chise::buffer);
+}
+sub system_db_dir{
+  my $self = shift;
+  return chise::get_char($chise::chise_system_db_dir);
+}
+sub db_dir{
+  my $self = shift;
+  return chise::get_char($chise::chise_db_dir);
+}
+sub db_format_version{
+  my $self = shift;
+  return chise::get_char($chise::chise_db_format_version);
+}
+sub ds_location{
+  my $self = shift;
+  return chise::get_char(chise::chise_ds_location($self->{chise_ds}));
+}
+sub get_newid{ # original : search new char_id and update $chise_newid
+  my $self = shift;
+  if($self->{chise_newid} < 0){
+    $self->{chise_newid} = 0x0F0000;
+    my @feature = $self->get_feature_list();
+    while(1){
+      my $found = 0;
+      foreach(@feature){
+        if($self->char_gets_feature_value($self->{chise_newid}, $_) ne ""){
+          $found = 1;
+          last;
+        }
+      }
+      if($found == 0){
+        last;
+      }
+      $self->{chise_newid}++;
+    }
+  }
+  return $self->{chise_newid};
+}
+
+%}

diff --git a/tools/sample.pl b/tools/sample.pl
new file mode 100755 (executable)
index 0000000..f6a07aa
--- /dev/null
+++ b/tools/sample.pl
@@ -0,0 +1,33 @@
+use chise;
+
+$chise = new chise;
+
+@feature = $chise->get_feature_list();
+print join("\n", @feature)."\n";
+
+print $chise->db_format_version()."\n";
+print $chise->db_dir()."\n";
+print $chise->ds_location()."\n";
+print $chise->system_db_dir()."\n";
+
+print $chise->char_gets_feature_value(0x5555, "ideographic-structure")."\n";
+printf "%x\n", $chise->ds_decode_char("=daikanwa", 8);
+printf "%x\n", $chise->char_gets_feature_value($chise->ds_decode_char("=gt-k", 1873), "=gt-pj-k2");
+
+print $chise->feature_gets_property_value("=daikanwa", "description")."\n";
+print $chise->feature_gets_property_value('=ucs@JP', "mother")."\n";
+
+printf "%x\n", $chise->get_newid();
+
+#&set_feature_value('glyph@kage', 0x4e00, "abcdefghijkl");
+#&set_feature_value('glyph@kage', 0x4e00);
+
+#print &get_feature_value('glyph@kage', 0x4e00)."\n";
+#print &get_feature_value('glyph@kage', 0x4e01)."\n";
+
+#print &create_new_char('glyph@kage', "aaaaaaaaaaaaaaaaaaaaaaaa")."\n";
+
+#print &get_feature_value('glyph@kage', 987587)."\n";
+
+#&update_chise;
+