4 :sqlite-constraint-error
5 :sqlite-error-db-handle
18 :clear-statement-bindings
19 :statement-column-value
20 :statement-column-names
21 :statement-bind-parameter-names
33 (define-condition sqlite-error
(simple-error)
34 ((handle :initform nil
:initarg
:db-handle
35 :reader sqlite-error-db-handle
)
36 (error-code :initform nil
:initarg
:error-code
37 :reader sqlite-error-code
)
38 (error-msg :initform nil
:initarg
:error-msg
39 :reader sqlite-error-message
)
40 (statement :initform nil
:initarg
:statement
41 :reader sqlite-error-statement
)
42 (sql :initform nil
:initarg
:sql
43 :reader sqlite-error-sql
)))
45 (define-condition sqlite-constraint-error
(sqlite-error)
48 (defun sqlite-error (error-code message
&key
50 (db-handle (if statement
(db statement
)))
51 (sql-text (if statement
(sql statement
))))
52 (error (if (eq error-code
:constraint
)
53 'sqlite-constraint-error
55 :format-control
(if (listp message
) (first message
) message
)
56 :format-arguments
(if (listp message
) (rest message
))
58 :error-code error-code
59 :error-msg
(if (and db-handle error-code
)
60 (sqlite-ffi:sqlite3-errmsg
(handle db-handle
)))
64 (defmethod print-object :after
((obj sqlite-error
) stream
)
65 (unless *print-escape
*
66 (when (or (and (sqlite-error-code obj
)
67 (not (eq (sqlite-error-code obj
) :ok
)))
68 (sqlite-error-message obj
))
69 (format stream
"~&Code ~A: ~A."
70 (or (sqlite-error-code obj
) :OK
)
71 (or (sqlite-error-message obj
) "no message")))
72 (when (sqlite-error-db-handle obj
)
73 (format stream
"~&Database: ~A"
74 (database-path (sqlite-error-db-handle obj
))))
75 (when (sqlite-error-sql obj
)
76 (format stream
"~&SQL: ~A" (sqlite-error-sql obj
)))))
78 ;(declaim (optimize (speed 3) (safety 0) (debug 0)))
80 (defclass sqlite-handle
()
81 ((handle :accessor handle
)
82 (database-path :accessor database-path
)
83 (cache :accessor cache
)
84 (statements :initform nil
:accessor sqlite-handle-statements
))
85 (:documentation
"Class that encapsulates the connection to the database. Use connect and disconnect."))
87 (defmethod initialize-instance :after
((object sqlite-handle
) &key
(database-path ":memory:") &allow-other-keys
)
88 (cffi:with-foreign-object
(ppdb 'sqlite-ffi
:p-sqlite3
)
89 (let ((error-code (sqlite-ffi:sqlite3-open database-path ppdb
)))
90 (if (eq error-code
:ok
)
91 (setf (handle object
) (cffi:mem-ref ppdb
'sqlite-ffi
:p-sqlite3
)
92 (database-path object
) database-path
)
93 (sqlite-error error-code
(list "Could not open sqlite3 database ~A" database-path
)))))
94 (setf (cache object
) (make-instance 'sqlite.cache
:mru-cache
:cache-size
16 :destructor
#'really-finalize-statement
)))
96 (defun connect (database-path &key busy-timeout
)
97 "Connect to the sqlite database at the given DATABASE-PATH. Returns the SQLITE-HANDLE connected to the database. Use DISCONNECT to disconnect.
98 Operations will wait for locked databases for up to BUSY-TIMEOUT milliseconds; if BUSY-TIMEOUT is NIL, then operations on locked databases will fail immediately."
99 (let ((db (make-instance 'sqlite-handle
100 :database-path
(etypecase database-path
101 (string database-path
)
102 (pathname (namestring database-path
))))))
104 (set-busy-timeout db busy-timeout
))
107 (defun set-busy-timeout (db milliseconds
)
108 "Sets the maximum amount of time to wait for a locked database."
109 (sqlite-ffi:sqlite3-busy-timeout
(handle db
) milliseconds
))
111 (defun disconnect (handle)
112 "Disconnects the given HANDLE from the database. All further operations on the handle are invalid."
113 (sqlite.cache
:purge-cache
(cache handle
))
114 (iter (with statements
= (copy-list (sqlite-handle-statements handle
)))
115 (declare (dynamic-extent statements
))
116 (for statement in statements
)
117 (really-finalize-statement statement
))
118 (let ((error-code (sqlite-ffi:sqlite3-close
(handle handle
))))
119 (unless (eq error-code
:ok
)
120 (sqlite-error error-code
"Could not close sqlite3 database." :db-handle handle
))
121 (slot-makunbound handle
'handle
)))
123 (defclass sqlite-statement
()
124 ((db :reader db
:initarg
:db
)
125 (handle :accessor handle
)
126 (sql :reader sql
:initarg
:sql
)
127 (columns-count :accessor resultset-columns-count
)
128 (columns-names :accessor resultset-columns-names
:reader statement-column-names
)
129 (parameters-count :accessor parameters-count
)
130 (parameters-names :accessor parameters-names
:reader statement-bind-parameter-names
))
131 (:documentation
"Class that represents the prepared statement."))
133 (defmethod initialize-instance :after
((object sqlite-statement
) &key
&allow-other-keys
)
134 (cffi:with-foreign-object
(p-statement 'sqlite-ffi
:p-sqlite3-stmt
)
135 (cffi:with-foreign-object
(p-tail '(:pointer
:char
))
136 (cffi:with-foreign-string
(sql (sql object
))
137 (let ((error-code (sqlite-ffi:sqlite3-prepare
(handle (db object
)) sql -
1 p-statement p-tail
)))
138 (unless (eq error-code
:ok
)
139 (sqlite-error error-code
"Could not prepare an sqlite statement."
140 :db-handle
(db object
) :sql-text
(sql object
)))
141 (unless (zerop (cffi:mem-ref
(cffi:mem-ref p-tail
'(:pointer
:char
)) :uchar
))
142 (sqlite-error nil
"SQL string contains more than one SQL statement." :sql-text
(sql object
)))
143 (setf (handle object
) (cffi:mem-ref p-statement
'sqlite-ffi
:p-sqlite3-stmt
)
144 (resultset-columns-count object
) (sqlite-ffi:sqlite3-column-count
(handle object
))
145 (resultset-columns-names object
) (loop
146 for i below
(resultset-columns-count object
)
147 collect
(sqlite-ffi:sqlite3-column-name
(handle object
) i
))
148 (parameters-count object
) (sqlite-ffi:sqlite3-bind-parameter-count
(handle object
))
149 (parameters-names object
) (loop
150 for i from
1 to
(parameters-count object
)
151 collect
(sqlite-ffi:sqlite3-bind-parameter-name
(handle object
) i
))))))))
153 (defun prepare-statement (db sql
)
154 "Prepare the statement to the DB that will execute the commands that are in SQL.
156 Returns the SQLITE-STATEMENT.
158 SQL must contain exactly one statement.
159 SQL may have some positional (not named) parameters specified with question marks.
163 select name from users where id = ?"
164 (or (let ((statement (sqlite.cache
:get-from-cache
(cache db
) sql
)))
166 (clear-statement-bindings statement
))
168 (let ((statement (make-instance 'sqlite-statement
:db db
:sql sql
)))
169 (push statement
(sqlite-handle-statements db
))
172 (defun really-finalize-statement (statement)
173 (setf (sqlite-handle-statements (db statement
))
174 (delete statement
(sqlite-handle-statements (db statement
))))
175 (sqlite-ffi:sqlite3-finalize
(handle statement
))
176 (slot-makunbound statement
'handle
))
178 (defun finalize-statement (statement)
179 "Finalizes the statement and signals that associated resources may be released.
180 Note: does not immediately release resources because statements are cached."
181 (reset-statement statement
)
182 (sqlite.cache
:put-to-cache
(cache (db statement
)) (sql statement
) statement
))
184 (defun step-statement (statement)
185 "Steps to the next row of the resultset of STATEMENT.
186 Returns T is successfully advanced to the next row and NIL if there are no more rows."
187 (let ((error-code (sqlite-ffi:sqlite3-step
(handle statement
))))
192 (sqlite-error error-code
"Error while stepping an sqlite statement." :statement statement
)))))
194 (defun reset-statement (statement)
195 "Resets the STATEMENT and prepare it to be called again."
196 (let ((error-code (sqlite-ffi:sqlite3-reset
(handle statement
))))
197 (unless (eq error-code
:ok
)
198 (sqlite-error error-code
"Error while resetting an sqlite statement." :statement statement
))))
200 (defun clear-statement-bindings (statement)
201 "Sets all binding values to NULL."
202 (let ((error-code (sqlite-ffi:sqlite3-clear-bindings
(handle statement
))))
203 (unless (eq error-code
:ok
)
204 (sqlite-error error-code
"Error while clearing bindings of an sqlite statement."
205 :statement statement
))))
207 (defun statement-column-value (statement column-number
)
208 "Returns the COLUMN-NUMBER-th column's value of the current row of the STATEMENT. Columns are numbered from zero.
211 * INTEGER for integers
212 * DOUBLE-FLOAT for floats
214 * (SIMPLE-ARRAY (UNSIGNED-BYTE 8)) for BLOBs"
215 (let ((type (sqlite-ffi:sqlite3-column-type
(handle statement
) column-number
)))
218 (:text
(sqlite-ffi:sqlite3-column-text
(handle statement
) column-number
))
219 (:integer
(sqlite-ffi:sqlite3-column-int64
(handle statement
) column-number
))
220 (:float
(sqlite-ffi:sqlite3-column-double
(handle statement
) column-number
))
221 (:blob
(let* ((blob-length (sqlite-ffi:sqlite3-column-bytes
(handle statement
) column-number
))
222 (result (make-array (the fixnum blob-length
) :element-type
'(unsigned-byte 8)))
223 (blob (sqlite-ffi:sqlite3-column-blob
(handle statement
) column-number
)))
225 for i below blob-length
226 do
(setf (aref result i
) (cffi:mem-aref blob
:unsigned-char i
)))
229 (defun execute-non-query (db sql
&rest parameters
)
230 "Executes the query SQL to the database DB with given PARAMETERS. Returns nothing.
234 \(execute-non-query db \"insert into users (user_name, real_name) values (?, ?)\" \"joe\" \"Joe the User\")
236 See BIND-PARAMETER for the list of supported parameter types."
237 (declare (dynamic-extent parameters
))
238 (let ((stmt (prepare-statement db sql
)))
240 (declare (type fixnum i
))
241 (for value in parameters
)
242 (bind-parameter stmt i value
))
243 (step-statement stmt
)
244 (finalize-statement stmt
)
247 (defun execute-to-list (db sql
&rest parameters
)
248 "Executes the query SQL to the database DB with given PARAMETERS. Returns the results as list of lists.
252 \(execute-to-list db \"select id, user_name, real_name from users where user_name = ?\" \"joe\")
254 \((1 \"joe\" \"Joe the User\")
255 (2 \"joe\" \"Another Joe\"))
257 See BIND-PARAMETER for the list of supported parameter types."
258 (declare (dynamic-extent parameters
))
259 (let ((stmt (prepare-statement db sql
))
262 (declare (type fixnum i
))
263 (for value in parameters
)
264 (bind-parameter stmt i value
))
265 (loop (if (step-statement stmt
)
266 (push (iter (for i from
0 below
(the fixnum
(sqlite-ffi:sqlite3-column-count
(handle stmt
))))
267 (declare (type fixnum i
))
268 (collect (statement-column-value stmt i
)))
271 (finalize-statement stmt
)
274 (defun execute-one-row-m-v (db sql
&rest parameters
)
275 "Executes the query SQL to the database DB with given PARAMETERS. Returns the first row as multiple values.
278 \(execute-one-row-m-v db \"select id, user_name, real_name from users where id = ?\" 1)
280 \(values 1 \"joe\" \"Joe the User\")
282 See BIND-PARAMETER for the list of supported parameter types."
283 (let ((stmt (prepare-statement db sql
)))
287 (declare (type fixnum i
))
288 (for value in parameters
)
289 (bind-parameter stmt i value
))
290 (if (step-statement stmt
)
291 (return-from execute-one-row-m-v
292 (values-list (iter (for i from
0 below
(the fixnum
(sqlite-ffi:sqlite3-column-count
(handle stmt
))))
293 (declare (type fixnum i
))
294 (collect (statement-column-value stmt i
)))))
295 (return-from execute-one-row-m-v
296 (values-list (loop repeat
(the fixnum
(sqlite-ffi:sqlite3-column-count
(handle stmt
))) collect nil
)))))
297 (finalize-statement stmt
))))
299 (defun statement-parameter-index (statement parameter-name
)
300 (sqlite-ffi:sqlite3-bind-parameter-index
(handle statement
) parameter-name
))
302 (defun bind-parameter (statement parameter value
)
303 "Sets the PARAMETER-th parameter in STATEMENT to the VALUE.
304 Parameters are numbered from one.
306 * NULL. Passed as NULL
307 * INTEGER. Passed as an 64-bit integer
308 * STRING. Passed as a string
309 * FLOAT. Passed as a double
310 * (VECTOR (UNSIGNED-BYTE 8)) and VECTOR that contains integers in range [0,256). Passed as a BLOB"
311 (let ((index (etypecase parameter
313 (string (statement-parameter-index statement parameter
)))))
314 (declare (type fixnum index
))
315 (let ((error-code (typecase value
316 (null (sqlite-ffi:sqlite3-bind-null
(handle statement
) index
))
317 (integer (sqlite-ffi:sqlite3-bind-int64
(handle statement
) index value
))
318 (double-float (sqlite-ffi:sqlite3-bind-double
(handle statement
) index value
))
319 (real (sqlite-ffi:sqlite3-bind-double
(handle statement
) index
(coerce value
'double-float
)))
320 (string (sqlite-ffi:sqlite3-bind-text
(handle statement
) index value -
1 (sqlite-ffi:destructor-transient
)))
321 ((vector (unsigned-byte 8)) (cffi:with-pointer-to-vector-data
(ptr value
)
322 (sqlite-ffi:sqlite3-bind-blob
(handle statement
) index ptr
(length value
) (sqlite-ffi:destructor-transient
))))
323 (vector (cffi:with-foreign-object
(array :unsigned-char
(length value
))
325 for i from
0 below
(length value
)
326 do
(setf (cffi:mem-aref array
:unsigned-char i
) (aref value i
)))
327 (sqlite-ffi:sqlite3-bind-blob
(handle statement
) index array
(length value
) (sqlite-ffi:destructor-transient
))))
330 (list "Do not know how to pass value ~A of type ~A to sqlite."
331 value
(type-of value
))
332 :statement statement
)))))
333 (unless (eq error-code
:ok
)
334 (sqlite-error error-code
335 (list "Error when binding parameter ~A to value ~A." parameter value
)
336 :statement statement
)))))
338 (defun execute-single (db sql
&rest parameters
)
339 "Executes the query SQL to the database DB with given PARAMETERS. Returns the first column of the first row as single value.
342 \(execute-single db \"select user_name from users where id = ?\" 1)
346 See BIND-PARAMETER for the list of supported parameter types."
347 (declare (dynamic-extent parameters
))
348 (let ((stmt (prepare-statement db sql
)))
352 (declare (type fixnum i
))
353 (for value in parameters
)
354 (bind-parameter stmt i value
))
355 (if (step-statement stmt
)
356 (statement-column-value stmt
0)
358 (finalize-statement stmt
))))
360 (defun last-insert-rowid (db)
361 "Returns the auto-generated ID of the last inserted row on the database connection DB."
362 (sqlite-ffi:sqlite3-last-insert-rowid
(handle db
)))
364 (defmacro with-transaction
(db &body body
)
365 "Wraps the BODY inside the transaction."
366 (let ((ok (gensym "TRANSACTION-COMMIT-"))
367 (db-var (gensym "DB-")))
370 (execute-non-query ,db-var
"begin transaction")
372 (multiple-value-prog1
376 (execute-non-query ,db-var
"commit transaction")
377 (execute-non-query ,db-var
"rollback transaction"))))))
379 (defmacro with-open-database
((db path
&key busy-timeout
) &body body
)
380 `(let ((,db
(connect ,path
:busy-timeout
,busy-timeout
)))
385 (defmacro-driver (FOR vars IN-SQLITE-QUERY query-expression ON-DATABASE db
&optional WITH-PARAMETERS parameters
)
386 (let ((statement (gensym "STATEMENT-"))
387 (kwd (if generate
'generate
'for
)))
388 `(progn (with ,statement
= (prepare-statement ,db
,query-expression
))
389 (finally-protected (when ,statement
(finalize-statement ,statement
)))
391 (list `(initially ,@(iter (for i from
1)
392 (for value in parameters
)
393 (collect `(sqlite:bind-parameter
,statement
,i
,value
))))))
394 (,kwd
,(if (symbolp vars
)
397 next
(progn (if (step-statement ,statement
)
398 (values ,@(iter (for i from
0 below
(if (symbolp vars
) 1 (length vars
)))
399 (collect `(statement-column-value ,statement
,i
))))
402 (defmacro-driver (FOR vars ON-SQLITE-STATEMENT statement
)
403 (let ((statement-var (gensym "STATEMENT-"))
404 (kwd (if generate
'generate
'for
)))
405 `(progn (with ,statement-var
= ,statement
)
406 (,kwd
,(if (symbolp vars
)
409 next
(progn (if (step-statement ,statement-var
)
410 (values ,@(iter (for i from
0 below
(if (symbolp vars
) 1 (length vars
)))
411 (collect `(statement-column-value ,statement-var
,i
))))