(in-package :cl-user) (defpackage chatikbot.db (:use :cl) (:import-from :chatikbot.utils :dekeyify) (:export :db-transaction :db-execute :db-select :db-single :db-init :load-settings :set-setting :lists-set-entry :lists-get)) (in-package :chatikbot.db) (defvar *db-path* "db.sqlite" "SQLite database name") (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*) (unless *current-db* (let ((path *db-path*)) (log:info "Connecting to ~A" path) (setf *current-db* (sqlite:connect path)) (sqlite:execute-non-query *current-db* "PRAGMA foreign_keys = ON"))) (let ((,db *current-db*)) (declare (ignorable ,db)) (handler-case (progn ,@body) (sqlite:sqlite-error (e) (log:error (sqlite:sqlite-error-code e) (sqlite:sqlite-error-message e)) (ignore-errors (sqlite:disconnect *current-db*)) (setf *current-db* nil) (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))) (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 (handler-case (setf (symbol-value (read-from-string var)) (read-from-string val)) (error (e) (log:error "~A" e)))))) (defun set-setting (symbol value) (handler-case (let ((*package* (find-package :chatikbot))) (db-execute "replace into settings (var, val) values (?, ?)" (write-to-string 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)))))