4 :sqlite-constraint-error
5 :sqlite-error-db-handle
18 :statement-column-value
19 :statement-column-names
20 :statement-bind-parameter-names
32 (define-condition sqlite-error
(simple-error)
33 ((handle :initform nil
:initarg
:db-handle
34 :reader sqlite-error-db-handle
)
35 (error-code :initform nil
:initarg
:error-code
36 :reader sqlite-error-code
)
37 (error-msg :initform nil
:initarg
:error-msg
38 :reader sqlite-error-message
)
39 (statement :initform nil
:initarg
:statement
40 :reader sqlite-error-statement
)
41 (sql :initform nil
:initarg
:sql
42 :reader sqlite-error-sql
)))
44 (define-condition sqlite-constraint-error
(sqlite-error)
47 (defun sqlite-error (error-code message
&key
49 (db-handle (if statement
(db statement
)))
50 (sql-text (if statement
(sql statement
))))
51 (error (if (eq error-code
:constraint
)
52 'sqlite-constraint-error
54 :format-control
(if (listp message
) (first message
) message
)
55 :format-arguments
(if (listp message
) (rest message
))
57 :error-code error-code
58 :error-msg
(if db-handle
59 (sqlite-ffi:sqlite3-errmsg
(handle db-handle
)))
63 (defmethod print-object :after
((obj sqlite-error
) stream
)
64 (unless *print-escape
*
65 (when (or (and (sqlite-error-code obj
)
66 (not (eq (sqlite-error-code obj
) :ok
)))
67 (sqlite-error-message obj
))
68 (format stream
"~&Code ~A: ~A."
69 (or (sqlite-error-code obj
) :OK
)
70 (or (sqlite-error-message obj
) "no message")))
71 (when (sqlite-error-db-handle obj
)
72 (format stream
"~&Database: ~A"
73 (database-path (sqlite-error-db-handle obj
))))
74 (when (sqlite-error-sql obj
)
75 (format stream
"~&SQL: ~A" (sqlite-error-sql obj
)))))
77 ;(declaim (optimize (speed 3) (safety 0) (debug 0)))
79 (defclass sqlite-handle
()
80 ((handle :accessor handle
)
81 (database-path :accessor database-path
)
82 (cache :accessor cache
)
83 (statements :initform nil
:accessor sqlite-handle-statements
))
84 (:documentation
"Class that encapsulates the connection to the database. Use connect and disconnect."))
86 (defmethod initialize-instance :after
((object sqlite-handle
) &key
(database-path ":memory:") &allow-other-keys
)
87 (cffi:with-foreign-object
(ppdb 'sqlite-ffi
:p-sqlite3
)
88 (let ((error-code (sqlite-ffi:sqlite3-open database-path ppdb
)))
89 (if (eq error-code
:ok
)
90 (setf (handle object
) (cffi:mem-ref ppdb
'sqlite-ffi
:p-sqlite3
)
91 (database-path object
) database-path
)
92 (sqlite-error error-code
(list "Could not open sqlite3 database ~A" database-path
)))))
93 (setf (cache object
) (make-instance 'sqlite.cache
:mru-cache
:cache-size
16 :destructor
#'really-finalize-statement
)))
95 (defun connect (database-path &key busy-timeout
)
96 "Connect to the sqlite database at the given DATABASE-PATH. Returns the SQLITE-HANDLE connected to the database. Use DISCONNECT to disconnect.
97 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."
98 (let ((db (make-instance 'sqlite-handle
99 :database-path
(etypecase database-path
100 (string database-path
)
101 (pathname (namestring database-path
))))))
103 (set-busy-timeout db busy-timeout
))
106 (defun set-busy-timeout (db milliseconds
)
107 "Sets the maximum amount of time to wait for a locked database."
108 (sqlite-ffi:sqlite3-busy-timeout
(handle db
) milliseconds
))
110 (defun disconnect (handle)
111 "Disconnects the given HANDLE from the database. All further operations on the handle are invalid."
112 (sqlite.cache
:purge-cache
(cache handle
))
113 (iter (with statements
= (copy-list (sqlite-handle-statements handle
)))
114 (declare (dynamic-extent statements
))
115 (for statement in statements
)
116 (really-finalize-statement statement
))
117 (let ((error-code (sqlite-ffi:sqlite3-close
(handle handle
))))
118 (unless (eq error-code
:ok
)
119 (sqlite-error error-code
"Could not close sqlite3 database." :db-handle handle
))
120 (slot-makunbound handle
'handle
)))
122 (defclass sqlite-statement
()
123 ((db :reader db
:initarg
:db
)
124 (handle :accessor handle
)
125 (sql :reader sql
:initarg
:sql
)
126 (columns-count :accessor resultset-columns-count
)
127 (columns-names :accessor resultset-columns-names
:reader statement-column-names
)
128 (parameters-count :accessor parameters-count
)
129 (parameters-names :accessor parameters-names
:reader statement-bind-parameter-names
))
130 (:documentation
"Class that represents the prepared statement."))
132 (defmethod initialize-instance :after
((object sqlite-statement
) &key
&allow-other-keys
)
133 (cffi:with-foreign-object
(p-statement 'sqlite-ffi
:p-sqlite3-stmt
)
134 (cffi:with-foreign-object
(p-tail '(:pointer
:char
))
135 (cffi:with-foreign-string
(sql (sql object
))
136 (let ((error-code (sqlite-ffi:sqlite3-prepare
(handle (db object
)) sql -
1 p-statement p-tail
)))
137 (unless (eq error-code
:ok
)
138 (sqlite-error error-code
"Could not prepare an sqlite statement."
139 :db-handle
(db object
) :sql-text
(sql object
)))
140 (unless (zerop (cffi:mem-ref
(cffi:mem-ref p-tail
'(:pointer
:char
)) :uchar
))
141 (sqlite-error nil
"SQL string contains more than one SQL statement." :sql-text
(sql object
)))
142 (setf (handle object
) (cffi:mem-ref p-statement
'sqlite-ffi
:p-sqlite3-stmt
)
143 (resultset-columns-count object
) (sqlite-ffi:sqlite3-column-count
(handle object
))
144 (resultset-columns-names object
) (loop
145 for i below
(resultset-columns-count object
)
146 collect
(sqlite-ffi:sqlite3-column-name
(handle object
) i
))
147 (parameters-count object
) (sqlite-ffi:sqlite3-bind-parameter-count
(handle object
))
148 (parameters-names object
) (loop
149 for i from
1 to
(parameters-count object
)
150 collect
(sqlite-ffi:sqlite3-bind-parameter-name
(handle object
) i
))))))))
152 (defun prepare-statement (db sql
)
153 "Prepare the statement to the DB that will execute the commands that are in SQL.
155 Returns the SQLITE-STATEMENT.
157 SQL must contain exactly one statement.
158 SQL may have some positional (not named) parameters specified with question marks.
162 select name from users where id = ?"
163 (or (sqlite.cache
:get-from-cache
(cache db
) sql
)
164 (let ((statement (make-instance 'sqlite-statement
:db db
:sql sql
)))
165 (push statement
(sqlite-handle-statements db
))
168 (defun really-finalize-statement (statement)
169 (setf (sqlite-handle-statements (db statement
))
170 (delete statement
(sqlite-handle-statements (db statement
))))
171 (sqlite-ffi:sqlite3-finalize
(handle statement
))
172 (slot-makunbound statement
'handle
))
174 (defun finalize-statement (statement)
175 "Finalizes the statement and signals that associated resources may be released.
176 Note: does not immediately release resources because statements are cached."
177 (reset-statement statement
)
178 (sqlite.cache
:put-to-cache
(cache (db statement
)) (sql statement
) statement
))
180 (defun step-statement (statement)
181 "Steps to the next row of the resultset of STATEMENT.
182 Returns T is successfully advanced to the next row and NIL if there are no more rows."
183 (let ((error-code (sqlite-ffi:sqlite3-step
(handle statement
))))
188 (sqlite-error error-code
"Error while stepping an sqlite statement." :statement statement
)))))
190 (defun reset-statement (statement)
191 "Resets the STATEMENT and prepare it to be called again."
192 (let ((error-code (sqlite-ffi:sqlite3-reset
(handle statement
))))
193 (unless (eq error-code
:ok
)
194 (sqlite-error error-code
"Error while resetting an sqlite statement." :statement statement
))))
196 (defun statement-column-value (statement column-number
)
197 "Returns the COLUMN-NUMBER-th column's value of the current row of the STATEMENT. Columns are numbered from zero.
200 * INTEGER for integers
201 * DOUBLE-FLOAT for floats
203 * (SIMPLE-ARRAY (UNSIGNED-BYTE 8)) for BLOBs"
204 (let ((type (sqlite-ffi:sqlite3-column-type
(handle statement
) column-number
)))
207 (:text
(sqlite-ffi:sqlite3-column-text
(handle statement
) column-number
))
208 (:integer
(sqlite-ffi:sqlite3-column-int64
(handle statement
) column-number
))
209 (:float
(sqlite-ffi:sqlite3-column-double
(handle statement
) column-number
))
210 (:blob
(let* ((blob-length (sqlite-ffi:sqlite3-column-bytes
(handle statement
) column-number
))
211 (result (make-array (the fixnum blob-length
) :element-type
'(unsigned-byte 8)))
212 (blob (sqlite-ffi:sqlite3-column-blob
(handle statement
) column-number
)))
214 for i below blob-length
215 do
(setf (aref result i
) (cffi:mem-aref blob
:unsigned-char i
)))
218 (defun execute-non-query (db sql
&rest parameters
)
219 "Executes the query SQL to the database DB with given PARAMETERS. Returns nothing.
223 \(execute-non-query db \"insert into users (user_name, real_name) values (?, ?)\" \"joe\" \"Joe the User\")
225 See BIND-PARAMETER for the list of supported parameter types."
226 (declare (dynamic-extent parameters
))
227 (let ((stmt (prepare-statement db sql
)))
229 (declare (type fixnum i
))
230 (for value in parameters
)
231 (bind-parameter stmt i value
))
232 (step-statement stmt
)
233 (finalize-statement stmt
)
236 (defun execute-to-list (db sql
&rest parameters
)
237 "Executes the query SQL to the database DB with given PARAMETERS. Returns the results as list of lists.
241 \(execute-to-list db \"select id, user_name, real_name from users where user_name = ?\" \"joe\")
243 \((1 \"joe\" \"Joe the User\")
244 (2 \"joe\" \"Another Joe\"))
246 See BIND-PARAMETER for the list of supported parameter types."
247 (declare (dynamic-extent parameters
))
248 (let ((stmt (prepare-statement db sql
))
251 (declare (type fixnum i
))
252 (for value in parameters
)
253 (bind-parameter stmt i value
))
254 (loop (if (step-statement stmt
)
255 (push (iter (for i from
0 below
(the fixnum
(sqlite-ffi:sqlite3-column-count
(handle stmt
))))
256 (declare (type fixnum i
))
257 (collect (statement-column-value stmt i
)))
260 (finalize-statement stmt
)
263 (defun execute-one-row-m-v (db sql
&rest parameters
)
264 "Executes the query SQL to the database DB with given PARAMETERS. Returns the first row as multiple values.
267 \(execute-one-row-m-v db \"select id, user_name, real_name from users where id = ?\" 1)
269 \(values 1 \"joe\" \"Joe the User\")
271 See BIND-PARAMETER for the list of supported parameter types."
272 (let ((stmt (prepare-statement db sql
)))
276 (declare (type fixnum i
))
277 (for value in parameters
)
278 (bind-parameter stmt i value
))
279 (if (step-statement stmt
)
280 (return-from execute-one-row-m-v
281 (values-list (iter (for i from
0 below
(the fixnum
(sqlite-ffi:sqlite3-column-count
(handle stmt
))))
282 (declare (type fixnum i
))
283 (collect (statement-column-value stmt i
)))))
284 (return-from execute-one-row-m-v
285 (values-list (loop repeat
(the fixnum
(sqlite-ffi:sqlite3-column-count
(handle stmt
))) collect nil
)))))
286 (finalize-statement stmt
))))
288 (defun statement-parameter-index (statement parameter-name
)
289 (sqlite-ffi:sqlite3-bind-parameter-index
(handle statement
) parameter-name
))
291 (defun bind-parameter (statement parameter value
)
292 "Sets the PARAMETER-th parameter in STATEMENT to the VALUE.
293 Parameters are numbered from one.
295 * NULL. Passed as NULL
296 * INTEGER. Passed as an 64-bit integer
297 * STRING. Passed as a string
298 * FLOAT. Passed as a double
299 * (VECTOR (UNSIGNED-BYTE 8)) and VECTOR that contains integers in range [0,256). Passed as a BLOB"
300 (let ((index (etypecase parameter
302 (string (statement-parameter-index statement parameter
)))))
303 (declare (type fixnum index
))
304 (let ((error-code (typecase value
305 (null (sqlite-ffi:sqlite3-bind-null
(handle statement
) index
))
306 (integer (sqlite-ffi:sqlite3-bind-int64
(handle statement
) index value
))
307 (double-float (sqlite-ffi:sqlite3-bind-double
(handle statement
) index value
))
308 (real (sqlite-ffi:sqlite3-bind-double
(handle statement
) index
(coerce value
'double-float
)))
309 (string (sqlite-ffi:sqlite3-bind-text
(handle statement
) index value -
1 (sqlite-ffi:destructor-transient
)))
310 ((vector (unsigned-byte 8)) (cffi:with-pointer-to-vector-data
(ptr value
)
311 (sqlite-ffi:sqlite3-bind-blob
(handle statement
) index ptr
(length value
) (sqlite-ffi:destructor-transient
))))
312 (vector (cffi:with-foreign-object
(array :unsigned-char
(length value
))
314 for i from
0 below
(length value
)
315 do
(setf (cffi:mem-aref array
:unsigned-char i
) (aref value i
)))
316 (sqlite-ffi:sqlite3-bind-blob
(handle statement
) index array
(length value
) (sqlite-ffi:destructor-transient
))))
319 (list "Do not know how to pass value ~A of type ~A to sqlite."
320 value
(type-of value
))
321 :statement statement
)))))
322 (unless (eq error-code
:ok
)
323 (sqlite-error error-code
324 (list "Error when binding parameter ~A to value ~A." parameter value
)
325 :statement statement
)))))
327 (defun execute-single (db sql
&rest parameters
)
328 "Executes the query SQL to the database DB with given PARAMETERS. Returns the first column of the first row as single value.
331 \(execute-single db \"select user_name from users where id = ?\" 1)
335 See BIND-PARAMETER for the list of supported parameter types."
336 (declare (dynamic-extent parameters
))
337 (let ((stmt (prepare-statement db sql
)))
341 (declare (type fixnum i
))
342 (for value in parameters
)
343 (bind-parameter stmt i value
))
344 (if (step-statement stmt
)
345 (statement-column-value stmt
0)
347 (finalize-statement stmt
))))
349 (defun last-insert-rowid (db)
350 "Returns the auto-generated ID of the last inserted row on the database connection DB."
351 (sqlite-ffi:sqlite3-last-insert-rowid
(handle db
)))
353 (defmacro with-transaction
(db &body body
)
354 "Wraps the BODY inside the transaction."
355 (let ((ok (gensym "TRANSACTION-COMMIT-"))
356 (db-var (gensym "DB-")))
359 (execute-non-query ,db-var
"begin transaction")
361 (multiple-value-prog1
365 (execute-non-query ,db-var
"commit transaction")
366 (execute-non-query ,db-var
"rollback transaction"))))))
368 (defmacro with-open-database
((db path
&key busy-timeout
) &body body
)
369 `(let ((,db
(connect ,path
:busy-timeout
,busy-timeout
)))
374 (defmacro-driver (FOR vars IN-SQLITE-QUERY query-expression ON-DATABASE db
&optional WITH-PARAMETERS parameters
)
375 (let ((statement (gensym "STATEMENT-"))
376 (kwd (if generate
'generate
'for
)))
377 `(progn (with ,statement
= (prepare-statement ,db
,query-expression
))
378 (finally-protected (when ,statement
(finalize-statement ,statement
)))
380 (list `(initially ,@(iter (for i from
1)
381 (for value in parameters
)
382 (collect `(sqlite:bind-parameter
,statement
,i
,value
))))))
383 (,kwd
,(if (symbolp vars
)
386 next
(progn (if (step-statement ,statement
)
387 (values ,@(iter (for i from
0 below
(if (symbolp vars
) 1 (length vars
)))
388 (collect `(statement-column-value ,statement
,i
))))
391 (defmacro-driver (FOR vars ON-SQLITE-STATEMENT statement
)
392 (let ((statement-var (gensym "STATEMENT-"))
393 (kwd (if generate
'generate
'for
)))
394 `(progn (with ,statement-var
= ,statement
)
395 (,kwd
,(if (symbolp vars
)
398 next
(progn (if (step-statement ,statement-var
)
399 (values ,@(iter (for i from
0 below
(if (symbolp vars
) 1 (length vars
)))
400 (collect `(statement-column-value ,statement-var
,i
))))