Show More
@@ -1,63 +1,63 b'' | |||
|
1 | 1 | |
|
2 | 2 | (in-package mito-transactions.dev) |
|
3 | 3 | |
|
4 | 4 | ;;; Locking (for MT version) |
|
5 | 5 | |
|
6 | 6 | #+:mito-transactions-mt |
|
7 | 7 | (defvar *lock* (bt:make-recursive-lock)) |
|
8 | 8 | |
|
9 | 9 | (defmacro maybe-lock (&body body) |
|
10 | 10 | #+:mito-transactions-mt |
|
11 | 11 | `(bt:with-recursive-lock-held (*lock*) |
|
12 | 12 | ,@body) |
|
13 | 13 | #-:mito-transactions-mt |
|
14 | 14 | `(progn |
|
15 | 15 | ,@body)) |
|
16 | 16 | |
|
17 | 17 | ;;; Metaclass |
|
18 | 18 | |
|
19 | 19 | (defclass cached-dao-class (mito:dao-table-class) |
|
20 | 20 | ((cache :initform (trivial-garbage:make-weak-hash-table :weakness :value :test 'equal)))) |
|
21 | 21 | |
|
22 | 22 | (defclass transaction-dao-class (cached-dao-class) |
|
23 | 23 | ((transaction-slots :reader transaction-slots))) |
|
24 | 24 | |
|
25 | 25 | (ensure-superclass-for-metaclass cached-dao-class cached-dao) |
|
26 | 26 | (ensure-superclass-for-metaclass transaction-dao-class transaction-dao) |
|
27 | 27 | |
|
28 | 28 | (defmethod shared-initialize :after ((class transaction-dao-class) slot-names &key &allow-other-keys) |
|
29 | 29 | (setf (slot-value class 'transaction-slots) |
|
30 | 30 | (mapcar #'c2mop:slot-definition-name |
|
31 | 31 | (remove-if #'mito.class.column:ghost-slot-p |
|
32 | 32 | (all-direct-slots class 'transaction-dao-direct-slot))))) |
|
33 | 33 | |
|
34 | 34 | ;;; Class |
|
35 | 35 | |
|
36 | 36 | (defvar *ignore-transaction* nil "Bind to T to ignore transaction slot writer in a dynamic scope") |
|
37 | 37 | |
|
38 | 38 | (defmacro deftable (name direct-superclasses direct-slots &rest options) |
|
39 | (unless (and (getf options :auto-pk) | |
|
40 |
( |
|
|
39 | (unless (and (cdr (or (assoc :auto-pk options) (cons t t))) | |
|
40 | (cdr (or (assoc :record-timestamps options) (cons t t)))) | |
|
41 | 41 | (error "Cached DAO require both :AUTO-PK and :RECORD-TIMESTAMPS")) |
|
42 | 42 | `(defclass ,name ,direct-superclasses |
|
43 | 43 | ,direct-slots |
|
44 | 44 | (:metaclass transaction-dao-class) |
|
45 | 45 | ,@(unless (find :conc-name options :key #'car) |
|
46 | 46 | `((:conc-name ,(intern (format nil "~@:(~A-~)" name) (symbol-package name))))) |
|
47 | 47 | ,@options)) |
|
48 | 48 | |
|
49 | 49 | (defclass cached-dao (mito:dao-class) |
|
50 | 50 | ()) |
|
51 | 51 | |
|
52 | 52 | (defclass transaction-dao (cached-dao) |
|
53 | 53 | ((value-backup :accessor value-backup |
|
54 | 54 | :initform nil |
|
55 | 55 | :documentation "Previous slot values. Used to rollback transactions"))) |
|
56 | 56 | |
|
57 | 57 | ;;; Slots |
|
58 | 58 | |
|
59 | 59 | (defclass transaction-dao-direct-slot (mito.dao.column:dao-table-column-class) |
|
60 | 60 | ()) |
|
61 | 61 | |
|
62 | 62 | (defmethod c2mop:direct-slot-definition-class ((class transaction-dao-class) &key &allow-other-keys) |
|
63 | 63 | 'transaction-dao-direct-slot) |
General Comments 0
You need to be logged in to leave comments.
Login now