« RDBMS の制約の使い方 | トップページ | 中国の「ソースコード強制開示」 »

2009年4月26日 (日)

xyzzy から sqlite を使う

一応できたわけですが。

(setq test-home "\path\to\test")
=>"\path\to\test"
(setq test-db (merge-pathnames "test.db" test-home))
=>"\path\to\test\test.db"
(sqlite3 test-db "select date('now')")
date('now') = 2009-04-26
=>0
(sqlite3 test-db "create table tbl1(one varchar(10), two smallint);")
=>0
(sqlite3 test-db "insert into tbl1 values('hello!',10);")
=>0
(sqlite3 test-db "insert into tbl1 values('goodbye', 20);")
=>0
(sqlite3 test-db "select * from tbl1;")
one = hello!
two = 10
one = goodbye
two = 20
=>0

色々と危険なコードになってしまいました。良い子はまねしちゃいけませんね。

やっぱり、 C 言語でヘルパーを作るべきか。

(require "foreign")

(c:*define-c-type c:u_int c-pointer)

(c:*define-dll-entry
  (c:void *) memcpy ((c:void *) (c:void *) c:u_int)
  "msvcrt.dll" "memcpy")

(c:*define-dll-entry
  c:int sqlite3-open ((char *) ((c:void *) *))
  "sqlite3.dll" "sqlite3_open")

(c:*define-dll-entry
  (char *) sqlite3-errmsg ((c:void *))
  "sqlite3.dll" "sqlite3_errmsg")

(c:*define-dll-entry
  c:int sqlite3-close ((c:void *))
  "sqlite3.dll" "sqlite3_close")

;; int sqlite3_exec(
;;   sqlite3*,                                  /* An open database */
;;   const char *sql,                           /* SQL to be evaluated */
;;   int (*callback)(void*,int,char**,char**),  /* Callback function */
;;   void *,                                    /* 1st argument to callback */
;;   char **errmsg                              /* Error msg written here */
;; );
(c:*define-dll-entry
  c:int sqlite3-exec
  ((c:void *) (char *) (c:void *) (c:void *) ((c:void *) *))
  "sqlite3.dll" "sqlite3_exec")

(c:*define-dll-entry
  c:void sqlite3-free ((c:void *))
  "sqlite3.dll" "sqlite3_free")

(defconstant c-pointer-size 4)
(defconstant msg-size 256)

(defun make-c-pointer ()
  (si:make-chunk nil c-pointer-size))

(defun unpack-c-pointer (pp)
  (si:unpack-uint32 pp 0))

(defun get-c-argv (arg-pos argv)
  (let* ((v** (make-c-pointer))
         (rc (memcpy v**
                     (+ argv (* arg-pos c-pointer-size))
                     c-pointer-size)))
    (let* ((v* (si:make-chunk nil msg-size))
           (rc (memcpy v* (unpack-c-pointer v**) msg-size))
           (v (si:unpack-string v* 0 msg-size)))
      v
      )))

(c:*defun-c-callable
  c:int callback
  (((c:void *) NotUsed)
   (c:int argc)
   (((char *) *) argv)
   (((char *) *) azColName))
  (let ((rc 0))
    (handler-case
        (do ((i 0 (+ i 1)))
            ((>= i argc))
          (let ((colname (get-c-argv i azColName))
                (colv (get-c-argv i argv)))
            (format t "~A = ~A~%" colname colv)))
      (error (c)
        (format t "~A~%" (si:*condition-string c))))
    rc))

(defun sqlite3 (fname sql)
  (let* ((fname* (si:make-string-chunk fname))
         (db* (make-c-pointer))
         (rc (sqlite3-open fname* db*))
         (db (unpack-c-pointer db*)))
    (if (not (eql rc 0))
        (let* ((errmsg** (sqlite3-errmsg db))
               (errmsg* (si:make-chunk nil msg-size))
               (rc (memcpy errmsg* errmsg** msg-size))
               (errmsg (si:unpack-string errmsg* 0 msg-size)))
          (format t "Can't open database: ~A~%" errmsg)
          (let ((rc (sqlite3-close db)))
            rc))
      (let* ((sql* (si:make-string-chunk sql))
             (errmsg** (make-c-pointer))
             (rc (sqlite3-exec db sql* #'callback 0 errmsg**)))
        (if (not (eql rc 0))
            (progn
              (format t "Error: ~A~%" rc)
              (let* ((errmsg* (si:make-chunk nil msg-size))
                     (rc (memcpy errmsg* (unpack-c-pointer errmsg**) msg-size))
                     (errmsg (si:unpack-string errmsg* 0 msg-size)))
                (format t "~A~%" errmsg))
              (sqlite3-free (unpack-c-pointer errmsg**))
              (let ((rc (sqlite3-close db)))
                rc))
          (let ((rc (sqlite3-close db)))
            rc)
          )))))

|

« RDBMS の制約の使い方 | トップページ | 中国の「ソースコード強制開示」 »

コメント

コメントを書く



(ウェブ上には掲載しません)


コメントは記事投稿者が公開するまで表示されません。



トラックバック

この記事のトラックバックURL:
http://app.f.cocolog-nifty.com/t/trackback/80472/29307703

この記事へのトラックバック一覧です: xyzzy から sqlite を使う:

« RDBMS の制約の使い方 | トップページ | 中国の「ソースコード強制開示」 »