src/class.lisp

(in-package mito-transactions.dev)

;;; Locking (for MT version)

#+:mito-transactions-mt
(defvar *lock* (bt:make-recursive-lock))

(defmacro maybe-lock (&body body)
  #+:mito-transactions-mt
  `(bt:with-recursive-lock-held (*lock*)
    ,@body)
  #-:mito-transactions-mt
  `(progn
     ,@body))

;;; Metaclass

(defclass cached-dao-class (mito:dao-table-class)
  ((cache :initform (trivial-garbage:make-weak-hash-table :weakness :value :test 'equal))))

(defclass transaction-dao-class (cached-dao-class)
  ((transaction-slots :reader transaction-slots)))

(ensure-superclass-for-metaclass cached-dao-class cached-dao)
(ensure-superclass-for-metaclass transaction-dao-class transaction-dao)

(defmethod shared-initialize :after ((class transaction-dao-class) slot-names &key &allow-other-keys)
  (setf (slot-value class 'transaction-slots)
        (mapcar #'c2mop:slot-definition-name
                (remove-if #'mito.class.column:ghost-slot-p
                           (all-direct-slots class 'transaction-dao-direct-slot)))))

;;; Class

(defvar *ignore-transaction* nil "Bind to T to ignore transaction slot writer in a dynamic scope")

(defmacro deftable (name direct-superclasses direct-slots &rest options)
  (unless (and (cdr (or (assoc :auto-pk options) (cons t t)))
               (cdr (or (assoc :record-timestamps options) (cons t t))))
    (error "Cached DAO require both :AUTO-PK and :RECORD-TIMESTAMPS"))
  `(defclass ,name ,direct-superclasses
     ,direct-slots
     (:metaclass transaction-dao-class)
     ,@(unless (find :conc-name options :key #'car)
         `((:conc-name ,(intern (format nil "~@:(~A-~)" name) (symbol-package name)))))
     ,@options))

(defclass cached-dao (mito:dao-class)
  ())

(defclass transaction-dao (cached-dao)
  ((value-backup :accessor value-backup
                 :initform nil
                 :documentation "Previous slot values. Used to rollback transactions")))

;;; Slots

(defclass transaction-dao-direct-slot (mito.dao.column:dao-table-column-class)
  ())

(defmethod c2mop:direct-slot-definition-class ((class transaction-dao-class) &key &allow-other-keys)
  'transaction-dao-direct-slot)