3 (:export
:sqlite-handle
12 :statement-column-value
13 :statement-column-names
14 :statement-bind-parameter-names
26 ;(declaim (optimize (speed 3) (safety 0) (debug 0)))
28 (defclass sqlite-handle
()
29 ((handle :accessor handle
)
30 (database-path :accessor database-path
)
31 (cache :accessor cache
)
32 (statements :initform nil
:accessor sqlite-handle-statements
))
33 (:documentation
"Class that encapsulates the connection to the database. Use connect and disconnect."))
35 (defmethod initialize-instance :after
((object sqlite-handle
) &key
(database-path ":memory:") &allow-other-keys
)
36 (cffi:with-foreign-object
(ppdb 'sqlite-ffi
:p-sqlite3
)
37 (let ((error-code (sqlite-ffi:sqlite3-open database-path ppdb
)))
38 (if (eq error-code
:ok
)
39 (setf (handle object
) (cffi:mem-ref ppdb
'sqlite-ffi
:p-sqlite3
)
40 (database-path object
) database-path
)
41 (error "Received error code ~A when trying to open sqlite3 database ~A"
42 error-code database-path
))))
43 (setf (cache object
) (make-instance 'sqlite.cache
:mru-cache
:cache-size
16 :destructor
#'really-finalize-statement
)))
45 (defun connect (database-path &key busy-timeout
)
46 "Connect to the sqlite database at the given DATABASE-PATH. Returns the SQLITE-HANDLE connected to the database. Use DISCONNECT to disconnect.
47 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."
48 (let ((db (make-instance 'sqlite-handle
49 :database-path
(etypecase database-path
50 (string database-path
)
51 (pathname (namestring database-path
))))))
53 (set-busy-timeout db busy-timeout
))
56 (defun set-busy-timeout (db milliseconds
)
57 "Sets the maximum amount of time to wait for a locked database."
58 (sqlite-ffi:sqlite3-busy-timeout
(handle db
) milliseconds
))
60 (defun disconnect (handle)
61 "Disconnects the given HANDLE from the database. All further operations on the handle are invalid."
62 (sqlite.cache
:purge-cache
(cache handle
))
63 (iter (with statements
= (copy-list (sqlite-handle-statements handle
)))
64 (declare (dynamic-extent statements
))
65 (for statement in statements
)
66 (really-finalize-statement statement
))
67 (let ((error-code (sqlite-ffi:sqlite3-close
(handle handle
))))
68 (unless (eq error-code
:ok
)
69 (error "Received error code ~A when trying to close ~A (connected to ~A)" error-code handle
(database-path handle
)))
70 (slot-makunbound handle
'handle
)))
72 (defclass sqlite-statement
()
73 ((db :reader db
:initarg
:db
)
74 (handle :accessor handle
)
75 (sql :reader sql
:initarg
:sql
)
76 (columns-count :accessor resultset-columns-count
)
77 (columns-names :accessor resultset-columns-names
:reader statement-column-names
)
78 (parameters-count :accessor parameters-count
)
79 (parameters-names :accessor parameters-names
:reader statement-bind-parameter-names
))
80 (:documentation
"Class that represents the prepared statement."))
82 (defmethod initialize-instance :after
((object sqlite-statement
) &key
&allow-other-keys
)
83 (cffi:with-foreign-object
(p-statement 'sqlite-ffi
:p-sqlite3-stmt
)
84 (cffi:with-foreign-object
(p-tail '(:pointer
:char
))
85 (cffi:with-foreign-string
(sql (sql object
))
86 (let ((error-code (sqlite-ffi:sqlite3-prepare
(handle (db object
)) sql -
1 p-statement p-tail
)))
87 (unless (eq error-code
:ok
)
88 (error "Error when trying to prepare sqlite statement '~A'. Code: ~A, message: ~A" (sql object
) error-code
(sqlite-ffi:sqlite3-errmsg
(handle (db object
)))))
89 (unless (zerop (cffi:mem-ref
(cffi:mem-ref p-tail
'(:pointer
:char
)) :uchar
))
90 (error "SQL string '~A' contains more than one SQL statements" (sql object
)))
91 (setf (handle object
) (cffi:mem-ref p-statement
'sqlite-ffi
:p-sqlite3-stmt
)
92 (resultset-columns-count object
) (sqlite-ffi:sqlite3-column-count
(handle object
))
93 (resultset-columns-names object
) (loop
94 for i below
(resultset-columns-count object
)
95 collect
(sqlite-ffi:sqlite3-column-name
(handle object
) i
))
96 (parameters-count object
) (sqlite-ffi:sqlite3-bind-parameter-count
(handle object
))
97 (parameters-names object
) (loop
98 for i from
1 to
(parameters-count object
)
99 collect
(sqlite-ffi:sqlite3-bind-parameter-name
(handle object
) i
))))))))
101 (defun prepare-statement (db sql
)
102 "Prepare the statement to the DB that will execute the commands that are in SQL.
104 Returns the SQLITE-STATEMENT.
106 SQL must contain exactly one statement.
107 SQL may have some positional (not named) parameters specified with question marks.
111 select name from users where id = ?"
112 (or (sqlite.cache
:get-from-cache
(cache db
) sql
)
113 (let ((statement (make-instance 'sqlite-statement
:db db
:sql sql
)))
114 (push statement
(sqlite-handle-statements db
))
117 (defun really-finalize-statement (statement)
118 (setf (sqlite-handle-statements (db statement
))
119 (delete statement
(sqlite-handle-statements (db statement
))))
120 (sqlite-ffi:sqlite3-finalize
(handle statement
))
121 (slot-makunbound statement
'handle
))
123 (defun finalize-statement (statement)
124 "Finalizes the statement and signals that associated resources may be released.
125 Note: does not immediately release resources because statements are cached."
127 (let ((error-code (sqlite-ffi:sqlite3-reset
(handle statement
))))
128 (unless (eq error-code
:ok
)
129 (error "When resetting statement ~A (sql: ~A), error ~A (~A)" statement
(sql statement
) error-code
(sqlite-ffi:sqlite3-errmsg
(handle (db statement
))))))
130 (sqlite.cache
:put-to-cache
(cache (db statement
)) (sql statement
) statement
)))
132 (defun step-statement (statement)
133 "Steps to the next row of the resultset of STATEMENT.
134 Returns T is successfully advanced to the next row and NIL if there are no more rows."
135 (let ((error-code (sqlite-ffi:sqlite3-step
(handle statement
))))
139 (t (error "When stepping statement ~A (sql: ~A), error ~A (~A)" statement
(sql statement
) error-code
(sqlite-ffi:sqlite3-errmsg
(handle (db statement
))))))))
141 (defun reset-statement (statement)
142 "Resets the STATEMENT and prepare it to be called again."
143 (let ((error-code (sqlite-ffi:sqlite3-reset
(handle statement
))))
144 (unless (eq error-code
:ok
)
145 (error "When resetting statment ~A (sql: ~A), error ~A (~A)" statement
(sql statement
) error-code
(sqlite-ffi:sqlite3-errmsg
(handle (db statement
)))))))
147 (defun statement-column-value (statement column-number
)
148 "Returns the COLUMN-NUMBER-th column's value of the current row of the STATEMENT. Columns are numbered from zero.
151 * INTEGER for integers
152 * DOUBLE-FLOAT for floats
154 * (SIMPLE-ARRAY (UNSIGNED-BYTE 8)) for BLOBs"
155 (let ((type (sqlite-ffi:sqlite3-column-type
(handle statement
) column-number
)))
158 (:text
(sqlite-ffi:sqlite3-column-text
(handle statement
) column-number
))
159 (:integer
(sqlite-ffi:sqlite3-column-int64
(handle statement
) column-number
))
160 (:float
(sqlite-ffi:sqlite3-column-double
(handle statement
) column-number
))
161 (:blob
(let* ((blob-length (sqlite-ffi:sqlite3-column-bytes
(handle statement
) column-number
))
162 (result (make-array (the fixnum blob-length
) :element-type
'(unsigned-byte 8)))
163 (blob (sqlite-ffi:sqlite3-column-blob
(handle statement
) column-number
)))
165 for i below blob-length
166 do
(setf (aref result i
) (cffi:mem-aref blob
:unsigned-char i
)))
169 (defun execute-non-query (db sql
&rest parameters
)
170 "Executes the query SQL to the database DB with given PARAMETERS. Returns nothing.
174 \(execute-non-query db \"insert into users (user_name, real_name) values (?, ?)\" \"joe\" \"Joe the User\")
176 See BIND-PARAMETER for the list of supported parameter types."
177 (declare (dynamic-extent parameters
))
178 (let ((stmt (prepare-statement db sql
)))
180 (declare (type fixnum i
))
181 (for value in parameters
)
182 (bind-parameter stmt i value
))
183 (step-statement stmt
)
184 (finalize-statement stmt
)
187 (defun execute-to-list (db sql
&rest parameters
)
188 "Executes the query SQL to the database DB with given PARAMETERS. Returns the results as list of lists.
192 \(execute-to-list db \"select id, user_name, real_name from users where user_name = ?\" \"joe\")
194 \((1 \"joe\" \"Joe the User\")
195 (2 \"joe\" \"Another Joe\"))
197 See BIND-PARAMETER for the list of supported parameter types."
198 (declare (dynamic-extent parameters
))
199 (let ((stmt (prepare-statement db sql
))
202 (declare (type fixnum i
))
203 (for value in parameters
)
204 (bind-parameter stmt i value
))
205 (loop (if (step-statement stmt
)
206 (push (iter (for i from
0 below
(the fixnum
(sqlite-ffi:sqlite3-column-count
(handle stmt
))))
207 (declare (type fixnum i
))
208 (collect (statement-column-value stmt i
)))
211 (finalize-statement stmt
)
214 (defun execute-one-row-m-v (db sql
&rest parameters
)
215 "Executes the query SQL to the database DB with given PARAMETERS. Returns the first row as multiple values.
218 \(execute-one-row-m-v db \"select id, user_name, real_name from users where id = ?\" 1)
220 \(values 1 \"joe\" \"Joe the User\")
222 See BIND-PARAMETER for the list of supported parameter types."
223 (let ((stmt (prepare-statement db sql
)))
227 (declare (type fixnum i
))
228 (for value in parameters
)
229 (bind-parameter stmt i value
))
230 (if (step-statement stmt
)
231 (return-from execute-one-row-m-v
232 (values-list (iter (for i from
0 below
(the fixnum
(sqlite-ffi:sqlite3-column-count
(handle stmt
))))
233 (declare (type fixnum i
))
234 (collect (statement-column-value stmt i
)))))
235 (return-from execute-one-row-m-v
236 (values-list (loop repeat
(the fixnum
(sqlite-ffi:sqlite3-column-count
(handle stmt
))) collect nil
)))))
237 (finalize-statement stmt
))))
239 (defun statement-parameter-index (statement parameter-name
)
240 (sqlite-ffi:sqlite3-bind-parameter-index
(handle statement
) parameter-name
))
242 (defun bind-parameter (statement parameter value
)
243 "Sets the PARAMETER-th parameter in STATEMENT to the VALUE.
244 Parameters are numbered from one.
246 * NULL. Passed as NULL
247 * INTEGER. Passed as an 64-bit integer
248 * STRING. Passed as a string
249 * FLOAT. Passed as a double
250 * (VECTOR (UNSIGNED-BYTE 8)) and VECTOR that contains integers in range [0,256). Passed as a BLOB"
251 (let ((index (etypecase parameter
253 (string (statement-parameter-index statement parameter
)))))
254 (declare (type fixnum index
))
255 (let ((error-code (typecase value
256 (null (sqlite-ffi:sqlite3-bind-null
(handle statement
) index
))
257 (integer (sqlite-ffi:sqlite3-bind-int64
(handle statement
) index value
))
258 (double-float (sqlite-ffi:sqlite3-bind-double
(handle statement
) index value
))
259 (real (sqlite-ffi:sqlite3-bind-double
(handle statement
) index
(coerce value
'double-float
)))
260 (string (sqlite-ffi:sqlite3-bind-text
(handle statement
) index value -
1 (sqlite-ffi:destructor-transient
)))
261 ((vector (unsigned-byte 8)) (cffi:with-pointer-to-vector-data
(ptr value
)
262 (sqlite-ffi:sqlite3-bind-blob
(handle statement
) index ptr
(length value
) (sqlite-ffi:destructor-transient
))))
263 (vector (cffi:with-foreign-object
(array :unsigned-char
(length value
))
265 for i from
0 below
(length value
)
266 do
(setf (cffi:mem-aref array
:unsigned-char i
) (aref value i
)))
267 (sqlite-ffi:sqlite3-bind-blob
(handle statement
) index array
(length value
) (sqlite-ffi:destructor-transient
))))
268 (t (error "Do not know how to pass value ~A of type ~A to sqlite" value
(type-of value
))))))
269 (unless (eq error-code
:ok
)
270 (error "When binding parameter ~A to value ~A for statment ~A (sql: ~A), error ~A (~A)" parameter value statement
(sql statement
) error-code
(sqlite-ffi:sqlite3-errmsg
(handle (db statement
))))))))
272 (defun execute-single (db sql
&rest parameters
)
273 "Executes the query SQL to the database DB with given PARAMETERS. Returns the first column of the first row as single value.
276 \(execute-single db \"select user_name from users where id = ?\" 1)
280 See BIND-PARAMETER for the list of supported parameter types."
281 (declare (dynamic-extent parameters
))
282 (let ((stmt (prepare-statement db sql
)))
286 (declare (type fixnum i
))
287 (for value in parameters
)
288 (bind-parameter stmt i value
))
289 (if (step-statement stmt
)
290 (statement-column-value stmt
0)
292 (finalize-statement stmt
))))
294 (defun last-insert-rowid (db)
295 "Returns the auto-generated ID of the last inserted row on the database connection DB."
296 (sqlite-ffi:sqlite3-last-insert-rowid
(handle db
)))
298 (defmacro with-transaction
(db &body body
)
299 "Wraps the BODY inside the transaction."
300 (let ((ok (gensym "TRANSACTION-COMMIT-"))
301 (db-var (gensym "DB-"))
302 (result (gensym "RESULT-")))
305 (execute-non-query ,db-var
"begin transaction")
308 (let ((,result
(progn
313 (execute-non-query ,db-var
"commit transaction")
314 (execute-non-query ,db-var
"rollback transaction"))))))
316 (defmacro with-open-database
((db path
&key busy-timeout
) &body body
)
317 `(let ((,db
(connect ,path
:busy-timeout
,busy-timeout
)))
322 (defmacro-driver (FOR vars IN-SQLITE-QUERY query-expression ON-DATABASE db
&optional WITH-PARAMETERS parameters
)
323 (let ((statement (gensym "STATEMENT-"))
324 (kwd (if generate
'generate
'for
)))
325 `(progn (with ,statement
= (prepare-statement ,db
,query-expression
))
326 (finally-protected (when ,statement
(finalize-statement ,statement
)))
328 (list `(initially ,@(iter (for i from
1)
329 (for value in parameters
)
330 (collect `(sqlite:bind-parameter
,statement
,i
,value
))))))
331 (,kwd
,(if (symbolp vars
)
334 next
(progn (if (step-statement ,statement
)
335 (values ,@(iter (for i from
0 below
(if (symbolp vars
) 1 (length vars
)))
336 (collect `(statement-column-value ,statement
,i
))))
339 (defmacro-driver (FOR vars ON-SQLITE-STATEMENT statement
)
340 (let ((statement-var (gensym "STATEMENT-"))
341 (kwd (if generate
'generate
'for
)))
342 `(progn (with ,statement-var
= ,statement
)
343 (,kwd
,(if (symbolp vars
)
346 next
(progn (if (step-statement ,statement-var
)
347 (values ,@(iter (for i from
0 below
(if (symbolp vars
) 1 (length vars
)))
348 (collect `(statement-column-value ,statement-var
,i
))))