(in-package #:chatikbot) (defvar *db-name* "db.sqlite" "SQLite database name") (defun db-path () (merge-pathnames *db-name* (asdf:component-pathname (asdf:find-system '#:chatikbot)))) (defvar *current-db* nil "Currently opened database") (defvar *db-lock* (bordeaux-threads:make-recursive-lock "sqlite connection lock") "Database connection lock") (defmacro with-db ((db) &body body) `(bordeaux-threads:with-recursive-lock-held (*db-lock*) (if *current-db* (let ((,db *current-db*)) (declare (ignorable ,db)) ,@body) (sqlite:with-open-database (,db (db-path) :busy-timeout 30) (sqlite:execute-non-query ,db "PRAGMA foreign_keys = ON") (let ((*current-db* ,db)) (handler-case (progn ,@body) (sqlite:sqlite-error (e) (log:error (sqlite:sqlite-error-code e) (sqlite:sqlite-error-message e)) (error e)))))))) (defmacro db-transaction (&body body) (let ((db (gensym "DB-"))) `(with-db (,db) (sqlite:with-transaction ,db ,@body)))) (defun db-execute (sql &rest parameters) (with-db (db) (apply #'sqlite:execute-non-query db sql parameters) (sqlite:last-insert-rowid db))) (defun db-select (sql &rest parameters) (with-db (db) (apply #'sqlite:execute-to-list db sql parameters))) (defun db-single (sql &rest parameters) (with-db (db) (apply #'sqlite:execute-single db sql parameters))) (defmacro def-db-init (&body body) `(add-hook :db-init #'(lambda () (handler-case (progn ,@body) (error (e) (log:error e))) (values)))) (defun db-init () (with-db (db) (db-execute "create table if not exists settings (var, val)") (db-execute "create unique index if not exists settings_var_unique on settings (var)") (db-execute "create table if not exists lists (list, entry)") (db-execute "create unique index if not exists lists_unique on lists (list, entry)"))) (defun load-settings () (let ((*package* (find-package :chatikbot))) (loop for (var val) in (db-select "select var, val from settings") do (setf (symbol-value (intern var)) (handler-case (read-from-string val) (error (e) (log:error e))))))) (defun set-setting (symbol value) (handler-case (let ((*package* (find-package :chatikbot))) (db-execute "replace into settings (var, val) values (?, ?)" (symbol-name symbol) (write-to-string value)) (setf (symbol-value symbol) value)) (error (e) (log:error e)))) (defun lists-set-entry (list entry &optional (add t)) (with-db (db) (handler-case (if add (db-execute "insert into lists (list, entry) values (?, ?)" (dekeyify list) entry) (db-execute "delete from lists where list = ? and entry = ?" (dekeyify list) entry)) (sqlite:sqlite-constraint-error () nil)))) (defun lists-get (list) (with-db (db) (mapcar #'car (db-select "select entry from lists where list = ?" (dekeyify list)))))