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,
22 (in-package #:cl-user)
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)
55 ;;; Compatibility with clsql-sql-uffi.lisp
64 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
66 ;;;; Return values for sqlite_exec() and sqlite_step()
68 (defconstant SQLITE-OK 0 "Successful result")
69 (defconstant SQLITE-ERROR 1 "SQL error or missing database")
70 (defconstant SQLITE-INTERNAL 2 "An internal logic error in SQLite")
71 (defconstant SQLITE-PERM 3 "Access permission denied")
72 (defconstant SQLITE-ABORT 4 "Callback routine requested an abort")
73 (defconstant SQLITE-BUSY 5 "The database file is locked")
74 (defconstant SQLITE-LOCKED 6 "A table in the database is locked")
75 (defconstant SQLITE-NOMEM 7 "A malloc() failed")
76 (defconstant SQLITE-READONLY 8 "Attempt to write a readonly database")
77 (defconstant SQLITE-INTERRUPT 9 "Operation terminated by sqlite_interrupt()")
78 (defconstant SQLITE-IOERR 10 "Some kind of disk I/O error occurred")
79 (defconstant SQLITE-CORRUPT 11 "The database disk image is malformed")
80 (defconstant SQLITE-NOTFOUND 12 "(Internal Only) Table or record not found")
81 (defconstant SQLITE-FULL 13 "Insertion failed because database is full")
82 (defconstant SQLITE-CANTOPEN 14 "Unable to open the database file")
83 (defconstant SQLITE-PROTOCOL 15 "Database lock protocol error")
84 (defconstant SQLITE-EMPTY 16 "(Internal Only) Database table is empty")
85 (defconstant SQLITE-SCHEMA 17 "The database schema changed")
86 (defconstant SQLITE-TOOBIG 18 "Too much data for one row of a table")
87 (defconstant SQLITE-CONSTRAINT 19 "Abort due to contraint violation")
88 (defconstant SQLITE-MISMATCH 20 "Data type mismatch")
89 (defconstant SQLITE-MISUSE 21 "Library used incorrectly")
90 (defconstant SQLITE-NOLFS 22 "Uses OS features not supported on host")
91 (defconstant SQLITE-AUTH 23 "Authorization denied")
92 (defconstant SQLITE-FORMAT 24 "Auxiliary database format error")
93 (defconstant SQLITE-ROW 100 "sqlite_step() has another row ready")
94 (defconstant SQLITE-DONE 101 "sqlite_step() has finished executing")
96 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
100 (def-c-type sqlite-db c-pointer)
101 (def-c-type sqlite-vm c-pointer)
102 (def-c-type error-message (c-ptr c-pointer))
103 ; It is not NULL only in case of error.
105 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
109 (define-condition sqlite-error ()
110 ((message :initarg :message :reader sqlite-error-message :initform "")
111 (code :initarg :code :reader sqlite-error-code))
112 (:report (lambda (condition stream)
113 (let ((code (sqlite-error-code condition)))
114 (format stream "SQLite error [~A] - ~A : ~A"
115 code (error-string code)
116 (sqlite-error-message condition))))))
118 (defun signal-sqlite-error (code message)
120 (make-condition 'sqlite-error
125 (t (error-message-as-string message))))))
126 (unless (signal condition)
127 (invoke-debugger condition))))
129 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
131 ;;;; Library functions.
133 (defmacro def-sqlite-call-out (name &rest args)
136 (:library "libsqlite.so")
139 (def-sqlite-call-out error-string
140 (:name "sqlite_error_string")
142 (error-code int :in))
143 (:return-type c-string))
145 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
149 (def-sqlite-call-out %open
150 (:name "sqlite_open")
152 (dbname c-string :in)
154 (errmsg error-message :out))
155 (:return-type sqlite-db))
157 (def-sqlite-call-out sqlite-close
158 (:name "sqlite_close")
159 (:arguments (db sqlite-db :in))
162 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
166 (def-sqlite-call-out %compile
167 (:name "sqlite_compile")
171 (sql-tail (c-ptr c-string) :out)
172 (vm (c-ptr sqlite-vm) :out)
173 (errmsg error-message :out))
176 (def-sqlite-call-out %step
177 (:name "sqlite_step")
180 (cols-n (c-ptr int) :out)
181 (cols (c-ptr c-pointer) :out)
182 (col-names (c-ptr c-pointer) :out))
185 (def-sqlite-call-out %finalize
186 (:name "sqlite_finalize")
189 (errmsg error-message :out))
192 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
196 (def-sqlite-call-out sqlite-last-insert-rowid
197 (:name "sqlite_last_insert_rowid")
202 (def-sqlite-call-out %get-table
203 (:name "sqlite_get_table")
207 (result (c-ptr c-pointer) :out)
208 (n-row (c-ptr int) :out)
209 (n-column (c-ptr int) :out)
210 (errmsg error-message :out))
213 (def-sqlite-call-out %free-table
214 (:name "sqlite_free_table")
216 (rows c-pointer :in))
220 (:name "sqlite_version")
221 (:library "libsqlite.so")
222 (:type (c-array-max char 32))
226 (:name "sqlite_encoding")
227 (:library "libsqlite.so")
228 (:type (c-array-max char 32))
231 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
233 ;;;; Wrapper functions.
235 (defconstant sqlite-version
236 (ext:convert-string-from-bytes %version custom:*terminal-encoding*))
238 (defconstant sqlite-encoding
239 (ext:convert-string-from-bytes %encoding custom:*terminal-encoding*))
241 (defun error-message-as-string (p)
242 (with-c-var (p1 'c-pointer p)
247 (defun sqlite-open (db-name &optional (mode 0))
248 (multiple-value-bind (db error-message)
252 (signal-sqlite-error SQLITE-ERROR error-message))))
254 (defun c-pointer-to-string-array (p element-n)
257 (with-c-var (p1 'c-pointer p)
258 (cast p1 `(c-ptr (c-array c-string ,element-n))))))
260 (defun sqlite-compile (db sql)
261 (multiple-value-bind (result sql-tail vm error-message)
263 (declare (ignore sql-tail))
264 (if (= result SQLITE-OK)
266 (signal-sqlite-error result error-message))))
268 (defun sqlite-step (vm)
269 (multiple-value-bind (result n-col cols col-names)
272 ((= result SQLITE-ROW)
273 (values n-col (c-pointer-to-string-array cols n-col)
274 (c-pointer-to-string-array col-names (* 2 n-col))))
275 ((= result SQLITE-DONE) (values 0 nil nil))
276 (t (signal-sqlite-error result "sqlite-step")))))
278 (defun sqlite-finalize (vm)
279 (multiple-value-bind (result error-message)
281 (if (= result SQLITE-OK)
283 (signal-sqlite-error result error-message))))
285 (defun sqlite-get-table (db sql)
286 (multiple-value-bind (result rows n-row n-col error-message)
288 (if (= result SQLITE-OK)
289 (let ((x (c-pointer-to-string-array rows (* (1+ n-row) n-col))))
291 (values x n-row n-col))
292 (signal-sqlite-error result error-message))))
294 (defmacro with-open-sqlite-db ((db dbname &key (mode 0)) &body body)
295 (let ((error-message (gensym)))
296 `(multiple-value-bind (,db ,error-message)
297 (sqlite-open ,dbname ,mode)
299 (signal-sqlite-error SQLITE-ERROR ,error-message)
302 (sqlite-close ,db))))))
304 (defmacro with-sqlite-vm ((vm db sql) &body body)
305 `(let ((,vm (sqlite-compile ,db ,sql)))
308 (sqlite-finalize ,vm))))
310 (declaim (inline null-row-p))
311 (defun null-row-p (row)
314 (declaim (inline make-null-row))
315 (defun make-null-row ()
319 (defun test-function (db-name)
320 (with-open-sqlite-db (db db-name)
321 (let ((x (sqlite-get-table db "select * from sqlite_master;")))
322 (with-sqlite-vm (vm db "select * from sqlite_master;")
324 (loop for i = 1 then (1+ i)
325 do (multiple-value-bind (n-col cols col-names)
327 (declare (ignore col-names))
330 (loop for j from 0 to (1- n-col)
331 for j1 = (* n-col i) then (1+ j1)
333 (when (string/= (aref x j1) (aref cols j))
334 (format t "~&row=~A, col=~A: ~A - ~A~%"
336 (aref x j1) (aref cols j))
339 (format t "~&Test passed!~%")
340 (format t "~&Test not passed. ~A errors" error-n)))))))
342 (defun get-column-types (db-name table-name)
343 (with-open-sqlite-db (db db-name)
344 (with-sqlite-vm (vm db (format nil "pragma table_info('~A')" table-name))
346 (multiple-value-bind (n-col cols col-names)
348 (declare (ignore col-names))
351 (format t "~&column name = ~A, type = ~A~%"
352 (aref cols 1) (aref cols 2))))))))
354 ;;; Compatibility with sqlite-api-uffi.lisp
356 (defun sqlite-aref (row i)
359 (defun sqlite-free-table (table)
360 (declare (ignore table))
363 (defun make-null-vm ()
366 (defun make-null-row ()
370 ;;;; Local Variables:
372 ;;;; Syntax: ANSI-Common-Lisp