Implement a custom error condition for SQLite.
[cl-sqlite.git] / sqlite.lisp
blobcaa7d4019cedef003522e118ca0ec0cc2118c94a
1 (defpackage :sqlite
2 (:use :cl :iter)
3 (:export :sqlite-error
4 :sqlite-constraint-error
5 :sqlite-error-db-handle
6 :sqlite-error-code
7 :sqlite-error-message
8 :sqlite-error-sql
9 :sqlite-handle
10 :connect
11 :set-busy-timeout
12 :disconnect
13 :sqlite-statement
14 :prepare-statement
15 :finalize-statement
16 :step-statement
17 :reset-statement
18 :statement-column-value
19 :statement-column-names
20 :statement-bind-parameter-names
21 :bind-parameter
22 :execute-non-query
23 :execute-to-list
24 :execute-single
25 :execute-one-row-m-v
26 :last-insert-rowid
27 :with-transaction
28 :with-open-database))
30 (in-package :sqlite)
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)
45 ())
47 (defun sqlite-error (error-code message &key
48 statement
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
53 'sqlite-error)
54 :format-control (if (listp message) (first message) message)
55 :format-arguments (if (listp message) (rest message))
56 :db-handle db-handle
57 :error-code error-code
58 :error-msg (if db-handle
59 (sqlite-ffi:sqlite3-errmsg (handle db-handle)))
60 :statement statement
61 :sql sql-text))
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))))))
102 (when busy-timeout
103 (set-busy-timeout db busy-timeout))
104 db))
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.
160 Example:
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))
166 statement)))
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))))
184 (case error-code
185 (:done nil)
186 (:row t)
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.
198 Returns:
199 * NIL for NULL
200 * INTEGER for integers
201 * DOUBLE-FLOAT for floats
202 * STRING for text
203 * (SIMPLE-ARRAY (UNSIGNED-BYTE 8)) for BLOBs"
204 (let ((type (sqlite-ffi:sqlite3-column-type (handle statement) column-number)))
205 (ecase type
206 (:null nil)
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)))
213 (loop
214 for i below blob-length
215 do (setf (aref result i) (cffi:mem-aref blob :unsigned-char i)))
216 result)))))
218 (defun execute-non-query (db sql &rest parameters)
219 "Executes the query SQL to the database DB with given PARAMETERS. Returns nothing.
221 Example:
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)))
228 (iter (for i from 1)
229 (declare (type fixnum i))
230 (for value in parameters)
231 (bind-parameter stmt i value))
232 (step-statement stmt)
233 (finalize-statement stmt)
234 (values)))
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.
239 Example:
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))
249 result)
250 (iter (for i from 1)
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)))
258 result)
259 (return)))
260 (finalize-statement stmt)
261 (nreverse result)))
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.
266 Example:
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)))
273 (unwind-protect
274 (progn
275 (iter (for i from 1)
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.
294 Supported types:
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
301 (integer 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))
313 (loop
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))))
318 (sqlite-error nil
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.
330 Example:
331 \(execute-single db \"select user_name from users where id = ?\" 1)
333 \"joe\"
335 See BIND-PARAMETER for the list of supported parameter types."
336 (declare (dynamic-extent parameters))
337 (let ((stmt (prepare-statement db sql)))
338 (unwind-protect
339 (progn
340 (iter (for i from 1)
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)
346 nil))
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-")))
357 `(let (,ok
358 (,db-var ,db))
359 (execute-non-query ,db-var "begin transaction")
360 (unwind-protect
361 (multiple-value-prog1
362 (progn ,@body)
363 (setf ,ok t))
364 (if ,ok
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)))
370 (unwind-protect
371 (progn ,@body)
372 (disconnect ,db))))
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)))
379 ,@(when parameters
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)
384 `(values ,vars)
385 `(values ,@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))))
389 (terminate)))))))
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)
396 `(values ,vars)
397 `(values ,@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))))
401 (terminate)))))))