1 ;; sqlite.lisp --- CLISP FFI for SQLite (http://www.sqlite.org).
3 ;; Copyright (C) 2003 Aurelio Bignoli
5 ;; This program is free software; you can redistribute it and/or
6 ;; modify it under the terms of the GNU General Public License as
7 ;; published by the Free Software Foundation; either version 2 of
8 ;; the License, or (at your option) any later version.
10 ;; This program is distributed in the hope that it will be
11 ;; useful, but WITHOUT ANY WARRANTY; without even the implied
12 ;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
13 ;; PURPOSE. See the GNU General Public License for more details.
15 ;; You should have received a copy of the GNU General Public
16 ;; License along with this program; if not, write to the Free
17 ;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
25 (:use :common-lisp :ffi)
30 #:sqlite-error-message
43 #:sqlite-version ; Defined as constant.
44 #:sqlite-encoding ; Defined as constant.
45 #:sqlite-last-insert-rowid
47 ;;; Utility functions (used by CLSQL)
57 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
59 ;;;; Return values for sqlite_exec() and sqlite_step()
61 (defconstant SQLITE-OK 0 "Successful result")
62 (defconstant SQLITE-ERROR 1 "SQL error or missing database")
63 (defconstant SQLITE-INTERNAL 2 "An internal logic error in SQLite")
64 (defconstant SQLITE-PERM 3 "Access permission denied")
65 (defconstant SQLITE-ABORT 4 "Callback routine requested an abort")
66 (defconstant SQLITE-BUSY 5 "The database file is locked")
67 (defconstant SQLITE-LOCKED 6 "A table in the database is locked")
68 (defconstant SQLITE-NOMEM 7 "A malloc() failed")
69 (defconstant SQLITE-READONLY 8 "Attempt to write a readonly database")
70 (defconstant SQLITE-INTERRUPT 9 "Operation terminated by sqlite_interrupt()")
71 (defconstant SQLITE-IOERR 10 "Some kind of disk I/O error occurred")
72 (defconstant SQLITE-CORRUPT 11 "The database disk image is malformed")
73 (defconstant SQLITE-NOTFOUND 12 "(Internal Only) Table or record not found")
74 (defconstant SQLITE-FULL 13 "Insertion failed because database is full")
75 (defconstant SQLITE-CANTOPEN 14 "Unable to open the database file")
76 (defconstant SQLITE-PROTOCOL 15 "Database lock protocol error")
77 (defconstant SQLITE-EMPTY 16 "(Internal Only) Database table is empty")
78 (defconstant SQLITE-SCHEMA 17 "The database schema changed")
79 (defconstant SQLITE-TOOBIG 18 "Too much data for one row of a table")
80 (defconstant SQLITE-CONSTRAINT 19 "Abort due to contraint violation")
81 (defconstant SQLITE-MISMATCH 20 "Data type mismatch")
82 (defconstant SQLITE-MISUSE 21 "Library used incorrectly")
83 (defconstant SQLITE-NOLFS 22 "Uses OS features not supported on host")
84 (defconstant SQLITE-AUTH 23 "Authorization denied")
85 (defconstant SQLITE-FORMAT 24 "Auxiliary database format error")
86 (defconstant SQLITE-ROW 100 "sqlite_step() has another row ready")
87 (defconstant SQLITE-DONE 101 "sqlite_step() has finished executing")
89 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
93 (def-c-type sqlite-db c-pointer)
94 (def-c-type sqlite-vm c-pointer)
95 (def-c-type error-message (c-ptr c-pointer))
96 ; It is not NULL only in case of error.
98 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
102 (define-condition sqlite-error ()
103 ((message :initarg :message :reader sqlite-error-message :initform "")
104 (code :initarg :code :reader sqlite-error-code))
105 (:report (lambda (condition stream)
106 (let ((code (sqlite-error-code condition)))
107 (format stream "SQLite error [~A] - ~A : ~A"
108 code (error-string code)
109 (sqlite-error-message condition))))))
111 (defun signal-sqlite-error (code message)
113 (make-condition 'sqlite-error
118 (t (error-message-as-string message))))))
119 (unless (signal condition)
120 (invoke-debugger condition))))
122 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
124 ;;;; Library functions.
126 (defmacro def-sqlite-call-out (name &rest args)
129 (:library "libsqlite.so")
132 (def-sqlite-call-out error-string
133 (:name "sqlite_error_string")
135 (error-code int :in))
136 (:return-type c-string))
138 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
142 (def-sqlite-call-out %open
143 (:name "sqlite_open")
145 (dbname c-string :in)
147 (errmsg error-message :out))
148 (:return-type sqlite-db))
150 (def-sqlite-call-out sqlite-close
151 (:name "sqlite_close")
152 (:arguments (db sqlite-db :in))
155 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
159 (def-sqlite-call-out %compile
160 (:name "sqlite_compile")
164 (sql-tail (c-ptr c-string) :out)
165 (vm (c-ptr sqlite-vm) :out)
166 (errmsg error-message :out))
169 (def-sqlite-call-out %step
170 (:name "sqlite_step")
173 (cols-n (c-ptr int) :out)
174 (cols (c-ptr c-pointer) :out)
175 (col-names (c-ptr c-pointer) :out))
178 (def-sqlite-call-out %finalize
179 (:name "sqlite_finalize")
182 (errmsg error-message :out))
185 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
189 (def-sqlite-call-out sqlite-last-insert-rowid
190 (:name "sqlite_last_insert_rowid")
195 (def-sqlite-call-out %get-table
196 (:name "sqlite_get_table")
200 (result (c-ptr c-pointer) :out)
201 (n-row (c-ptr int) :out)
202 (n-column (c-ptr int) :out)
203 (errmsg error-message :out))
206 (def-sqlite-call-out %free-table
207 (:name "sqlite_free_table")
209 (rows c-pointer :in))
213 (:name "sqlite_version")
214 (:library "libsqlite.so")
215 (:type (c-array-max char 32))
219 (:name "sqlite_encoding")
220 (:library "libsqlite.so")
221 (:type (c-array-max char 32))
224 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
226 ;;;; Wrapper functions.
228 (defconstant sqlite-version
229 (ext:convert-string-from-bytes %version custom:*terminal-encoding*))
231 (defconstant sqlite-encoding
232 (ext:convert-string-from-bytes %encoding custom:*terminal-encoding*))
234 (defun error-message-as-string (p)
235 (with-c-var (p1 'c-pointer p)
240 (defun sqlite-open (db-name &optional (mode 0))
241 (multiple-value-bind (db error-message)
245 (signal-sqlite-error SQLITE-ERROR error-message))))
247 (defun c-pointer-to-string-array (p element-n)
250 (with-c-var (p1 'c-pointer p)
251 (cast p1 `(c-ptr (c-array c-string ,element-n))))))
253 (defun sqlite-compile (db sql)
254 (multiple-value-bind (result sql-tail vm error-message)
256 (declare (ignore sql-tail))
257 (if (= result SQLITE-OK)
259 (signal-sqlite-error result error-message))))
261 (defun sqlite-step (vm)
262 (multiple-value-bind (result n-col cols col-names)
265 ((= result SQLITE-ROW)
266 (values n-col (c-pointer-to-string-array cols n-col)
267 (c-pointer-to-string-array col-names (* 2 n-col))))
268 ((= result SQLITE-DONE) (values 0 nil nil))
269 (t (signal-sqlite-error result "sqlite-step")))))
271 (defun sqlite-finalize (vm)
272 (multiple-value-bind (result error-message)
274 (if (= result SQLITE-OK)
276 (signal-sqlite-error result error-message))))
278 (defun sqlite-get-table (db sql)
279 (multiple-value-bind (result rows n-row n-col error-message)
281 (if (= result SQLITE-OK)
282 (let ((x (c-pointer-to-string-array rows (* (1+ n-row) n-col))))
284 (values x n-row n-col))
285 (signal-sqlite-error result error-message))))
287 (defmacro with-open-sqlite-db ((db dbname &key (mode 0)) &body body)
288 (let ((error-message (gensym)))
289 `(multiple-value-bind (,db ,error-message)
290 (sqlite-open ,dbname ,mode)
292 (signal-sqlite-error SQLITE-ERROR ,error-message)
295 (sqlite-close ,db))))))
297 (defmacro with-sqlite-vm ((vm db sql) &body body)
298 `(let ((,vm (sqlite-compile ,db ,sql)))
301 (sqlite-finalize ,vm))))
303 (declaim (inline null-row-p))
304 (defun null-row-p (row)
307 (declaim (inline make-null-row))
308 (defun make-null-row ()
312 (defun test-function (db-name)
313 (with-open-sqlite-db (db db-name)
314 (let ((x (sqlite-get-table db "select * from sqlite_master;")))
315 (with-sqlite-vm (vm db "select * from sqlite_master;")
317 (loop for i = 1 then (1+ i)
318 do (multiple-value-bind (n-col cols col-names)
320 (declare (ignore col-names))
323 (loop for j from 0 to (1- n-col)
324 for j1 = (* n-col i) then (1+ j1)
326 (when (string/= (aref x j1) (aref cols j))
327 (format t "~&row=~A, col=~A: ~A - ~A~%"
329 (aref x j1) (aref cols j))
332 (format t "~&Test passed!~%")
333 (format t "~&Test not passed. ~A errors" error-n)))))))
335 (defun get-column-types (db-name table-name)
336 (with-open-sqlite-db (db db-name)
337 (with-sqlite-vm (vm db (format nil "pragma table_info('~A')" table-name))
339 (multiple-value-bind (n-col cols col-names)
341 (declare (ignore col-names))
344 (format t "~&column name = ~A, type = ~A~%"
345 (aref cols 1) (aref cols 2))))))))
347 ;;;; Local Variables:
349 ;;;; Syntax: ANSI-Common-Lisp