sqlite.lisp

   1 (defpackage :sqlite
   2   (:use :cl :iter)
   3   (:export :sqlite-handle
   4            :connect
   5            :disconnect
   6            :sqlite-statement
   7            :prepare-statement
   8            :finalize-statement
   9            :step-statement
  10            :reset-statement
  11            :statement-column-value
  12            :bind-parameter
  13            :execute-non-query
  14            :execute-to-list
  15            :execute-single
  16            :execute-one-row-m-v
  17            :last-insert-rowid
  18            :with-transaction
  19            :with-open-database))
  20
  21 (in-package :sqlite)
  22
  23 ;(declaim (optimize (speed 3) (safety 0) (debug 0)))
  24
  25 (defclass sqlite-handle ()
  26   ((handle :accessor handle)
  27    (database-path :accessor database-path)
  28    (cache :accessor cache))
  29   (:documentation "Class that encapsulates the connection to the database. Use connect and disconnect."))
  30
  31 (defmethod initialize-instance :after ((object sqlite-handle) &key (database-path ":memory:") &allow-other-keys)
  32   (cffi:with-foreign-object (ppdb 'sqlite-ffi:p-sqlite3)
  33     (let ((error-code (sqlite-ffi:sqlite3-open database-path ppdb)))
  34       (if (eq error-code :ok)
  35           (setf (handle object) (cffi:mem-ref ppdb 'sqlite-ffi:p-sqlite3)
  36                 (database-path object) database-path)
  37           (error "Received error code ~A when trying to open sqlite3 database ~A"
  38                  error-code database-path))))
  39   (setf (cache object) (make-instance 'sqlite.cache:mru-cache :cache-size 16 :destructor #'really-finalize-statement)))
  40
  41 (defun connect (database-path)
  42   "Connect to the sqlite database at the given DATABASE-PATH. Returns the SQLITE-HANDLE connected to the database. Use DISCONNECT to disconnect."
  43   (make-instance 'sqlite-handle :database-path database-path))
  44
  45 (defun disconnect (handle)
  46   "Disconnects the given HANDLE from the database. All further operations on the handle are invalid."
  47   (sqlite.cache:purge-cache (cache handle))
  48   (iter (for p-stmt = (sqlite-ffi:sqlite3-next-stmt (handle handle) (cffi:null-pointer)))
  49         (until (cffi:null-pointer-p p-stmt))
  50         (sqlite-ffi:sqlite3-finalize p-stmt))
  51   (let ((error-code (sqlite-ffi:sqlite3-close (handle handle))))
  52     (unless (eq error-code :ok)
  53       (error "Received error code ~A when trying to close ~A (connected to ~A)" error-code handle (database-path handle)))))
  54
  55 (defclass sqlite-statement ()
  56   ((db :reader db :initarg :db)
  57    (handle :accessor handle)
  58    (sql :reader sql :initarg :sql)
  59    (columns-count :accessor resultset-columns-count)
  60    (columns-names :accessor resultset-columns-names)
  61    (parameters-count :accessor parameters-count)
  62    (parameters-names :accessor parameters-names))
  63   (:documentation "Class that represents the prepared statement."))
  64
  65 (defmethod initialize-instance :after ((object sqlite-statement) &key &allow-other-keys)
  66   (cffi:with-foreign-object (p-statement 'sqlite-ffi:p-sqlite3-stmt)
  67     (cffi:with-foreign-object (p-tail '(:pointer :char))
  68       (cffi:with-foreign-string (sql (sql object))
  69         (let ((error-code (sqlite-ffi:sqlite3-prepare (handle (db object)) sql -1 p-statement p-tail)))
  70           (unless (eq error-code :ok)
  71             (error "Error when trying to prepare sqlite statement '~A'. Code: ~A, message: ~A" (sql object) error-code (sqlite-ffi:sqlite3-errmsg (handle (db object)))))
  72           (unless (zerop (cffi:mem-ref (cffi:mem-ref p-tail '(:pointer :char)) :uchar))
  73             (error "SQL string '~A' contains more than one SQL statements" (sql object)))
  74           (setf (handle object) (cffi:mem-ref p-statement 'sqlite-ffi:p-sqlite3-stmt)
  75                 (resultset-columns-count object) (sqlite-ffi:sqlite3-column-count (handle object))
  76                 (resultset-columns-names object) (loop
  77                                                     for i below (resultset-columns-count object)
  78                                                     collect (sqlite-ffi:sqlite3-column-name (handle object) i))
  79                 (parameters-count object) (sqlite-ffi:sqlite3-bind-parameter-count (handle object))
  80                 (parameters-names object) (loop
  81                                              for i from 1 to (parameters-count object)
  82                                              collect (sqlite-ffi:sqlite3-bind-parameter-name (handle object) i))))))))
  83
  84 (defun prepare-statement (db sql)
  85   "Prepare the statement to the DB that will execute the commands that are in SQL.
  86
  87 Returns the SQLITE-STATEMENT.
  88
  89 SQL must contain exactly one statement.
  90 SQL may have some positional (not named) parameters specified with question marks.
  91
  92 Example:
  93
  94  select name from users where id = ?"
  95   #+nil(make-instance 'sqlite-statement :db db :sql sql)
  96   (or (sqlite.cache:get-from-cache (cache db) sql)
  97       (make-instance 'sqlite-statement :db db :sql sql)))
  98
  99 (defun really-finalize-statement (statement)
 100   (sqlite-ffi:sqlite3-finalize (handle statement)))
 101
 102 (defun finalize-statement (statement)
 103   "Finalizes the statement and signals that associated resources may be released.
 104 Note: does not immediately release resources because statements are cached."
 105   #+nil(really-finalize-statement statement)
 106   (progn
 107     (let ((error-code (sqlite-ffi:sqlite3-reset (handle statement))))
 108      (unless (eq error-code :ok)
 109        (error "When resetting statement ~A (sql: ~A), error ~A (~A)" statement (sql statement) error-code (sqlite-ffi:sqlite3-errmsg (handle (db statement))))))
 110     #+nil(let ((error-code (sqlite-ffi:sqlite3-clear-bindings (handle statement))))
 111       (unless (eq error-code :ok)
 112         (error "When resetting statement ~A (sql: ~A), error ~A (~A)" statement (sql statement) error-code (sqlite-ffi:sqlite3-errmsg (handle (db statement))))))
 113     (sqlite.cache:put-to-cache (cache (db statement)) (sql statement) statement)))
 114
 115 (defun step-statement (statement)
 116   "Steps to the next row of the resultset of STATEMENT.
 117 Returns T is successfully advanced to the next row and NIL if there are no more rows."
 118   (let ((error-code (sqlite-ffi:sqlite3-step (handle statement))))
 119     (case error-code
 120       (:done nil)
 121       (:row t)
 122       (t (error "When stepping statement ~A (sql: ~A), error ~A (~A)" statement (sql statement) error-code (sqlite-ffi:sqlite3-errmsg (handle (db statement))))))))
 123
 124 (defun reset-statement (statement)
 125   "Resets the STATEMENT and prepare it to be called again."
 126   (let ((error-code (sqlite-ffi:sqlite3-reset (handle statement))))
 127     (unless (eq error-code :ok)
 128       (error "When resetting statment ~A (sql: ~A), error ~A (~A)" statement (sql statement) error-code (sqlite-ffi:sqlite3-errmsg (handle (db statement)))))))
 129
 130 (defun statement-column-value (statement column-number)
 131   "Returns the COLUMN-NUMBER-th column's value of the current row of the STATEMENT. Columns are numbered from zero.
 132 Returns:
 133  * NIL for NULL
 134  * INTEGER for integers
 135  * DOUBLE-FLOAT for floats
 136  * STRING for text
 137  * (SIMPLE-ARRAY (UNSIGNED-BYTE 8)) for BLOBs"
 138   (let ((type (sqlite-ffi:sqlite3-column-type (handle statement) column-number)))
 139     (ecase type
 140       (:null nil)
 141       (:text (sqlite-ffi:sqlite3-column-text (handle statement) column-number))
 142       (:integer (sqlite-ffi:sqlite3-column-int64 (handle statement) column-number))
 143       (:float (sqlite-ffi:sqlite3-column-double (handle statement) column-number))
 144       (:blob (let* ((blob-length (sqlite-ffi:sqlite3-column-bytes (handle statement) column-number))
 145                     (result (make-array (the fixnum blob-length) :element-type '(unsigned-byte 8)))
 146                     (blob (sqlite-ffi:sqlite3-column-blob (handle statement) column-number)))
 147                (loop
 148                   for i below blob-length
 149                   do (setf (aref result i) (cffi:mem-aref blob :unsigned-char i)))
 150                result)))))
 151
 152 (defun execute-non-query (db sql &rest parameters)
 153   "Executes the query SQL to the database DB with given PARAMETERS. Returns nothing.
 154
 155 Example:
 156
 157 (execute-non-query db \"insert into users (user_name, real_name) values (?, ?)\" \"joe\" \"Joe the User\")
 158
 159 See BIND-PARAMETER for the list of supported parameter types."
 160   (declare (dynamic-extent parameters))
 161   (let ((stmt (prepare-statement db sql)))
 162     (iter (for i from 1)
 163           (declare (type fixnum i))
 164           (for value in parameters)
 165           (bind-parameter stmt i value))
 166     (step-statement stmt)
 167     (finalize-statement stmt)
 168     (values)))
 169
 170 (defun execute-to-list (db sql &rest parameters)
 171   "Executes the query SQL to the database DB with given PARAMETERS. Returns the results as list of lists.
 172
 173 Example:
 174
 175 (execute-to-list db \"select id, user_name, real_name from users where user_name = ?\" \"joe\")
 176 =>
 177 ((1 \"joe\" \"Joe the User\")
 178  (2 \"joe\" \"Another Joe\"))
 179
 180 See BIND-PARAMETER for the list of supported parameter types."
 181   (declare (dynamic-extent parameters))
 182   (let ((stmt (prepare-statement db sql))
 183         result)
 184     (iter (for i from 1)
 185           (declare (type fixnum i))
 186           (for value in parameters)
 187           (bind-parameter stmt i value))
 188     (loop (if (step-statement stmt)
 189               (push (iter (for i from 0 below (the fixnum (sqlite-ffi:sqlite3-column-count (handle stmt))))
 190                           (declare (type fixnum i))
 191                           (collect (statement-column-value stmt i)))
 192                     result)
 193               (return)))
 194     (finalize-statement stmt)
 195     (nreverse result)))
 196
 197 (defun execute-one-row-m-v (db sql &rest parameters)
 198   "Executes the query SQL to the database DB with given PARAMETERS. Returns the first row as multiple values.
 199
 200 Example:
 201 (execute-one-row-m-v db \"select id, user_name, real_name from users where id = ?\" 1)
 202 =>
 203 (values 1 \"joe\" \"Joe the User\")
 204
 205 See BIND-PARAMETER for the list of supported parameter types."
 206   (let ((stmt (prepare-statement db sql)))
 207     (unwind-protect
 208          (progn
 209            (iter (for i from 1)
 210                  (declare (type fixnum i))
 211                  (for value in parameters)
 212                  (bind-parameter stmt i value))
 213            (if (step-statement stmt)
 214                (return-from execute-one-row-m-v
 215                  (values-list (iter (for i from 0 below (the fixnum (sqlite-ffi:sqlite3-column-count (handle stmt))))
 216                                     (declare (type fixnum i))
 217                                     (collect (statement-column-value stmt i)))))
 218                (return-from execute-one-row-m-v
 219                  (values-list (loop repeat (the fixnum (sqlite-ffi:sqlite3-column-count (handle stmt))) collect nil)))))
 220       (finalize-statement stmt))))
 221
 222 (defun statement-parameter-index (statement parameter-name)
 223   (sqlite-ffi:sqlite3-bind-parameter-index (handle statement) parameter-name))
 224
 225 (defun bind-parameter (statement parameter value)
 226   "Sets the PARAMETER-th parameter in STATEMENT to the VALUE.
 227 Parameters are numbered from one.
 228 Supported types:
 229  * NULL. Passed as NULL
 230  * INTEGER. Passed as an 64-bit integer
 231  * STRING. Passed as a string
 232  * FLOAT. Passed as a double
 233  * (VECTOR (UNSIGNED-BYTE 8)) and VECTOR that contains integers in range [0,256). Passed as a BLOB"
 234   (let ((index (etypecase parameter
 235                  (integer parameter)
 236                  (string (statement-parameter-index statement parameter)))))
 237     (declare (type fixnum index))
 238     (let ((error-code (typecase value
 239                         (null (sqlite-ffi:sqlite3-bind-null (handle statement) index))
 240                         (integer (sqlite-ffi:sqlite3-bind-int64 (handle statement) index value))
 241                         (single-float (sqlite-ffi:sqlite3-bind-double (handle statement) index (coerce value 'double-float)))
 242                         (double-float (sqlite-ffi:sqlite3-bind-double (handle statement) index value))
 243                         (string (sqlite-ffi:sqlite3-bind-text (handle statement) index value -1 (sqlite-ffi:destructor-transient)))
 244                         ((vector (unsigned-byte 8)) (cffi:with-pointer-to-vector-data (ptr value)
 245                                                       (sqlite-ffi:sqlite3-bind-blob (handle statement) index ptr (length value) (sqlite-ffi:destructor-transient))))
 246                         (vector (cffi:with-foreign-object (array :unsigned-char (length value))
 247                                   (loop
 248                                      for i from 0 below (length value)
 249                                      do (setf (cffi:mem-aref array :unsigned-char i) (aref value i)))
 250                                   (sqlite-ffi:sqlite3-bind-blob (handle statement) index array (length value) (sqlite-ffi:destructor-transient))))
 251                         (t (error "Do not know how to pass value ~A of type ~A to sqlite" value (type-of value))))))
 252       (unless (eq error-code :ok)
 253         (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))))))))
 254
 255 (defun execute-single (db sql &rest parameters)
 256   "Executes the query SQL to the database DB with given PARAMETERS. Returns the first column of the first row as single value.
 257
 258 Example:
 259 (execute-single db \"select user_name from users where id = ?\" 1)
 260 =>
 261 \"joe\"
 262
 263 See BIND-PARAMETER for the list of supported parameter types."
 264   (declare (dynamic-extent parameters))
 265   (let ((stmt (prepare-statement db sql)))
 266     (unwind-protect
 267          (progn
 268            (iter (for i from 1)
 269                  (declare (type fixnum i))
 270                  (for value in parameters)
 271                  (bind-parameter stmt i value))
 272            (if (step-statement stmt)
 273                (statement-column-value stmt 0)
 274                nil))
 275       (finalize-statement stmt))))
 276
 277 (defun last-insert-rowid (db)
 278   "Returns the auto-generated ID of the last inserted row on the database connection DB."
 279   (sqlite-ffi:sqlite3-last-insert-rowid (handle db)))
 280
 281 (defmacro with-transaction (db &body body)
 282   "Wraps the BODY inside the transaction."
 283   (let ((ok (gensym "TRANSACTION-COMMIT-"))
 284         (db-var (gensym "DB-"))
 285         (result (gensym "RESULT-")))
 286     `(let (,ok
 287            (,db-var ,db))
 288        (execute-non-query ,db-var "begin transaction")
 289        (unwind-protect
 290             (progn
 291               (let ((,result (progn
 292                                ,@body)))
 293                 (setf ,ok t)
 294                 ,result))
 295          (if ,ok
 296              (execute-non-query ,db-var "commit transaction")
 297              (execute-non-query ,db-var "rollback transaction"))))))
 298
 299 (defmacro with-open-database ((db path) &body body)
 300   `(let ((,db (connect ,path)))
 301      (unwind-protect
 302           (progn ,@body)
 303        (disconnect ,db))))
 304
 305 (defmacro-driver (FOR vars IN-SQLITE-QUERY query-expression ON-DATABASE db &optional WITH-PARAMETERS parameters)
 306   (let ((statement (gensym "STATEMENT-"))
 307         (kwd (if generate 'generate 'for)))
 308     `(progn (with ,statement = (prepare-statement ,db ,query-expression))
 309             (finally-protected (when ,statement (finalize-statement ,statement)))
 310             ,@(when parameters
 311                     (list `(initially ,@(iter (for i from 1)
 312                                               (for value in parameters)
 313                                               (collect `(sqlite:bind-parameter ,statement ,i ,value))))))
 314             (,kwd ,(if (symbolp vars)
 315                        `(values ,vars)
 316                        `(values ,@vars))
 317                   next (progn (if (step-statement ,statement)
 318                                   (values ,@(iter (for i from 0 below (if (symbolp vars) 1 (length vars)))
 319                                                   (collect `(statement-column-value ,statement ,i))))
 320                                   (terminate)))))))
 321
 322 (defmacro-driver (FOR vars ON-SQLITE-STATEMENT statement)
 323   (let ((statement-var (gensym "STATEMENT-"))
 324         (kwd (if generate 'generate 'for)))
 325     `(progn (with ,statement-var = ,statement)
 326             (,kwd ,(if (symbolp vars)
 327                        `(values ,vars)
 328                        `(values ,@vars))
 329                   next (progn (if (step-statement ,statement-var)
 330                                   (values ,@(iter (for i from 0 below (if (symbolp vars) 1 (length vars)))
 331                                                   (collect `(statement-column-value ,statement-var ,i))))
 332                                   (terminate)))))))