sqlite.lisp

   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            :clear-statement-bindings
  19            :statement-column-value
  20            :statement-column-names
  21            :statement-bind-parameter-names
  22            :bind-parameter
  23            :execute-non-query
  24            :execute-to-list
  25            :execute-single
  26            :execute-one-row-m-v
  27            :last-insert-rowid
  28            :with-transaction
  29            :with-open-database))
  30
  31 (in-package :sqlite)
  32
  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)))
  44
  45 (define-condition sqlite-constraint-error (sqlite-error)
  46   ())
  47
  48 (defun sqlite-error (error-code message &key
  49                      statement
  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
  54              'sqlite-error)
  55          :format-control (if (listp message) (first message) message)
  56          :format-arguments (if (listp message) (rest message))
  57          :db-handle db-handle
  58          :error-code error-code
  59          :error-msg (if (and db-handle error-code)
  60                         (sqlite-ffi:sqlite3-errmsg (handle db-handle)))
  61          :statement statement
  62          :sql sql-text))
  63
  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)))))
  77
  78 ;(declaim (optimize (speed 3) (safety 0) (debug 0)))
  79
  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."))
  86
  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)))
  95
  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))))))
 103     (when busy-timeout
 104       (set-busy-timeout db busy-timeout))
 105     db))
 106
 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))
 110
 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)))
 122
 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."))
 132
 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))))))))
 152
 153 (defun prepare-statement (db sql)
 154   "Prepare the statement to the DB that will execute the commands that are in SQL.
 155
 156 Returns the SQLITE-STATEMENT.
 157
 158 SQL must contain exactly one statement.
 159 SQL may have some positional (not named) parameters specified with question marks.
 160
 161 Example:
 162
 163  select name from users where id = ?"
 164   (or (let ((statement (sqlite.cache:get-from-cache (cache db) sql)))
 165         (when statement
 166           (clear-statement-bindings statement))
 167         statement)
 168       (let ((statement (make-instance 'sqlite-statement :db db :sql sql)))
 169         (push statement (sqlite-handle-statements db))
 170         statement)))
 171
 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))
 177
 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))
 183
 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))))
 188     (case error-code
 189       (:done nil)
 190       (:row t)
 191       (t
 192        (sqlite-error error-code "Error while stepping an sqlite statement." :statement statement)))))
 193
 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))))
 199
 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))))
 206
 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.
 209 Returns:
 210  * NIL for NULL
 211  * INTEGER for integers
 212  * DOUBLE-FLOAT for floats
 213  * STRING for text
 214  * (SIMPLE-ARRAY (UNSIGNED-BYTE 8)) for BLOBs"
 215   (let ((type (sqlite-ffi:sqlite3-column-type (handle statement) column-number)))
 216     (ecase type
 217       (:null nil)
 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)))
 224                (loop
 225                   for i below blob-length
 226                   do (setf (aref result i) (cffi:mem-aref blob :unsigned-char i)))
 227                result)))))
 228
 229 (defun execute-non-query (db sql &rest parameters)
 230   "Executes the query SQL to the database DB with given PARAMETERS. Returns nothing.
 231
 232 Example:
 233
 234 \(execute-non-query db \"insert into users (user_name, real_name) values (?, ?)\" \"joe\" \"Joe the User\")
 235
 236 See BIND-PARAMETER for the list of supported parameter types."
 237   (declare (dynamic-extent parameters))
 238   (let ((stmt (prepare-statement db sql)))
 239     (iter (for i from 1)
 240           (declare (type fixnum i))
 241           (for value in parameters)
 242           (bind-parameter stmt i value))
 243     (step-statement stmt)
 244     (finalize-statement stmt)
 245     (values)))
 246
 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.
 249
 250 Example:
 251
 252 \(execute-to-list db \"select id, user_name, real_name from users where user_name = ?\" \"joe\")
 253 =>
 254 \((1 \"joe\" \"Joe the User\")
 255  (2 \"joe\" \"Another Joe\"))
 256
 257 See BIND-PARAMETER for the list of supported parameter types."
 258   (declare (dynamic-extent parameters))
 259   (let ((stmt (prepare-statement db sql))
 260         result)
 261     (iter (for i from 1)
 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)))
 269                     result)
 270               (return)))
 271     (finalize-statement stmt)
 272     (nreverse result)))
 273
 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.
 276
 277 Example:
 278 \(execute-one-row-m-v db \"select id, user_name, real_name from users where id = ?\" 1)
 279 =>
 280 \(values 1 \"joe\" \"Joe the User\")
 281
 282 See BIND-PARAMETER for the list of supported parameter types."
 283   (let ((stmt (prepare-statement db sql)))
 284     (unwind-protect
 285          (progn
 286            (iter (for i from 1)
 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))))
 298
 299 (defun statement-parameter-index (statement parameter-name)
 300   (sqlite-ffi:sqlite3-bind-parameter-index (handle statement) parameter-name))
 301
 302 (defun bind-parameter (statement parameter value)
 303   "Sets the PARAMETER-th parameter in STATEMENT to the VALUE.
 304 Parameters are numbered from one.
 305 Supported types:
 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
 312                  (integer 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))
 324                                   (loop
 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))))
 328                         (t
 329                          (sqlite-error nil
 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)))))
 337
 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.
 340
 341 Example:
 342 \(execute-single db \"select user_name from users where id = ?\" 1)
 343 =>
 344 \"joe\"
 345
 346 See BIND-PARAMETER for the list of supported parameter types."
 347   (declare (dynamic-extent parameters))
 348   (let ((stmt (prepare-statement db sql)))
 349     (unwind-protect
 350          (progn
 351            (iter (for i from 1)
 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)
 357                nil))
 358       (finalize-statement stmt))))
 359
 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)))
 363
 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-")))
 368     `(let (,ok
 369            (,db-var ,db))
 370        (execute-non-query ,db-var "begin transaction")
 371        (unwind-protect
 372             (multiple-value-prog1
 373                 (progn ,@body)
 374               (setf ,ok t))
 375          (if ,ok
 376              (execute-non-query ,db-var "commit transaction")
 377              (execute-non-query ,db-var "rollback transaction"))))))
 378
 379 (defmacro with-open-database ((db path &key busy-timeout) &body body)
 380   `(let ((,db (connect ,path :busy-timeout ,busy-timeout)))
 381      (unwind-protect
 382           (progn ,@body)
 383        (disconnect ,db))))
 384
 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)))
 390             ,@(when parameters
 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)
 395                        `(values ,vars)
 396                        `(values ,@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))))
 400                                   (terminate)))))))
 401
 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)
 407                        `(values ,vars)
 408                        `(values ,@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))))
 412                                   (terminate)))))))