Update of /project/elephant/cvsroot/elephant/src In directory common-lisp.net:/tmp/cvs-serv28007/src

Modified Files: controller.lisp Log Message: docstring fix, some easy transaction functions

Date: Sun Sep 19 19:49:25 2004 Author: blee

Index: elephant/src/controller.lisp diff -u elephant/src/controller.lisp:1.10 elephant/src/controller.lisp:1.11 --- elephant/src/controller.lisp:1.10 Thu Sep 16 06:15:31 2004 +++ elephant/src/controller.lisp Sun Sep 19 19:49:25 2004 @@ -61,38 +61,47 @@ creation, counters, locks, the root (for garbage collection,) et cetera."))

-(defgeneric cache-instance (sc obj)) -(defgeneric get-cached-instance (sc oid class-name)) -(defgeneric next-oid (sc)) -(defgeneric open-controller (sc &key recover recover-fatal thread)) -(defgeneric close-controller (sc)) +(defgeneric open-controller (sc &key recover recover-fatal thread) + (:documentation + "Opens the underlying environment and all the necessary +database tables.")) + +(defgeneric close-controller (sc) + (:documentation + "Close the db handles and environment. Tries to wipe out +references to the db handles."))

(defun add-to-root (key value &key (store-controller *store-controller*)) "Add an arbitrary persistent thing to the root, so you can retrieve it in a later session. N.B. this means it (and everything it points to) won't get gc'd." + (declare (type store-controller store-controller)) (setf (get-value key (controller-root store-controller)) value))

(defun get-from-root (key &key (store-controller *store-controller*)) "Get a something from the root." + (declare (type store-controller store-controller)) (get-value key (controller-root store-controller)))

(defun remove-from-root (key &key (store-controller *store-controller*)) "Remove something from the root." + (declare (type store-controller store-controller)) (remove-kv key (controller-root store-controller)))

-(defmethod cache-instance ((sc store-controller) obj) +(defun cache-instance (sc obj) "Cache a persistent object with the controller." + (declare (type store-controller sc)) (setf (get-cache (oid obj) (instance-cache sc)) obj))

-(defmethod get-cached-instance ((sc store-controller) oid class-name) +(defun get-cached-instance (sc oid class-name) "Get a cached instance, or instantiate!" + (declare (type store-controller sc) + (type fixnum oid)) (let ((obj (get-cache oid (instance-cache sc)))) (if obj obj ;; Should get cached since make-instance calls cache-instance (make-instance class-name :from-oid oid))))

- ;; OID stuff ;; This stuff is all a hack until sequences appear in Sleepycat 4.3 (defvar %oid-entry (uffi:allocate-foreign-object :char 12)) @@ -112,8 +121,9 @@ (defvar %oid-entry-length 12) (defvar %oid-lock-length 16)

-(defmethod next-oid ((sc store-controller)) +(defun next-oid (sc) "Get the next OID." + (declare (type store-controller sc)) (sleepycat::next-counter (controller-environment sc) (controller-db sc) *current-transaction* @@ -123,8 +133,6 @@ ;; Open/close (defmethod open-controller ((sc store-controller) &key (recover nil) (recover-fatal nil) (thread t)) - "Opens the underlying environment and all the necessary -database tables." (let ((env (db-env-create))) ;; thread stuff? (setf (controller-environment sc) env) @@ -174,8 +182,6 @@ sc))))

(defmethod close-controller ((sc store-controller)) - "Close the db handles and environment. Tries to wipe out -references to the db handles." (when (slot-value sc 'root) ;; no root (setf (slot-value sc 'root) nil) @@ -226,3 +232,19 @@ (progn ,@body) (close-controller *store-controller*))))

+(defun start-transaction (&key (parent *current-transaction*)) + "Start a transaction. May be nested but not interleaved." + (vector-push-extend *current-transaction* *transaction-stack*) + (setq *current-transaction* + (db-transaction-begin (controller-environment *store-controller*) + :parent parent))) + +(defun commit-transaction () + "Commit the current transaction." + (db-transaction-commit) + (setq *current-transaction* (vector-pop *transaction-stack*))) + +(defun abort-transaction () + "Abort the current transaction." + (db-transaction-abort) + (setq *current-transaction* (vector-pop *transaction-stack*)))