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
12 ;;;; This file, part of CLSQL, is Copyright (c) 2004 by Aurelio Bignoli
14 ;;;; CLSQL users are granted the rights to distribute and use this software
15 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
16 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
17 ;;;; *************************************************************************
19 (in-package #:cl-user
)
22 (:use
#:common-lisp
#:uffi
)
27 #:sqlite3-error-message
37 #:sqlite3-column-count
41 #:sqlite3-column-bytes
48 #:unsigned-char-ptr-type
58 (in-package #:sqlite3
)
60 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
62 ;;;; Return values for sqlite_exec() and sqlite_step()
64 (defconstant SQLITE-OK
0 "Successful result")
65 (defconstant SQLITE-ERROR
1 "SQL error or missing database")
66 (defconstant SQLITE-INTERNAL
2 "An internal logic error in SQLite")
67 (defconstant SQLITE-PERM
3 "Access permission denied")
68 (defconstant SQLITE-ABORT
4 "Callback routine requested an abort")
69 (defconstant SQLITE-BUSY
5 "The database file is locked")
70 (defconstant SQLITE-LOCKED
6 "A table in the database is locked")
71 (defconstant SQLITE-NOMEM
7 "A malloc() failed")
72 (defconstant SQLITE-READONLY
8 "Attempt to write a readonly database")
73 (defconstant SQLITE-INTERRUPT
9 "Operation terminated by sqlite3_interrupt()")
74 (defconstant SQLITE-IOERR
10 "Some kind of disk I/O error occurred")
75 (defconstant SQLITE-CORRUPT
11 "The database disk image is malformed")
76 (defconstant SQLITE-NOTFOUND
12 "(Internal Only) Table or record not found")
77 (defconstant SQLITE-FULL
13 "Insertion failed because database is full")
78 (defconstant SQLITE-CANTOPEN
14 "Unable to open the database file")
79 (defconstant SQLITE-PROTOCOL
15 "Database lock protocol error")
80 (defconstant SQLITE-EMPTY
16 "Database is empty")
81 (defconstant SQLITE-SCHEMA
17 "The database schema changed")
82 (defconstant SQLITE-TOOBIG
18 "Too much data for one row of a table")
83 (defconstant SQLITE-CONSTRAINT
19 "Abort due to contraint violation")
84 (defconstant SQLITE-MISMATCH
20 "Data type mismatch")
85 (defconstant SQLITE-MISUSE
21 "Library used incorrectly")
86 (defconstant SQLITE-NOLFS
22 "Uses OS features not supported on host")
87 (defconstant SQLITE-AUTH
23 "Authorization denied")
88 (defconstant SQLITE-FORMAT
24 "Auxiliary database format error")
89 (defconstant SQLITE-RANGE
25 "2nd parameter to sqlite3_bind out of range")
90 (defconstant SQLITE-NOTADB
26 "File opened that is not a database file")
91 (defconstant SQLITE-ROW
100 "sqlite3_step() has another row ready")
92 (defconstant SQLITE-DONE
101 "sqlite3_step() has finished executing")
94 (defparameter error-codes
96 (cons SQLITE-OK
"not an error")
97 (cons SQLITE-ERROR
"SQL logic error or missing database")
98 (cons SQLITE-INTERNAL
"internal SQLite implementation flaw")
99 (cons SQLITE-PERM
"access permission denied")
100 (cons SQLITE-ABORT
"callback requested query abort")
101 (cons SQLITE-BUSY
"database is locked")
102 (cons SQLITE-LOCKED
"database table is locked")
103 (cons SQLITE-NOMEM
"out of memory")
104 (cons SQLITE-READONLY
"attempt to write a readonly database")
105 (cons SQLITE-INTERRUPT
"interrupted")
106 (cons SQLITE-IOERR
"disk I/O error")
107 (cons SQLITE-CORRUPT
"database disk image is malformed")
108 (cons SQLITE-NOTFOUND
"table or record not found")
109 (cons SQLITE-FULL
"database is full")
110 (cons SQLITE-CANTOPEN
"unable to open database file")
111 (cons SQLITE-PROTOCOL
"database locking protocol failure")
112 (cons SQLITE-EMPTY
"table contains no data")
113 (cons SQLITE-SCHEMA
"database schema has changed")
114 (cons SQLITE-TOOBIG
"too much data for one table row")
115 (cons SQLITE-CONSTRAINT
"constraint failed")
116 (cons SQLITE-MISMATCH
"datatype mismatch")
117 (cons SQLITE-MISUSE
"library routine called out of sequence")
118 (cons SQLITE-NOLFS
"kernel lacks large file support")
119 (cons SQLITE-AUTH
"authorization denied")
120 (cons SQLITE-FORMAT
"auxiliary database format error")
121 (cons SQLITE-RANGE
"bind index out of range")
122 (cons SQLITE-NOTADB
"file is encrypted or is not a database"))
123 "Association list of error messages.")
125 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
129 (defconstant SQLITE-INTEGER
1)
130 (defconstant SQLITE-FLOAT
2)
131 (defconstant SQLITE-TEXT
3)
132 (defconstant SQLITE-BLOB
4)
133 (defconstant SQLITE-NULL
5)
135 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
137 ;;;; Foreign types definitions.
139 (def-foreign-type sqlite3-db
:pointer-void
)
140 (def-foreign-type sqlite3-stmt
:pointer-void
)
142 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
144 ;;;; Lisp types definitions.
146 (def-type sqlite3-db-type sqlite3-db
)
147 (def-type sqlite3-db-ptr-type
(* sqlite3-db
))
148 (def-type sqlite3-stmt-type sqlite3-stmt
)
149 (def-type sqlite3-stmt-ptr-type
(* sqlite3-stmt
))
150 (def-type unsigned-char-ptr-type
(* :unsigned-char
))
152 (defparameter null-stmt
(make-null-pointer :void
))
154 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
156 ;;; Hash tables for db and statement pointers.
158 (defvar *db-pointers
* (make-hash-table))
159 (defvar *stmt-pointers
* (make-hash-table))
161 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
165 (define-condition sqlite3-error
()
166 ((message :initarg
:message
:reader sqlite3-error-message
:initform
"")
167 (code :initarg
:code
:reader sqlite3-error-code
))
168 (:report
(lambda (condition stream
)
169 (format stream
"Sqlite3 error [~A]: ~A"
170 (sqlite3-error-code condition
)
171 (sqlite3-error-message condition
)))))
173 (defgeneric signal-sqlite3-error
(db))
174 (defmethod signal-sqlite3-error (db)
176 (make-condition 'sqlite3-error
177 :code
(sqlite3-errcode db
)
178 :message
(convert-from-cstring (sqlite3-errmsg db
)))))
179 (unless (signal condition
)
180 (invoke-debugger condition
))))
182 (defmethod signal-sqlite3-error ((code number
))
184 (make-condition 'sqlite3-error
186 :message
(let ((s (cdr (assoc code error-codes
))))
190 (unless (signal condition
)
191 (invoke-debugger condition
))))
193 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
195 ;;;; Library functions.
197 (defmacro def-sqlite3-function
(name args
&key
(returning :void
))
198 `(def-function ,name
,args
200 :returning
,returning
))
202 (declaim (inline %errcode
))
203 (def-sqlite3-function
208 (declaim (inline %errmsg
))
209 (def-sqlite3-function
214 (declaim (inline %open
))
215 (def-sqlite3-function
216 ("sqlite3_open" %open
)
221 (declaim (inline %close
))
222 (def-sqlite3-function
223 ("sqlite3_close" %close
)
227 (declaim (inline %prepare
))
228 (def-sqlite3-function
229 ("sqlite3_prepare" %prepare
)
233 (stmt (* sqlite3-stmt
))
234 (sql-tail (* (* :unsigned-char
))))
237 (declaim (inline %step
))
238 (def-sqlite3-function
239 ("sqlite3_step" %step
)
240 ((stmt sqlite3-stmt
))
243 (declaim (inline %finalize
))
244 (def-sqlite3-function
245 ("sqlite3_finalize" %finalize
)
246 ((stmt sqlite3-stmt
))
249 (declaim (inline sqlite3-column-count
))
250 (def-sqlite3-function
251 "sqlite3_column_count"
252 ((stmt sqlite3-stmt
))
255 (declaim (inline %column-name
))
256 (def-sqlite3-function
257 ("sqlite3_column_name" %column-name
)
262 (declaim (inline sqlite3-column-type
))
263 (def-sqlite3-function
264 "sqlite3_column_type"
269 (declaim (inline sqlite3-column-text
))
270 (def-sqlite3-function
271 "sqlite3_column_text"
274 :returning
(* :unsigned-char
))
276 (declaim (inline sqlite3-column-bytes
))
277 (def-sqlite3-function
278 "sqlite3_column_bytes"
283 (declaim (inline sqlite3-column-blob
))
284 (def-sqlite3-function
285 "sqlite3_column_blob"
288 :returning
:pointer-void
)
290 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
292 ;;;; wrapper functions.
294 (defun sqlite3-open (db-name &optional
(mode 0))
295 (declare (ignore mode
) (type string db-name
))
296 (let ((dbp (allocate-foreign-object 'sqlite3-db
)))
297 (declare (type sqlite3-db-ptr-type dbp
))
298 (with-cstring (db-name-native db-name
)
299 (let ((result (%open db-name-native dbp
)))
302 ;; According to docs, the db must be closed even in case
304 (%close
(deref-pointer dbp
'sqlite3-db
))
305 (free-foreign-object dbp
)
306 (signal-sqlite3-error result
))
307 (let ((db (deref-pointer dbp
'sqlite3-db
)))
308 (declare (type sqlite3-db-type db
))
309 (setf (gethash db
*db-pointers
*) dbp
)
312 (declaim (ftype (function (sqlite3-db-type) t
) sqlite3-close
))
313 (defun sqlite3-close (db)
314 (declare (type sqlite3-db-type db
))
315 (let ((result (%close db
)))
317 (signal-sqlite3-error result
)
319 (free-foreign-object (gethash db
*db-pointers
*))
320 (remhash db
*db-pointers
*)
323 (declaim (ftype (function (sqlite3-db-type string
) sqlite3-stmt-type
) sqlite3-prepare
))
324 (defun sqlite3-prepare (db sql
)
325 (declare (type sqlite3-db-type db
))
326 (with-cstring (sql-native sql
)
327 (let ((stmtp (allocate-foreign-object 'sqlite3-stmt
)))
328 (declare (type sqlite3-stmt-ptr-type stmtp
))
329 (with-foreign-object (sql-tail '(* :unsigned-char
))
330 (let ((result (%prepare db sql-native -
1 stmtp sql-tail
)))
331 (if (/= result SQLITE-OK
)
333 (unless (null-pointer-p stmtp
)
334 ;; There is an error, but a statement has been allocated:
335 ;; finalize it (better safe than sorry).
336 (%finalize
(deref-pointer stmtp
'sqlite3-stmt
)))
337 (free-foreign-object stmtp
)
338 (signal-sqlite3-error db
))
339 (let ((stmt (deref-pointer stmtp
'sqlite3-stmt
)))
340 (declare (type sqlite3-stmt-type stmt
))
341 (setf (gethash stmt
*stmt-pointers
*) stmtp
)
344 (declaim (ftype (function (sqlite3-stmt-type) t
) sqlite3-step
))
345 (defun sqlite3-step (stmt)
346 (declare (type sqlite3-stmt-type stmt
))
347 (let ((result (%step stmt
)))
348 (cond ((= result SQLITE-ROW
) t
)
349 ((= result SQLITE-DONE
) nil
)
350 (t (signal-sqlite3-error result
)))))
352 (declaim (ftype (function (sqlite3-stmt-type) t
) sqlite3-finalize
))
353 (defun sqlite3-finalize (stmt)
354 (declare (type sqlite3-stmt-type stmt
))
355 (let ((result (%finalize stmt
)))
356 (if (/= result SQLITE-OK
)
357 (signal-sqlite3-error result
)
359 (free-foreign-object (gethash stmt
*stmt-pointers
*))
360 (remhash stmt
*stmt-pointers
*)
363 (declaim (inline sqlite3-column-name
))
364 (defun sqlite3-column-name (stmt n
)
365 (declare (type sqlite3-stmt-type stmt
) (type fixnum n
))
366 (convert-from-cstring (%column-name stmt n
)))