/sqlite.lisp
Lisp | 507 lines | 439 code | 67 blank | 1 comment | 24 complexity | b556d686eef5c94a06b99cfd07d05451 MD5 | raw file
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-single/named 27 :execute-one-row-m-v/named 28 :execute-to-list/named 29 :execute-non-query/named 30 :execute-one-row-m-v 31 :last-insert-rowid 32 :with-transaction 33 :with-open-database)) 34 35(in-package :sqlite) 36 37(define-condition sqlite-error (simple-error) 38 ((handle :initform nil :initarg :db-handle 39 :reader sqlite-error-db-handle) 40 (error-code :initform nil :initarg :error-code 41 :reader sqlite-error-code) 42 (error-msg :initform nil :initarg :error-msg 43 :reader sqlite-error-message) 44 (statement :initform nil :initarg :statement 45 :reader sqlite-error-statement) 46 (sql :initform nil :initarg :sql 47 :reader sqlite-error-sql))) 48 49(define-condition sqlite-constraint-error (sqlite-error) 50 ()) 51 52(defun sqlite-error (error-code message &key 53 statement 54 (db-handle (if statement (db statement))) 55 (sql-text (if statement (sql statement)))) 56 (error (if (eq error-code :constraint) 57 'sqlite-constraint-error 58 'sqlite-error) 59 :format-control (if (listp message) (first message) message) 60 :format-arguments (if (listp message) (rest message)) 61 :db-handle db-handle 62 :error-code error-code 63 :error-msg (if (and db-handle error-code) 64 (sqlite-ffi:sqlite3-errmsg (handle db-handle))) 65 :statement statement 66 :sql sql-text)) 67 68(defmethod print-object :after ((obj sqlite-error) stream) 69 (unless *print-escape* 70 (when (or (and (sqlite-error-code obj) 71 (not (eq (sqlite-error-code obj) :ok))) 72 (sqlite-error-message obj)) 73 (format stream "~&Code ~A: ~A." 74 (or (sqlite-error-code obj) :OK) 75 (or (sqlite-error-message obj) "no message"))) 76 (when (sqlite-error-db-handle obj) 77 (format stream "~&Database: ~A" 78 (database-path (sqlite-error-db-handle obj)))) 79 (when (sqlite-error-sql obj) 80 (format stream "~&SQL: ~A" (sqlite-error-sql obj))))) 81 82;(declaim (optimize (speed 3) (safety 0) (debug 0))) 83 84(defclass sqlite-handle () 85 ((handle :accessor handle) 86 (database-path :accessor database-path) 87 (cache :accessor cache) 88 (statements :initform nil :accessor sqlite-handle-statements)) 89 (:documentation "Class that encapsulates the connection to the database. Use connect and disconnect.")) 90 91(defmethod initialize-instance :after ((object sqlite-handle) &key (database-path ":memory:") &allow-other-keys) 92 (cffi:with-foreign-object (ppdb 'sqlite-ffi:p-sqlite3) 93 (let ((error-code (sqlite-ffi:sqlite3-open database-path ppdb))) 94 (if (eq error-code :ok) 95 (setf (handle object) (cffi:mem-ref ppdb 'sqlite-ffi:p-sqlite3) 96 (database-path object) database-path) 97 (sqlite-error error-code (list "Could not open sqlite3 database ~A" database-path))))) 98 (setf (cache object) (make-instance 'sqlite.cache:mru-cache :cache-size 16 :destructor #'really-finalize-statement))) 99 100(defun connect (database-path &key busy-timeout) 101 "Connect to the sqlite database at the given DATABASE-PATH. Returns the SQLITE-HANDLE connected to the database. Use DISCONNECT to disconnect. 102 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." 103 (let ((db (make-instance 'sqlite-handle 104 :database-path (etypecase database-path 105 (string database-path) 106 (pathname (namestring database-path)))))) 107 (when busy-timeout 108 (set-busy-timeout db busy-timeout)) 109 db)) 110 111(defun set-busy-timeout (db milliseconds) 112 "Sets the maximum amount of time to wait for a locked database." 113 (sqlite-ffi:sqlite3-busy-timeout (handle db) milliseconds)) 114 115(defun disconnect (handle) 116 "Disconnects the given HANDLE from the database. All further operations on the handle are invalid." 117 (sqlite.cache:purge-cache (cache handle)) 118 (iter (with statements = (copy-list (sqlite-handle-statements handle))) 119 (declare (dynamic-extent statements)) 120 (for statement in statements) 121 (really-finalize-statement statement)) 122 (let ((error-code (sqlite-ffi:sqlite3-close (handle handle)))) 123 (unless (eq error-code :ok) 124 (sqlite-error error-code "Could not close sqlite3 database." :db-handle handle)) 125 (slot-makunbound handle 'handle))) 126 127(defclass sqlite-statement () 128 ((db :reader db :initarg :db) 129 (handle :accessor handle) 130 (sql :reader sql :initarg :sql) 131 (columns-count :accessor resultset-columns-count) 132 (columns-names :accessor resultset-columns-names :reader statement-column-names) 133 (parameters-count :accessor parameters-count) 134 (parameters-names :accessor parameters-names :reader statement-bind-parameter-names)) 135 (:documentation "Class that represents the prepared statement.")) 136 137(defmethod initialize-instance :after ((object sqlite-statement) &key &allow-other-keys) 138 (cffi:with-foreign-object (p-statement 'sqlite-ffi:p-sqlite3-stmt) 139 (cffi:with-foreign-object (p-tail '(:pointer :char)) 140 (cffi:with-foreign-string (sql (sql object)) 141 (let ((error-code (sqlite-ffi:sqlite3-prepare (handle (db object)) sql -1 p-statement p-tail))) 142 (unless (eq error-code :ok) 143 (sqlite-error error-code "Could not prepare an sqlite statement." 144 :db-handle (db object) :sql-text (sql object))) 145 (unless (zerop (cffi:mem-ref (cffi:mem-ref p-tail '(:pointer :char)) :uchar)) 146 (sqlite-error nil "SQL string contains more than one SQL statement." :sql-text (sql object))) 147 (setf (handle object) (cffi:mem-ref p-statement 'sqlite-ffi:p-sqlite3-stmt) 148 (resultset-columns-count object) (sqlite-ffi:sqlite3-column-count (handle object)) 149 (resultset-columns-names object) (loop 150 for i below (resultset-columns-count object) 151 collect (sqlite-ffi:sqlite3-column-name (handle object) i)) 152 (parameters-count object) (sqlite-ffi:sqlite3-bind-parameter-count (handle object)) 153 (parameters-names object) (loop 154 for i from 1 to (parameters-count object) 155 collect (sqlite-ffi:sqlite3-bind-parameter-name (handle object) i)))))))) 156 157(defun prepare-statement (db sql) 158 "Prepare the statement to the DB that will execute the commands that are in SQL. 159 160Returns the SQLITE-STATEMENT. 161 162SQL must contain exactly one statement. 163SQL may have some positional (not named) parameters specified with question marks. 164 165Example: 166 167 select name from users where id = ?" 168 (or (let ((statement (sqlite.cache:get-from-cache (cache db) sql))) 169 (when statement 170 (clear-statement-bindings statement)) 171 statement) 172 (let ((statement (make-instance 'sqlite-statement :db db :sql sql))) 173 (push statement (sqlite-handle-statements db)) 174 statement))) 175 176(defun really-finalize-statement (statement) 177 (setf (sqlite-handle-statements (db statement)) 178 (delete statement (sqlite-handle-statements (db statement)))) 179 (sqlite-ffi:sqlite3-finalize (handle statement)) 180 (slot-makunbound statement 'handle)) 181 182(defun finalize-statement (statement) 183 "Finalizes the statement and signals that associated resources may be released. 184Note: does not immediately release resources because statements are cached." 185 (reset-statement statement) 186 (sqlite.cache:put-to-cache (cache (db statement)) (sql statement) statement)) 187 188(defun step-statement (statement) 189 "Steps to the next row of the resultset of STATEMENT. 190Returns T is successfully advanced to the next row and NIL if there are no more rows." 191 (let ((error-code (sqlite-ffi:sqlite3-step (handle statement)))) 192 (case error-code 193 (:done nil) 194 (:row t) 195 (t 196 (sqlite-error error-code "Error while stepping an sqlite statement." :statement statement))))) 197 198(defun reset-statement (statement) 199 "Resets the STATEMENT and prepare it to be called again." 200 (let ((error-code (sqlite-ffi:sqlite3-reset (handle statement)))) 201 (unless (eq error-code :ok) 202 (sqlite-error error-code "Error while resetting an sqlite statement." :statement statement)))) 203 204(defun clear-statement-bindings (statement) 205 "Sets all binding values to NULL." 206 (let ((error-code (sqlite-ffi:sqlite3-clear-bindings (handle statement)))) 207 (unless (eq error-code :ok) 208 (sqlite-error error-code "Error while clearing bindings of an sqlite statement." 209 :statement statement)))) 210 211(defun statement-column-value (statement column-number) 212 "Returns the COLUMN-NUMBER-th column's value of the current row of the STATEMENT. Columns are numbered from zero. 213Returns: 214 * NIL for NULL 215 * INTEGER for integers 216 * DOUBLE-FLOAT for floats 217 * STRING for text 218 * (SIMPLE-ARRAY (UNSIGNED-BYTE 8)) for BLOBs" 219 (let ((type (sqlite-ffi:sqlite3-column-type (handle statement) column-number))) 220 (ecase type 221 (:null nil) 222 (:text (sqlite-ffi:sqlite3-column-text (handle statement) column-number)) 223 (:integer (sqlite-ffi:sqlite3-column-int64 (handle statement) column-number)) 224 (:float (sqlite-ffi:sqlite3-column-double (handle statement) column-number)) 225 (:blob (let* ((blob-length (sqlite-ffi:sqlite3-column-bytes (handle statement) column-number)) 226 (result (make-array (the fixnum blob-length) :element-type '(unsigned-byte 8))) 227 (blob (sqlite-ffi:sqlite3-column-blob (handle statement) column-number))) 228 (loop 229 for i below blob-length 230 do (setf (aref result i) (cffi:mem-aref blob :unsigned-char i))) 231 result))))) 232 233(defmacro with-prepared-statement (statement-var (db sql parameters-var) &body body) 234 (let ((i-var (gensym "I")) 235 (value-var (gensym "VALUE"))) 236 `(let ((,statement-var (prepare-statement ,db ,sql))) 237 (unwind-protect 238 (progn 239 (iter (for ,i-var from 1) 240 (declare (type fixnum ,i-var)) 241 (for ,value-var in ,parameters-var) 242 (bind-parameter ,statement-var ,i-var ,value-var)) 243 ,@body) 244 (finalize-statement ,statement-var))))) 245 246(defmacro with-prepared-statement/named (statement-var (db sql parameters-var) &body body) 247 (let ((name-var (gensym "NAME")) 248 (value-var (gensym "VALUE"))) 249 `(let ((,statement-var (prepare-statement ,db ,sql))) 250 (unwind-protect 251 (progn 252 (iter (for (,name-var ,value-var) on ,parameters-var by #'cddr) 253 (bind-parameter ,statement-var (string ,name-var) ,value-var)) 254 ,@body) 255 (finalize-statement ,statement-var))))) 256 257(defun execute-non-query (db sql &rest parameters) 258 "Executes the query SQL to the database DB with given PARAMETERS. Returns nothing. 259 260Example: 261 262\(execute-non-query db \"insert into users (user_name, real_name) values (?, ?)\" \"joe\" \"Joe the User\") 263 264See BIND-PARAMETER for the list of supported parameter types." 265 (declare (dynamic-extent parameters)) 266 (with-prepared-statement statement (db sql parameters) 267 (step-statement statement))) 268 269(defun execute-non-query/named (db sql &rest parameters) 270 "Executes the query SQL to the database DB with given PARAMETERS. Returns nothing. 271 272PARAMETERS is a list of alternating parameter names and values. 273 274Example: 275 276\(execute-non-query db \"insert into users (user_name, real_name) values (:name, :real_name)\" \":name\" \"joe\" \":real_name\" \"Joe the User\") 277 278See BIND-PARAMETER for the list of supported parameter types." 279 (declare (dynamic-extent parameters)) 280 (with-prepared-statement/named statement (db sql parameters) 281 (step-statement statement))) 282 283(defun execute-to-list (db sql &rest parameters) 284 "Executes the query SQL to the database DB with given PARAMETERS. Returns the results as list of lists. 285 286Example: 287 288\(execute-to-list db \"select id, user_name, real_name from users where user_name = ?\" \"joe\") 289=> 290\((1 \"joe\" \"Joe the User\") 291 (2 \"joe\" \"Another Joe\")) 292 293See BIND-PARAMETER for the list of supported parameter types." 294 (declare (dynamic-extent parameters)) 295 (with-prepared-statement stmt (db sql parameters) 296 (let (result) 297 (loop (if (step-statement stmt) 298 (push (iter (for i from 0 below (the fixnum (sqlite-ffi:sqlite3-column-count (handle stmt)))) 299 (declare (type fixnum i)) 300 (collect (statement-column-value stmt i))) 301 result) 302 (return))) 303 (nreverse result)))) 304 305(defun execute-to-list/named (db sql &rest parameters) 306 "Executes the query SQL to the database DB with given PARAMETERS. Returns the results as list of lists. 307 308PARAMETERS is a list of alternating parameters names and values. 309 310Example: 311 312\(execute-to-list db \"select id, user_name, real_name from users where user_name = :user_name\" \":user_name\" \"joe\") 313=> 314\((1 \"joe\" \"Joe the User\") 315 (2 \"joe\" \"Another Joe\")) 316 317See BIND-PARAMETER for the list of supported parameter types." 318 (declare (dynamic-extent parameters)) 319 (with-prepared-statement/named stmt (db sql parameters) 320 (let (result) 321 (loop (if (step-statement stmt) 322 (push (iter (for i from 0 below (the fixnum (sqlite-ffi:sqlite3-column-count (handle stmt)))) 323 (declare (type fixnum i)) 324 (collect (statement-column-value stmt i))) 325 result) 326 (return))) 327 (nreverse result)))) 328 329(defun execute-one-row-m-v (db sql &rest parameters) 330 "Executes the query SQL to the database DB with given PARAMETERS. Returns the first row as multiple values. 331 332Example: 333\(execute-one-row-m-v db \"select id, user_name, real_name from users where id = ?\" 1) 334=> 335\(values 1 \"joe\" \"Joe the User\") 336 337See BIND-PARAMETER for the list of supported parameter types." 338 (with-prepared-statement stmt (db sql parameters) 339 (if (step-statement stmt) 340 (return-from execute-one-row-m-v 341 (values-list (iter (for i from 0 below (the fixnum (sqlite-ffi:sqlite3-column-count (handle stmt)))) 342 (declare (type fixnum i)) 343 (collect (statement-column-value stmt i))))) 344 (return-from execute-one-row-m-v 345 (values-list (loop repeat (the fixnum (sqlite-ffi:sqlite3-column-count (handle stmt))) collect nil)))))) 346 347(defun execute-one-row-m-v/named (db sql &rest parameters) 348 "Executes the query SQL to the database DB with given PARAMETERS. Returns the first row as multiple values. 349 350PARAMETERS is a list of alternating parameters names and values. 351 352Example: 353\(execute-one-row-m-v db \"select id, user_name, real_name from users where id = :id\" \":id\" 1) 354=> 355\(values 1 \"joe\" \"Joe the User\") 356 357See BIND-PARAMETER for the list of supported parameter types." 358 (with-prepared-statement/named stmt (db sql parameters) 359 (if (step-statement stmt) 360 (return-from execute-one-row-m-v/named 361 (values-list (iter (for i from 0 below (the fixnum (sqlite-ffi:sqlite3-column-count (handle stmt)))) 362 (declare (type fixnum i)) 363 (collect (statement-column-value stmt i))))) 364 (return-from execute-one-row-m-v/named 365 (values-list (loop repeat (the fixnum (sqlite-ffi:sqlite3-column-count (handle stmt))) collect nil)))))) 366 367(defun statement-parameter-index (statement parameter-name) 368 (sqlite-ffi:sqlite3-bind-parameter-index (handle statement) parameter-name)) 369 370(defun bind-parameter (statement parameter value) 371 "Sets the PARAMETER-th parameter in STATEMENT to the VALUE. 372PARAMETER may be parameter index (starting from 1) or parameters name. 373Supported types: 374 * NULL. Passed as NULL 375 * INTEGER. Passed as an 64-bit integer 376 * STRING. Passed as a string 377 * FLOAT. Passed as a double 378 * (VECTOR (UNSIGNED-BYTE 8)) and VECTOR that contains integers in range [0,256). Passed as a BLOB" 379 (let ((index (etypecase parameter 380 (integer parameter) 381 (string (statement-parameter-index statement parameter))))) 382 (declare (type fixnum index)) 383 (let ((error-code (typecase value 384 (null (sqlite-ffi:sqlite3-bind-null (handle statement) index)) 385 (integer (sqlite-ffi:sqlite3-bind-int64 (handle statement) index value)) 386 (double-float (sqlite-ffi:sqlite3-bind-double (handle statement) index value)) 387 (real (sqlite-ffi:sqlite3-bind-double (handle statement) index (coerce value 'double-float))) 388 (string (sqlite-ffi:sqlite3-bind-text (handle statement) index value -1 (sqlite-ffi:destructor-transient))) 389 ((vector (unsigned-byte 8)) (cffi:with-pointer-to-vector-data (ptr value) 390 (sqlite-ffi:sqlite3-bind-blob (handle statement) index ptr (length value) (sqlite-ffi:destructor-transient)))) 391 (vector (cffi:with-foreign-object (array :unsigned-char (length value)) 392 (loop 393 for i from 0 below (length value) 394 do (setf (cffi:mem-aref array :unsigned-char i) (aref value i))) 395 (sqlite-ffi:sqlite3-bind-blob (handle statement) index array (length value) (sqlite-ffi:destructor-transient)))) 396 (t 397 (sqlite-error nil 398 (list "Do not know how to pass value ~A of type ~A to sqlite." 399 value (type-of value)) 400 :statement statement))))) 401 (unless (eq error-code :ok) 402 (sqlite-error error-code 403 (list "Error when binding parameter ~A to value ~A." parameter value) 404 :statement statement))))) 405 406(defun execute-single (db sql &rest parameters) 407 "Executes the query SQL to the database DB with given PARAMETERS. Returns the first column of the first row as single value. 408 409Example: 410\(execute-single db \"select user_name from users where id = ?\" 1) 411=> 412\"joe\" 413 414See BIND-PARAMETER for the list of supported parameter types." 415 (declare (dynamic-extent parameters)) 416 (with-prepared-statement stmt (db sql parameters) 417 (if (step-statement stmt) 418 (statement-column-value stmt 0) 419 nil))) 420 421(defun execute-single/named (db sql &rest parameters) 422 "Executes the query SQL to the database DB with given PARAMETERS. Returns the first column of the first row as single value. 423 424PARAMETERS is a list of alternating parameters names and values. 425 426Example: 427\(execute-single db \"select user_name from users where id = :id\" \":id\" 1) 428=> 429\"joe\" 430 431See BIND-PARAMETER for the list of supported parameter types." 432 (declare (dynamic-extent parameters)) 433 (with-prepared-statement/named stmt (db sql parameters) 434 (if (step-statement stmt) 435 (statement-column-value stmt 0) 436 nil))) 437 438(defun last-insert-rowid (db) 439 "Returns the auto-generated ID of the last inserted row on the database connection DB." 440 (sqlite-ffi:sqlite3-last-insert-rowid (handle db))) 441 442(defmacro with-transaction (db &body body) 443 "Wraps the BODY inside the transaction." 444 (let ((ok (gensym "TRANSACTION-COMMIT-")) 445 (db-var (gensym "DB-"))) 446 `(let (,ok 447 (,db-var ,db)) 448 (execute-non-query ,db-var "begin transaction") 449 (unwind-protect 450 (multiple-value-prog1 451 (progn ,@body) 452 (setf ,ok t)) 453 (if ,ok 454 (execute-non-query ,db-var "commit transaction") 455 (execute-non-query ,db-var "rollback transaction")))))) 456 457(defmacro with-open-database ((db path &key busy-timeout) &body body) 458 `(let ((,db (connect ,path :busy-timeout ,busy-timeout))) 459 (unwind-protect 460 (progn ,@body) 461 (disconnect ,db)))) 462 463(defmacro-driver (FOR vars IN-SQLITE-QUERY query-expression ON-DATABASE db &optional WITH-PARAMETERS parameters) 464 (let ((statement (gensym "STATEMENT-")) 465 (kwd (if generate 'generate 'for))) 466 `(progn (with ,statement = (prepare-statement ,db ,query-expression)) 467 (finally-protected (when ,statement (finalize-statement ,statement))) 468 ,@(when parameters 469 (list `(initially ,@(iter (for i from 1) 470 (for value in parameters) 471 (collect `(sqlite:bind-parameter ,statement ,i ,value)))))) 472 (,kwd ,(if (symbolp vars) 473 `(values ,vars) 474 `(values ,@vars)) 475 next (progn (if (step-statement ,statement) 476 (values ,@(iter (for i from 0 below (if (symbolp vars) 1 (length vars))) 477 (collect `(statement-column-value ,statement ,i)))) 478 (terminate))))))) 479 480(defmacro-driver (FOR vars IN-SQLITE-QUERY/NAMED query-expression ON-DATABASE db &optional WITH-PARAMETERS parameters) 481 (let ((statement (gensym "STATEMENT-")) 482 (kwd (if generate 'generate 'for))) 483 `(progn (with ,statement = (prepare-statement ,db ,query-expression)) 484 (finally-protected (when ,statement (finalize-statement ,statement))) 485 ,@(when parameters 486 (list `(initially ,@(iter (for (name value) on parameters by #'cddr) 487 (collect `(sqlite:bind-parameter ,statement ,name ,value)))))) 488 (,kwd ,(if (symbolp vars) 489 `(values ,vars) 490 `(values ,@vars)) 491 next (progn (if (step-statement ,statement) 492 (values ,@(iter (for i from 0 below (if (symbolp vars) 1 (length vars))) 493 (collect `(statement-column-value ,statement ,i)))) 494 (terminate))))))) 495 496 497(defmacro-driver (FOR vars ON-SQLITE-STATEMENT statement) 498 (let ((statement-var (gensym "STATEMENT-")) 499 (kwd (if generate 'generate 'for))) 500 `(progn (with ,statement-var = ,statement) 501 (,kwd ,(if (symbolp vars) 502 `(values ,vars) 503 `(values ,@vars)) 504 next (progn (if (step-statement ,statement-var) 505 (values ,@(iter (for i from 0 below (if (symbolp vars) 1 (length vars))) 506 (collect `(statement-column-value ,statement-var ,i)))) 507 (terminate)))))))