sqlite.lisp

   1 (defpackage :sqlite
   2   (:use :cl :iter)
   3   (:export :sqlite-handle
   4            :connect
   5            :set-busy-timeout
   6            :disconnect
   7            :sqlite-statement
   8            :prepare-statement
   9            :finalize-statement
  10            :step-statement
  11            :reset-statement
  12            :statement-column-value
  13            :statement-column-names
  14            :statement-bind-parameter-names
  15            :bind-parameter
  16            :execute-non-query
  17            :execute-to-list
  18            :execute-single
  19            :execute-one-row-m-v
  20            :last-insert-rowid
  21            :with-transaction
  22            :with-open-database))
  23
  24 (in-package :sqlite)
  25
  26 ;(declaim (optimize (speed 3) (safety 0) (debug 0)))
  27
  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."))
  34
  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)))
  44
  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))))))
  52     (when busy-timeout
  53       (set-busy-timeout db busy-timeout))
  54     db))
  55
  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))
  59
  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)))
  71
  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."))
  81
  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))))))))
 100
 101 (defun prepare-statement (db sql)
 102   "Prepare the statement to the DB that will execute the commands that are in SQL.
 103
 104 Returns the SQLITE-STATEMENT.
 105
 106 SQL must contain exactly one statement.
 107 SQL may have some positional (not named) parameters specified with question marks.
 108
 109 Example:
 110
 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))
 115         statement)))
 116
 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))
 122
 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."
 126   (progn
 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)))
 131
 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))))
 136     (case error-code
 137       (:done nil)
 138       (:row t)
 139       (t (error "When stepping statement ~A (sql: ~A), error ~A (~A)" statement (sql statement) error-code (sqlite-ffi:sqlite3-errmsg (handle (db statement))))))))
 140
 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)))))))
 146
 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.
 149 Returns:
 150  * NIL for NULL
 151  * INTEGER for integers
 152  * DOUBLE-FLOAT for floats
 153  * STRING for text
 154  * (SIMPLE-ARRAY (UNSIGNED-BYTE 8)) for BLOBs"
 155   (let ((type (sqlite-ffi:sqlite3-column-type (handle statement) column-number)))
 156     (ecase type
 157       (:null nil)
 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)))
 164                (loop
 165                   for i below blob-length
 166                   do (setf (aref result i) (cffi:mem-aref blob :unsigned-char i)))
 167                result)))))
 168
 169 (defun execute-non-query (db sql &rest parameters)
 170   "Executes the query SQL to the database DB with given PARAMETERS. Returns nothing.
 171
 172 Example:
 173
 174 \(execute-non-query db \"insert into users (user_name, real_name) values (?, ?)\" \"joe\" \"Joe the User\")
 175
 176 See BIND-PARAMETER for the list of supported parameter types."
 177   (declare (dynamic-extent parameters))
 178   (let ((stmt (prepare-statement db sql)))
 179     (iter (for i from 1)
 180           (declare (type fixnum i))
 181           (for value in parameters)
 182           (bind-parameter stmt i value))
 183     (step-statement stmt)
 184     (finalize-statement stmt)
 185     (values)))
 186
 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.
 189
 190 Example:
 191
 192 \(execute-to-list db \"select id, user_name, real_name from users where user_name = ?\" \"joe\")
 193 =>
 194 \((1 \"joe\" \"Joe the User\")
 195  (2 \"joe\" \"Another Joe\"))
 196
 197 See BIND-PARAMETER for the list of supported parameter types."
 198   (declare (dynamic-extent parameters))
 199   (let ((stmt (prepare-statement db sql))
 200         result)
 201     (iter (for i from 1)
 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)))
 209                     result)
 210               (return)))
 211     (finalize-statement stmt)
 212     (nreverse result)))
 213
 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.
 216
 217 Example:
 218 \(execute-one-row-m-v db \"select id, user_name, real_name from users where id = ?\" 1)
 219 =>
 220 \(values 1 \"joe\" \"Joe the User\")
 221
 222 See BIND-PARAMETER for the list of supported parameter types."
 223   (let ((stmt (prepare-statement db sql)))
 224     (unwind-protect
 225          (progn
 226            (iter (for i from 1)
 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))))
 238
 239 (defun statement-parameter-index (statement parameter-name)
 240   (sqlite-ffi:sqlite3-bind-parameter-index (handle statement) parameter-name))
 241
 242 (defun bind-parameter (statement parameter value)
 243   "Sets the PARAMETER-th parameter in STATEMENT to the VALUE.
 244 Parameters are numbered from one.
 245 Supported types:
 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
 252                  (integer 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))
 264                                   (loop
 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))))))))
 271
 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.
 274
 275 Example:
 276 \(execute-single db \"select user_name from users where id = ?\" 1)
 277 =>
 278 \"joe\"
 279
 280 See BIND-PARAMETER for the list of supported parameter types."
 281   (declare (dynamic-extent parameters))
 282   (let ((stmt (prepare-statement db sql)))
 283     (unwind-protect
 284          (progn
 285            (iter (for i from 1)
 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)
 291                nil))
 292       (finalize-statement stmt))))
 293
 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)))
 297
 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     `(let (,ok
 303            (,db-var ,db))
 304        (execute-non-query ,db-var "begin transaction")
 305        (unwind-protect
 306             (multiple-value-prog1
 307                 (progn ,@body)
 308               (setf ,ok t))
 309          (if ,ok
 310              (execute-non-query ,db-var "commit transaction")
 311              (execute-non-query ,db-var "rollback transaction"))))))
 312
 313 (defmacro with-open-database ((db path &key busy-timeout) &body body)
 314   `(let ((,db (connect ,path :busy-timeout ,busy-timeout)))
 315      (unwind-protect
 316           (progn ,@body)
 317        (disconnect ,db))))
 318
 319 (defmacro-driver (FOR vars IN-SQLITE-QUERY query-expression ON-DATABASE db &optional WITH-PARAMETERS parameters)
 320   (let ((statement (gensym "STATEMENT-"))
 321         (kwd (if generate 'generate 'for)))
 322     `(progn (with ,statement = (prepare-statement ,db ,query-expression))
 323             (finally-protected (when ,statement (finalize-statement ,statement)))
 324             ,@(when parameters
 325                     (list `(initially ,@(iter (for i from 1)
 326                                               (for value in parameters)
 327                                               (collect `(sqlite:bind-parameter ,statement ,i ,value))))))
 328             (,kwd ,(if (symbolp vars)
 329                        `(values ,vars)
 330                        `(values ,@vars))
 331                   next (progn (if (step-statement ,statement)
 332                                   (values ,@(iter (for i from 0 below (if (symbolp vars) 1 (length vars)))
 333                                                   (collect `(statement-column-value ,statement ,i))))
 334                                   (terminate)))))))
 335
 336 (defmacro-driver (FOR vars ON-SQLITE-STATEMENT statement)
 337   (let ((statement-var (gensym "STATEMENT-"))
 338         (kwd (if generate 'generate 'for)))
 339     `(progn (with ,statement-var = ,statement)
 340             (,kwd ,(if (symbolp vars)
 341                        `(values ,vars)
 342                        `(values ,@vars))
 343                   next (progn (if (step-statement ,statement-var)
 344                                   (values ,@(iter (for i from 0 below (if (symbolp vars) 1 (length vars)))
 345                                                   (collect `(statement-column-value ,statement-var ,i))))
 346                                   (terminate)))))))