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
27 :execute-one-row-m-v
/named
28 :execute-to-list
/named
29 :execute-non-query
/named
37 (define-condition sqlite-error
(simple-error)
38 ((handle :initform nil
:initarg
:db-handle
39 :reader sqlite-error-db-handle
)
40 (error-code :initform nil
:initarg
:error-code
41 :reader sqlite-error-code
)
42 (error-msg :initform nil
:initarg
:error-msg
43 :reader sqlite-error-message
)
44 (statement :initform nil
:initarg
:statement
45 :reader sqlite-error-statement
)
46 (sql :initform nil
:initarg
:sql
47 :reader sqlite-error-sql
)))
49 (define-condition sqlite-constraint-error
(sqlite-error)
52 (defun sqlite-error (error-code message
&key
54 (db-handle (if statement
(db statement
)))
55 (sql-text (if statement
(sql statement
))))
56 (error (if (eq error-code
:constraint
)
57 'sqlite-constraint-error
59 :format-control
(if (listp message
) (first message
) message
)
60 :format-arguments
(if (listp message
) (rest message
))
62 :error-code error-code
63 :error-msg
(if (and db-handle error-code
)
64 (sqlite-ffi:sqlite3-errmsg
(handle db-handle
)))
68 (defmethod print-object :after
((obj sqlite-error
) stream
)
69 (unless *print-escape
*
70 (when (or (and (sqlite-error-code obj
)
71 (not (eq (sqlite-error-code obj
) :ok
)))
72 (sqlite-error-message obj
))
73 (format stream
"~&Code ~A: ~A."
74 (or (sqlite-error-code obj
) :OK
)
75 (or (sqlite-error-message obj
) "no message")))
76 (when (sqlite-error-db-handle obj
)
77 (format stream
"~&Database: ~A"
78 (database-path (sqlite-error-db-handle obj
))))
79 (when (sqlite-error-sql obj
)
80 (format stream
"~&SQL: ~A" (sqlite-error-sql obj
)))))
82 ;(declaim (optimize (speed 3) (safety 0) (debug 0)))
84 (defclass sqlite-handle
()
85 ((handle :accessor handle
)
86 (database-path :accessor database-path
)
87 (cache :accessor cache
)
88 (statements :initform nil
:accessor sqlite-handle-statements
))
89 (:documentation
"Class that encapsulates the connection to the database. Use connect and disconnect."))
91 (defmethod initialize-instance :after
((object sqlite-handle
) &key
(database-path ":memory:") &allow-other-keys
)
92 (cffi:with-foreign-object
(ppdb 'sqlite-ffi
:p-sqlite3
)
93 (let ((error-code (sqlite-ffi:sqlite3-open database-path ppdb
)))
94 (if (eq error-code
:ok
)
95 (setf (handle object
) (cffi:mem-ref ppdb
'sqlite-ffi
:p-sqlite3
)
96 (database-path object
) database-path
)
97 (sqlite-error error-code
(list "Could not open sqlite3 database ~A" database-path
)))))
98 (setf (cache object
) (make-instance 'sqlite.cache
:mru-cache
:cache-size
16 :destructor
#'really-finalize-statement
)))
100 (defun connect (database-path &key busy-timeout
)
101 "Connect to the sqlite database at the given DATABASE-PATH. Returns the SQLITE-HANDLE connected to the database. Use DISCONNECT to disconnect.
102 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."
103 (let ((db (make-instance 'sqlite-handle
104 :database-path
(etypecase database-path
105 (string database-path
)
106 (pathname (namestring database-path
))))))
108 (set-busy-timeout db busy-timeout
))
111 (defun set-busy-timeout (db milliseconds
)
112 "Sets the maximum amount of time to wait for a locked database."
113 (sqlite-ffi:sqlite3-busy-timeout
(handle db
) milliseconds
))
115 (defun disconnect (handle)
116 "Disconnects the given HANDLE from the database. All further operations on the handle are invalid."
117 (sqlite.cache
:purge-cache
(cache handle
))
118 (iter (with statements
= (copy-list (sqlite-handle-statements handle
)))
119 (declare (dynamic-extent statements
))
120 (for statement in statements
)
121 (really-finalize-statement statement
))
122 (let ((error-code (sqlite-ffi:sqlite3-close
(handle handle
))))
123 (unless (eq error-code
:ok
)
124 (sqlite-error error-code
"Could not close sqlite3 database." :db-handle handle
))
125 (slot-makunbound handle
'handle
)))
127 (defclass sqlite-statement
()
128 ((db :reader db
:initarg
:db
)
129 (handle :accessor handle
)
130 (sql :reader sql
:initarg
:sql
)
131 (columns-count :accessor resultset-columns-count
)
132 (columns-names :accessor resultset-columns-names
:reader statement-column-names
)
133 (parameters-count :accessor parameters-count
)
134 (parameters-names :accessor parameters-names
:reader statement-bind-parameter-names
))
135 (:documentation
"Class that represents the prepared statement."))
137 (defmethod initialize-instance :after
((object sqlite-statement
) &key
&allow-other-keys
)
138 (cffi:with-foreign-object
(p-statement 'sqlite-ffi
:p-sqlite3-stmt
)
139 (cffi:with-foreign-object
(p-tail '(:pointer
:char
))
140 (cffi:with-foreign-string
(sql (sql object
))
141 (let ((error-code (sqlite-ffi:sqlite3-prepare
(handle (db object
)) sql -
1 p-statement p-tail
)))
142 (unless (eq error-code
:ok
)
143 (sqlite-error error-code
"Could not prepare an sqlite statement."
144 :db-handle
(db object
) :sql-text
(sql object
)))
145 (unless (zerop (cffi:mem-ref
(cffi:mem-ref p-tail
'(:pointer
:char
)) :uchar
))
146 (sqlite-error nil
"SQL string contains more than one SQL statement." :sql-text
(sql object
)))
147 (setf (handle object
) (cffi:mem-ref p-statement
'sqlite-ffi
:p-sqlite3-stmt
)
148 (resultset-columns-count object
) (sqlite-ffi:sqlite3-column-count
(handle object
))
149 (resultset-columns-names object
) (loop
150 for i below
(resultset-columns-count object
)
151 collect
(sqlite-ffi:sqlite3-column-name
(handle object
) i
))
152 (parameters-count object
) (sqlite-ffi:sqlite3-bind-parameter-count
(handle object
))
153 (parameters-names object
) (loop
154 for i from
1 to
(parameters-count object
)
155 collect
(sqlite-ffi:sqlite3-bind-parameter-name
(handle object
) i
))))))))
157 (defun prepare-statement (db sql
)
158 "Prepare the statement to the DB that will execute the commands that are in SQL.
160 Returns the SQLITE-STATEMENT.
162 SQL must contain exactly one statement.
163 SQL may have some positional (not named) parameters specified with question marks.
167 select name from users where id = ?"
168 (or (let ((statement (sqlite.cache
:get-from-cache
(cache db
) sql
)))
170 (clear-statement-bindings statement
))
172 (let ((statement (make-instance 'sqlite-statement
:db db
:sql sql
)))
173 (push statement
(sqlite-handle-statements db
))
176 (defun really-finalize-statement (statement)
177 (setf (sqlite-handle-statements (db statement
))
178 (delete statement
(sqlite-handle-statements (db statement
))))
179 (sqlite-ffi:sqlite3-finalize
(handle statement
))
180 (slot-makunbound statement
'handle
))
182 (defun finalize-statement (statement)
183 "Finalizes the statement and signals that associated resources may be released.
184 Note: does not immediately release resources because statements are cached."
185 (reset-statement statement
)
186 (sqlite.cache
:put-to-cache
(cache (db statement
)) (sql statement
) statement
))
188 (defun step-statement (statement)
189 "Steps to the next row of the resultset of STATEMENT.
190 Returns T is successfully advanced to the next row and NIL if there are no more rows."
191 (let ((error-code (sqlite-ffi:sqlite3-step
(handle statement
))))
196 (sqlite-error error-code
"Error while stepping an sqlite statement." :statement statement
)))))
198 (defun reset-statement (statement)
199 "Resets the STATEMENT and prepare it to be called again."
200 (let ((error-code (sqlite-ffi:sqlite3-reset
(handle statement
))))
201 (unless (eq error-code
:ok
)
202 (sqlite-error error-code
"Error while resetting an sqlite statement." :statement statement
))))
204 (defun clear-statement-bindings (statement)
205 "Sets all binding values to NULL."
206 (let ((error-code (sqlite-ffi:sqlite3-clear-bindings
(handle statement
))))
207 (unless (eq error-code
:ok
)
208 (sqlite-error error-code
"Error while clearing bindings of an sqlite statement."
209 :statement statement
))))
211 (defun statement-column-value (statement column-number
)
212 "Returns the COLUMN-NUMBER-th column's value of the current row of the STATEMENT. Columns are numbered from zero.
215 * INTEGER for integers
216 * DOUBLE-FLOAT for floats
218 * (SIMPLE-ARRAY (UNSIGNED-BYTE 8)) for BLOBs"
219 (let ((type (sqlite-ffi:sqlite3-column-type
(handle statement
) column-number
)))
222 (:text
(sqlite-ffi:sqlite3-column-text
(handle statement
) column-number
))
223 (:integer
(sqlite-ffi:sqlite3-column-int64
(handle statement
) column-number
))
224 (:float
(sqlite-ffi:sqlite3-column-double
(handle statement
) column-number
))
225 (:blob
(let* ((blob-length (sqlite-ffi:sqlite3-column-bytes
(handle statement
) column-number
))
226 (result (make-array (the fixnum blob-length
) :element-type
'(unsigned-byte 8)))
227 (blob (sqlite-ffi:sqlite3-column-blob
(handle statement
) column-number
)))
229 for i below blob-length
230 do
(setf (aref result i
) (cffi:mem-aref blob
:unsigned-char i
)))
233 (defmacro with-prepared-statement
(statement-var (db sql parameters-var
) &body body
)
234 (let ((i-var (gensym "I"))
235 (value-var (gensym "VALUE")))
236 `(let ((,statement-var
(prepare-statement ,db
,sql
)))
239 (iter (for ,i-var from
1)
240 (declare (type fixnum
,i-var
))
241 (for ,value-var in
,parameters-var
)
242 (bind-parameter ,statement-var
,i-var
,value-var
))
244 (finalize-statement ,statement-var
)))))
246 (defmacro with-prepared-statement
/named
(statement-var (db sql parameters-var
) &body body
)
247 (let ((name-var (gensym "NAME"))
248 (value-var (gensym "VALUE")))
249 `(let ((,statement-var
(prepare-statement ,db
,sql
)))
252 (iter (for (,name-var
,value-var
) on
,parameters-var by
#'cddr
)
253 (bind-parameter ,statement-var
(string ,name-var
) ,value-var
))
255 (finalize-statement ,statement-var
)))))
257 (defun execute-non-query (db sql
&rest parameters
)
258 "Executes the query SQL to the database DB with given PARAMETERS. Returns nothing.
262 \(execute-non-query db \"insert into users (user_name, real_name) values (?, ?)\" \"joe\" \"Joe the User\")
264 See BIND-PARAMETER for the list of supported parameter types."
265 (declare (dynamic-extent parameters
))
266 (with-prepared-statement statement
(db sql parameters
)
267 (step-statement statement
)))
269 (defun execute-non-query/named
(db sql
&rest parameters
)
270 "Executes the query SQL to the database DB with given PARAMETERS. Returns nothing.
272 PARAMETERS is a list of alternating parameter names and values.
276 \(execute-non-query db \"insert into users (user_name, real_name) values (:name, :real_name)\" \":name\" \"joe\" \":real_name\" \"Joe the User\")
278 See BIND-PARAMETER for the list of supported parameter types."
279 (declare (dynamic-extent parameters
))
280 (with-prepared-statement/named statement
(db sql parameters
)
281 (step-statement statement
)))
283 (defun execute-to-list (db sql
&rest parameters
)
284 "Executes the query SQL to the database DB with given PARAMETERS. Returns the results as list of lists.
288 \(execute-to-list db \"select id, user_name, real_name from users where user_name = ?\" \"joe\")
290 \((1 \"joe\" \"Joe the User\")
291 (2 \"joe\" \"Another Joe\"))
293 See BIND-PARAMETER for the list of supported parameter types."
294 (declare (dynamic-extent parameters
))
295 (with-prepared-statement stmt
(db sql parameters
)
297 (loop (if (step-statement stmt
)
298 (push (iter (for i from
0 below
(the fixnum
(sqlite-ffi:sqlite3-column-count
(handle stmt
))))
299 (declare (type fixnum i
))
300 (collect (statement-column-value stmt i
)))
305 (defun execute-to-list/named
(db sql
&rest parameters
)
306 "Executes the query SQL to the database DB with given PARAMETERS. Returns the results as list of lists.
308 PARAMETERS is a list of alternating parameters names and values.
312 \(execute-to-list db \"select id, user_name, real_name from users where user_name = :user_name\" \":user_name\" \"joe\")
314 \((1 \"joe\" \"Joe the User\")
315 (2 \"joe\" \"Another Joe\"))
317 See BIND-PARAMETER for the list of supported parameter types."
318 (declare (dynamic-extent parameters
))
319 (with-prepared-statement/named stmt
(db sql parameters
)
321 (loop (if (step-statement stmt
)
322 (push (iter (for i from
0 below
(the fixnum
(sqlite-ffi:sqlite3-column-count
(handle stmt
))))
323 (declare (type fixnum i
))
324 (collect (statement-column-value stmt i
)))
329 (defun execute-one-row-m-v (db sql
&rest parameters
)
330 "Executes the query SQL to the database DB with given PARAMETERS. Returns the first row as multiple values.
333 \(execute-one-row-m-v db \"select id, user_name, real_name from users where id = ?\" 1)
335 \(values 1 \"joe\" \"Joe the User\")
337 See BIND-PARAMETER for the list of supported parameter types."
338 (with-prepared-statement stmt
(db sql parameters
)
339 (if (step-statement stmt
)
340 (return-from execute-one-row-m-v
341 (values-list (iter (for i from
0 below
(the fixnum
(sqlite-ffi:sqlite3-column-count
(handle stmt
))))
342 (declare (type fixnum i
))
343 (collect (statement-column-value stmt i
)))))
344 (return-from execute-one-row-m-v
345 (values-list (loop repeat
(the fixnum
(sqlite-ffi:sqlite3-column-count
(handle stmt
))) collect nil
))))))
347 (defun execute-one-row-m-v/named
(db sql
&rest parameters
)
348 "Executes the query SQL to the database DB with given PARAMETERS. Returns the first row as multiple values.
350 PARAMETERS is a list of alternating parameters names and values.
353 \(execute-one-row-m-v db \"select id, user_name, real_name from users where id = :id\" \":id\" 1)
355 \(values 1 \"joe\" \"Joe the User\")
357 See BIND-PARAMETER for the list of supported parameter types."
358 (with-prepared-statement/named stmt
(db sql parameters
)
359 (if (step-statement stmt
)
360 (return-from execute-one-row-m-v
/named
361 (values-list (iter (for i from
0 below
(the fixnum
(sqlite-ffi:sqlite3-column-count
(handle stmt
))))
362 (declare (type fixnum i
))
363 (collect (statement-column-value stmt i
)))))
364 (return-from execute-one-row-m-v
/named
365 (values-list (loop repeat
(the fixnum
(sqlite-ffi:sqlite3-column-count
(handle stmt
))) collect nil
))))))
367 (defun statement-parameter-index (statement parameter-name
)
368 (sqlite-ffi:sqlite3-bind-parameter-index
(handle statement
) parameter-name
))
370 (defun bind-parameter (statement parameter value
)
371 "Sets the PARAMETER-th parameter in STATEMENT to the VALUE.
372 PARAMETER may be parameter index (starting from 1) or parameters name.
374 * NULL. Passed as NULL
375 * INTEGER. Passed as an 64-bit integer
376 * STRING. Passed as a string
377 * FLOAT. Passed as a double
378 * (VECTOR (UNSIGNED-BYTE 8)) and VECTOR that contains integers in range [0,256). Passed as a BLOB"
379 (let ((index (etypecase parameter
381 (string (statement-parameter-index statement parameter
)))))
382 (declare (type fixnum index
))
383 (let ((error-code (typecase value
384 (null (sqlite-ffi:sqlite3-bind-null
(handle statement
) index
))
385 (integer (sqlite-ffi:sqlite3-bind-int64
(handle statement
) index value
))
386 (double-float (sqlite-ffi:sqlite3-bind-double
(handle statement
) index value
))
387 (real (sqlite-ffi:sqlite3-bind-double
(handle statement
) index
(coerce value
'double-float
)))
388 (string (sqlite-ffi:sqlite3-bind-text
(handle statement
) index value -
1 (sqlite-ffi:destructor-transient
)))
389 ((vector (unsigned-byte 8)) (cffi:with-pointer-to-vector-data
(ptr value
)
390 (sqlite-ffi:sqlite3-bind-blob
(handle statement
) index ptr
(length value
) (sqlite-ffi:destructor-transient
))))
391 (vector (cffi:with-foreign-object
(array :unsigned-char
(length value
))
393 for i from
0 below
(length value
)
394 do
(setf (cffi:mem-aref array
:unsigned-char i
) (aref value i
)))
395 (sqlite-ffi:sqlite3-bind-blob
(handle statement
) index array
(length value
) (sqlite-ffi:destructor-transient
))))
398 (list "Do not know how to pass value ~A of type ~A to sqlite."
399 value
(type-of value
))
400 :statement statement
)))))
401 (unless (eq error-code
:ok
)
402 (sqlite-error error-code
403 (list "Error when binding parameter ~A to value ~A." parameter value
)
404 :statement statement
)))))
406 (defun execute-single (db sql
&rest parameters
)
407 "Executes the query SQL to the database DB with given PARAMETERS. Returns the first column of the first row as single value.
410 \(execute-single db \"select user_name from users where id = ?\" 1)
414 See BIND-PARAMETER for the list of supported parameter types."
415 (declare (dynamic-extent parameters
))
416 (with-prepared-statement stmt
(db sql parameters
)
417 (if (step-statement stmt
)
418 (statement-column-value stmt
0)
421 (defun execute-single/named
(db sql
&rest parameters
)
422 "Executes the query SQL to the database DB with given PARAMETERS. Returns the first column of the first row as single value.
424 PARAMETERS is a list of alternating parameters names and values.
427 \(execute-single db \"select user_name from users where id = :id\" \":id\" 1)
431 See BIND-PARAMETER for the list of supported parameter types."
432 (declare (dynamic-extent parameters
))
433 (with-prepared-statement/named stmt
(db sql parameters
)
434 (if (step-statement stmt
)
435 (statement-column-value stmt
0)
438 (defun last-insert-rowid (db)
439 "Returns the auto-generated ID of the last inserted row on the database connection DB."
440 (sqlite-ffi:sqlite3-last-insert-rowid
(handle db
)))
442 (defmacro with-transaction
(db &body body
)
443 "Wraps the BODY inside the transaction."
444 (let ((ok (gensym "TRANSACTION-COMMIT-"))
445 (db-var (gensym "DB-")))
448 (execute-non-query ,db-var
"begin transaction")
450 (multiple-value-prog1
454 (execute-non-query ,db-var
"commit transaction")
455 (execute-non-query ,db-var
"rollback transaction"))))))
457 (defmacro with-open-database
((db path
&key busy-timeout
) &body body
)
458 `(let ((,db
(connect ,path
:busy-timeout
,busy-timeout
)))
463 (defmacro-driver (FOR vars IN-SQLITE-QUERY query-expression ON-DATABASE db
&optional WITH-PARAMETERS parameters
)
464 (let ((statement (gensym "STATEMENT-"))
465 (kwd (if generate
'generate
'for
)))
466 `(progn (with ,statement
= (prepare-statement ,db
,query-expression
))
467 (finally-protected (when ,statement
(finalize-statement ,statement
)))
469 (list `(initially ,@(iter (for i from
1)
470 (for value in parameters
)
471 (collect `(sqlite:bind-parameter
,statement
,i
,value
))))))
472 (,kwd
,(if (symbolp vars
)
475 next
(progn (if (step-statement ,statement
)
476 (values ,@(iter (for i from
0 below
(if (symbolp vars
) 1 (length vars
)))
477 (collect `(statement-column-value ,statement
,i
))))
480 (defmacro-driver (FOR vars IN-SQLITE-QUERY
/NAMED query-expression ON-DATABASE db
&optional WITH-PARAMETERS parameters
)
481 (let ((statement (gensym "STATEMENT-"))
482 (kwd (if generate
'generate
'for
)))
483 `(progn (with ,statement
= (prepare-statement ,db
,query-expression
))
484 (finally-protected (when ,statement
(finalize-statement ,statement
)))
486 (list `(initially ,@(iter (for (name value
) on parameters by
#'cddr
)
487 (collect `(sqlite:bind-parameter
,statement
,name
,value
))))))
488 (,kwd
,(if (symbolp vars
)
491 next
(progn (if (step-statement ,statement
)
492 (values ,@(iter (for i from
0 below
(if (symbolp vars
) 1 (length vars
)))
493 (collect `(statement-column-value ,statement
,i
))))
497 (defmacro-driver (FOR vars ON-SQLITE-STATEMENT statement
)
498 (let ((statement-var (gensym "STATEMENT-"))
499 (kwd (if generate
'generate
'for
)))
500 `(progn (with ,statement-var
= ,statement
)
501 (,kwd
,(if (symbolp vars
)
504 next
(progn (if (step-statement ,statement-var
)
505 (values ,@(iter (for i from
0 below
(if (symbolp vars
) 1 (length vars
)))
506 (collect `(statement-column-value ,statement-var
,i
))))