1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
5 ;;;; Name: sqlite3-api.lisp
6 ;;;; Purpose: Low-level SQLite3 interface using UFFI
7 ;;;; Authors: Aurelio Bignoli
10 ;;;; This file, part of CLSQL, is Copyright (c) 2004 by Aurelio Bignoli
12 ;;;; CLSQL users are granted the rights to distribute and use this software
13 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
14 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
15 ;;;; *************************************************************************
17 (in-package #:cl-user)
20 (:use #:common-lisp #:uffi)
25 #:sqlite3-error-message
35 #:sqlite3-column-count
39 #:sqlite3-column-bytes
46 #:unsigned-char-ptr-type
56 (in-package #:sqlite3)
58 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
60 ;;;; Return values for sqlite_exec() and sqlite_step()
62 (defconstant SQLITE-OK 0 "Successful result")
63 (defconstant SQLITE-ERROR 1 "SQL error or missing database")
64 (defconstant SQLITE-INTERNAL 2 "An internal logic error in SQLite")
65 (defconstant SQLITE-PERM 3 "Access permission denied")
66 (defconstant SQLITE-ABORT 4 "Callback routine requested an abort")
67 (defconstant SQLITE-BUSY 5 "The database file is locked")
68 (defconstant SQLITE-LOCKED 6 "A table in the database is locked")
69 (defconstant SQLITE-NOMEM 7 "A malloc() failed")
70 (defconstant SQLITE-READONLY 8 "Attempt to write a readonly database")
71 (defconstant SQLITE-INTERRUPT 9 "Operation terminated by sqlite3_interrupt()")
72 (defconstant SQLITE-IOERR 10 "Some kind of disk I/O error occurred")
73 (defconstant SQLITE-CORRUPT 11 "The database disk image is malformed")
74 (defconstant SQLITE-NOTFOUND 12 "(Internal Only) Table or record not found")
75 (defconstant SQLITE-FULL 13 "Insertion failed because database is full")
76 (defconstant SQLITE-CANTOPEN 14 "Unable to open the database file")
77 (defconstant SQLITE-PROTOCOL 15 "Database lock protocol error")
78 (defconstant SQLITE-EMPTY 16 "Database is empty")
79 (defconstant SQLITE-SCHEMA 17 "The database schema changed")
80 (defconstant SQLITE-TOOBIG 18 "Too much data for one row of a table")
81 (defconstant SQLITE-CONSTRAINT 19 "Abort due to contraint violation")
82 (defconstant SQLITE-MISMATCH 20 "Data type mismatch")
83 (defconstant SQLITE-MISUSE 21 "Library used incorrectly")
84 (defconstant SQLITE-NOLFS 22 "Uses OS features not supported on host")
85 (defconstant SQLITE-AUTH 23 "Authorization denied")
86 (defconstant SQLITE-FORMAT 24 "Auxiliary database format error")
87 (defconstant SQLITE-RANGE 25 "2nd parameter to sqlite3_bind out of range")
88 (defconstant SQLITE-NOTADB 26 "File opened that is not a database file")
89 (defconstant SQLITE-ROW 100 "sqlite3_step() has another row ready")
90 (defconstant SQLITE-DONE 101 "sqlite3_step() has finished executing")
92 (defparameter error-codes
94 (cons SQLITE-OK "not an error")
95 (cons SQLITE-ERROR "SQL logic error or missing database")
96 (cons SQLITE-INTERNAL "internal SQLite implementation flaw")
97 (cons SQLITE-PERM "access permission denied")
98 (cons SQLITE-ABORT "callback requested query abort")
99 (cons SQLITE-BUSY "database is locked")
100 (cons SQLITE-LOCKED "database table is locked")
101 (cons SQLITE-NOMEM "out of memory")
102 (cons SQLITE-READONLY "attempt to write a readonly database")
103 (cons SQLITE-INTERRUPT "interrupted")
104 (cons SQLITE-IOERR "disk I/O error")
105 (cons SQLITE-CORRUPT "database disk image is malformed")
106 (cons SQLITE-NOTFOUND "table or record not found")
107 (cons SQLITE-FULL "database is full")
108 (cons SQLITE-CANTOPEN "unable to open database file")
109 (cons SQLITE-PROTOCOL "database locking protocol failure")
110 (cons SQLITE-EMPTY "table contains no data")
111 (cons SQLITE-SCHEMA "database schema has changed")
112 (cons SQLITE-TOOBIG "too much data for one table row")
113 (cons SQLITE-CONSTRAINT "constraint failed")
114 (cons SQLITE-MISMATCH "datatype mismatch")
115 (cons SQLITE-MISUSE "library routine called out of sequence")
116 (cons SQLITE-NOLFS "kernel lacks large file support")
117 (cons SQLITE-AUTH "authorization denied")
118 (cons SQLITE-FORMAT "auxiliary database format error")
119 (cons SQLITE-RANGE "bind index out of range")
120 (cons SQLITE-NOTADB "file is encrypted or is not a database"))
121 "Association list of error messages.")
123 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
127 (defconstant SQLITE-INTEGER 1)
128 (defconstant SQLITE-FLOAT 2)
129 (defconstant SQLITE-TEXT 3)
130 (defconstant SQLITE-BLOB 4)
131 (defconstant SQLITE-NULL 5)
133 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
135 ;;;; Foreign types definitions.
137 (def-foreign-type sqlite3-db :pointer-void)
138 (def-foreign-type sqlite3-stmt :pointer-void)
140 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
142 ;;;; Lisp types definitions.
144 (def-type sqlite3-db-type sqlite3-db)
145 (def-type sqlite3-db-ptr-type (* sqlite3-db))
146 (def-type sqlite3-stmt-type sqlite3-stmt)
147 (def-type sqlite3-stmt-ptr-type (* sqlite3-stmt))
148 (def-type unsigned-char-ptr-type (* :unsigned-char))
150 (defparameter null-stmt (make-null-pointer :void))
152 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
154 ;;; Hash tables for db and statement pointers.
156 (defvar *db-pointers* (make-hash-table))
157 (defvar *stmt-pointers* (make-hash-table))
159 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
163 (define-condition sqlite3-error ()
164 ((message :initarg :message :reader sqlite3-error-message :initform "")
165 (code :initarg :code :reader sqlite3-error-code))
166 (:report (lambda (condition stream)
167 (format stream "Sqlite3 error [~A]: ~A"
168 (sqlite3-error-code condition)
169 (sqlite3-error-message condition)))))
171 (defgeneric signal-sqlite3-error (db))
172 (defmethod signal-sqlite3-error (db)
174 (make-condition 'sqlite3-error
175 :code (sqlite3-errcode db)
176 :message (convert-from-cstring (sqlite3-errmsg db)))))
177 (unless (signal condition)
178 (invoke-debugger condition))))
180 (defmethod signal-sqlite3-error ((code number))
182 (make-condition 'sqlite3-error
184 :message (let ((s (cdr (assoc code error-codes))))
188 (unless (signal condition)
189 (invoke-debugger condition))))
191 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
193 ;;;; Library functions.
195 (defmacro def-sqlite3-function (name args &key (returning :void))
196 `(def-function ,name ,args
198 :returning ,returning))
200 (declaim (inline %errcode))
201 (def-sqlite3-function
206 (declaim (inline %errmsg))
207 (def-sqlite3-function
212 (declaim (inline %open))
213 (def-sqlite3-function
214 ("sqlite3_open" %open)
219 (declaim (inline %close))
220 (def-sqlite3-function
221 ("sqlite3_close" %close)
225 (declaim (inline %prepare))
226 (def-sqlite3-function
227 ("sqlite3_prepare" %prepare)
231 (stmt (* sqlite3-stmt))
232 (sql-tail (* (* :unsigned-char))))
235 (declaim (inline %step))
236 (def-sqlite3-function
237 ("sqlite3_step" %step)
238 ((stmt sqlite3-stmt))
241 (declaim (inline %finalize))
242 (def-sqlite3-function
243 ("sqlite3_finalize" %finalize)
244 ((stmt sqlite3-stmt))
247 (declaim (inline sqlite3-column-count))
248 (def-sqlite3-function
249 "sqlite3_column_count"
250 ((stmt sqlite3-stmt))
253 (declaim (inline %column-name))
254 (def-sqlite3-function
255 ("sqlite3_column_name" %column-name)
260 (declaim (inline sqlite3-column-type))
261 (def-sqlite3-function
262 "sqlite3_column_type"
267 (declaim (inline sqlite3-column-text))
268 (def-sqlite3-function
269 "sqlite3_column_text"
272 :returning (* :unsigned-char))
274 (declaim (inline sqlite3-column-bytes))
275 (def-sqlite3-function
276 "sqlite3_column_bytes"
281 (declaim (inline sqlite3-column-blob))
282 (def-sqlite3-function
283 "sqlite3_column_blob"
286 :returning :pointer-void)
288 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
290 ;;;; wrapper functions.
292 (defun sqlite3-open (db-name &optional (mode 0))
293 (declare (ignore mode) (type string db-name))
294 (let ((dbp (allocate-foreign-object 'sqlite3-db)))
295 (declare (type sqlite3-db-ptr-type dbp))
296 (with-cstring (db-name-native db-name)
297 (let ((result (%open db-name-native dbp)))
300 ;; According to docs, the db must be closed even in case
302 (%close (deref-pointer dbp 'sqlite3-db))
303 (free-foreign-object dbp)
304 (signal-sqlite3-error result))
305 (let ((db (deref-pointer dbp 'sqlite3-db)))
306 (declare (type sqlite3-db-type db))
307 (setf (gethash db *db-pointers*) dbp)
310 (declaim (ftype (function (sqlite3-db-type) t) sqlite3-close))
311 (defun sqlite3-close (db)
312 (declare (type sqlite3-db-type db))
313 (let ((result (%close db)))
315 (signal-sqlite3-error result)
317 (free-foreign-object (gethash db *db-pointers*))
318 (remhash db *db-pointers*)
321 (declaim (ftype (function (sqlite3-db-type string) sqlite3-stmt-type) sqlite3-prepare))
322 (defun sqlite3-prepare (db sql)
323 (declare (type sqlite3-db-type db))
324 (with-cstring (sql-native sql)
325 (let ((stmtp (allocate-foreign-object 'sqlite3-stmt)))
326 (declare (type sqlite3-stmt-ptr-type stmtp))
327 (with-foreign-object (sql-tail '(* :unsigned-char))
328 (let ((result (%prepare db sql-native -1 stmtp sql-tail)))
329 (if (/= result SQLITE-OK)
331 (unless (null-pointer-p stmtp)
332 ;; There is an error, but a statement has been allocated:
333 ;; finalize it (better safe than sorry).
334 (%finalize (deref-pointer stmtp 'sqlite3-stmt)))
335 (free-foreign-object stmtp)
336 (signal-sqlite3-error db))
337 (let ((stmt (deref-pointer stmtp 'sqlite3-stmt)))
338 (declare (type sqlite3-stmt-type stmt))
339 (setf (gethash stmt *stmt-pointers*) stmtp)
342 (declaim (ftype (function (sqlite3-stmt-type) t) sqlite3-step))
343 (defun sqlite3-step (stmt)
344 (declare (type sqlite3-stmt-type stmt))
345 (let ((result (%step stmt)))
346 (cond ((= result SQLITE-ROW) t)
347 ((= result SQLITE-DONE) nil)
348 (t (signal-sqlite3-error result)))))
350 (declaim (ftype (function (sqlite3-stmt-type) t) sqlite3-finalize))
351 (defun sqlite3-finalize (stmt)
352 (declare (type sqlite3-stmt-type stmt))
353 (let ((result (%finalize stmt)))
354 (if (/= result SQLITE-OK)
355 (signal-sqlite3-error result)
357 (free-foreign-object (gethash stmt *stmt-pointers*))
358 (remhash stmt *stmt-pointers*)
361 (declaim (inline sqlite3-column-name))
362 (defun sqlite3-column-name (stmt n)
363 (declare (type sqlite3-stmt-type stmt) (type fixnum n))
364 (convert-from-cstring (%column-name stmt n)))