whatsxmpp/sqlite.lisp

97 lines
4.1 KiB
Common Lisp

(in-package :whatsxmpp)
(defvar *db* nil
"Connection to the database.")
(defvar *db-lock* (bt:make-recursive-lock "sqlite3 lock")
"Lock for *DB*.")
(defparameter *default-database-path* "data.sqlite3"
"Default path to the SQLite database file.")
(defvar *prepared-statements* nil
"List of statements prepared by PREPARED-STATEMENT.")
(defparameter *sqlite-pragmas*
'("PRAGMA journal_mode = WAL"
"PRAGMA foreign_keys = ON"
"PRAGMA synchronous = NORMAL")
"List of SQLite pragmas to run on connection to make things bearable")
(defun run-pragmas ()
"Runs all statements in *SQLITE-PRAGMAS*."
(mapc (lambda (x) (sqlite:execute-non-query *db* x)) *sqlite-pragmas*))
(defun connect-database (&optional (path *default-database-path*))
"Establish a connection to the database."
(bt:with-recursive-lock-held (*db-lock*)
(setf *db* (sqlite:connect path))
(run-pragmas)
(loop for sym in *prepared-statements*
do (eval `(setf ,sym nil)))
(setf *prepared-statements* nil)))
(defmacro with-transaction (&body forms)
`(bt:with-recursive-lock-held (*db-lock*)
(sqlite:with-transaction *db*
,@forms)))
(defmacro prepared-statement (statement)
"Caches the creation of a prepared statement with SQL text STATEMENT.
In other words, prepares STATEMENT once, then returns the prepared statement after that instead of doing that work again."
(let ((statement-sym (gensym "PREPARED-STATEMENT-")))
(eval `(defvar ,statement-sym nil))
`(progn
(defvar ,statement-sym nil)
(unless ,statement-sym
(setf ,statement-sym (sqlite:prepare-statement *db* ,statement))
(setf *prepared-statements* (cons ',statement-sym *prepared-statements*)))
,statement-sym)))
(defmacro with-prepared-statement ((name statement) &body forms)
"Evaluates FORMS, binding a prepared statement with SQL text STATEMENT to NAME, and ensuring it is reset when control is transferred."
`(bt:with-recursive-lock-held (*db-lock*)
(let ((,name (prepared-statement ,statement)))
(multiple-value-prog1
(unwind-protect
(progn ,@forms)
(ignore-errors (sqlite:reset-statement ,name)))))))
(defmacro with-prepared-statements (statements &body forms)
"Like WITH-PREPARED-STATEMENT, but takes multiple statements."
(let ((let-forms (loop for (name statement) in statements
collect `(,name (prepared-statement ,statement))))
(reset-forms (loop for (name statement) in statements
collect `(ignore-errors (sqlite:reset-statement ,name)))))
`(bt:with-recursive-lock-held (*db-lock*)
(let (,@let-forms)
(multiple-value-prog1
(unwind-protect
(progn ,@forms))
(ignore-errors (progn ,@reset-forms)))))))
(defmacro column-values (statement)
"Returns the values in the current row of the STATEMENT."
(let ((i-sym (gensym))
(stmt (gensym)))
`(let ((,stmt ,statement))
(loop
for ,i-sym from 0 below (length (sqlite:statement-column-names ,stmt))
collect (sqlite:statement-column-value ,stmt ,i-sym)))))
(defmacro with-bound-columns (parameters statement &body forms)
"Binds each column value of STATEMENT to the symbols in PARAMETERS, and runs FORMS."
(let ((let-forms (loop
for param in parameters
for idx from 0 upto (1- (length parameters))
collect `(,param (sqlite:statement-column-value ,statement ,idx)))))
`(let (,@let-forms) ,@forms)))
(defmacro bind-parameters (statement &rest parameters)
"Binds PARAMETERS to the prepared statement STATEMENT.
PARAMETERS are either simple values (in which case they're bound to parameters 1, 2, ...),
or cons cells, where the `car` is the index to bind to and the `cdr' is the value to use."
`(progn
,@(loop for param in parameters
for idx from 1 upto (length parameters)
collect (if (listp param)
`(sqlite:bind-parameter ,statement ,(car param) ,(second param))
`(sqlite:bind-parameter ,statement ,idx ,param)))))