Преглед изворни кода

[db] try 'with-recursive-lock-held' for sqlite access

Innocenty Enikeew пре 8 година
родитељ
комит
7a1201e6e6
1 измењених фајлова са 15 додато и 8 уклоњено
  1. 15 8
      db.lisp

+ 15 - 8
db.lisp

@@ -8,15 +8,22 @@
                     (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)
-  `(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))
-           ,@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-")))