Revision: 3450 Author: hans URL: http://bknr.net/trac/changeset/3450

Automatic recursive determination of last-change timestamp. Also store-object-touch.

U trunk/bknr/datastore/src/data/object.lisp U trunk/bknr/datastore/src/data/package.lisp U trunk/bknr/datastore/src/data/txn.lisp

Modified: trunk/bknr/datastore/src/data/object.lisp =================================================================== --- trunk/bknr/datastore/src/data/object.lisp 2008-07-15 13:14:17 UTC (rev 3449) +++ trunk/bknr/datastore/src/data/object.lisp 2008-07-15 14:13:49 UTC (rev 3450) @@ -90,7 +90,7 @@ (error "Attempt to set persistent slot ~A of ~A outside of a transaction" slot-name object)) (unless (eq 'last-change slot-name) - (setf (slot-value object 'last-change) (transaction-timestamp *current-transaction*))))) + (setf (slot-value object 'last-change) (current-transaction-timestamp)))))

(defmethod (setf slot-value-using-class) :after (newval (class persistent-class) object slotd) (when (in-anonymous-transaction-p) @@ -151,6 +151,40 @@ (error "class-instances called for nonexistent class ~A" class)) (store-objects-with-class class))

+(deftransaction store-object-touch (object) + "Update the LAST-CHANGE slot to reflect the current transaction timestamp." + (setf (slot-value object 'last-change) (current-transaction-timestamp))) + +(defgeneric store-object-last-change (object depth) + (:documentation "Return the last change time of the OBJECT. DEPTH + determines how deep the object graph will be traversed.") + + (:method (object depth) + 0) + + (:method ((object store-object) (depth (eql 0))) + (slot-value object 'last-change)) + + (:method ((object store-object) depth) + (let ((last-change (slot-value object 'last-change))) + (dolist (slotd (class-slots (class-of object))) + (let* ((slot-name (slot-definition-name slotd)) + (child (and (slot-boundp object slot-name) + (slot-value object slot-name)))) + (setf last-change + (cond + ((null child) + last-change) + ((typep child 'store-object) + (max last-change (store-object-last-change child (1- depth)))) + ((listp child) + (reduce #'max child + :key (alexandria:rcurry 'store-object-last-change (1- depth)) + :initial-value last-change)) + (t + last-change))))) + last-change))) + #+allegro (aclmop::finalize-inheritance (find-class 'store-object))

Modified: trunk/bknr/datastore/src/data/package.lisp =================================================================== --- trunk/bknr/datastore/src/data/package.lisp 2008-07-15 13:14:17 UTC (rev 3449) +++ trunk/bknr/datastore/src/data/package.lisp 2008-07-15 14:13:49 UTC (rev 3450) @@ -28,6 +28,7 @@ #:transaction-function-symbol #:transaction-args #:transaction-timestamp + #:current-transaction-timestamp #:in-transaction-p #:deftransaction

@@ -42,6 +43,8 @@ #:store-object #:store-object-store #:store-object-id + #:store-object-last-change + #:store-object-touch

#:delete-object #:delete-objects

Modified: trunk/bknr/datastore/src/data/txn.lisp =================================================================== --- trunk/bknr/datastore/src/data/txn.lisp 2008-07-15 13:14:17 UTC (rev 3449) +++ trunk/bknr/datastore/src/data/txn.lisp 2008-07-15 14:13:49 UTC (rev 3450) @@ -236,6 +236,9 @@ (or *current-transaction* (eq :restore (store-state *store*))))

+(defun current-transaction-timestamp () + (transaction-timestamp *current-transaction*)) + (defun store-open-p () (not (eq :closed (store-state *store*))))