Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv11213/src/elephant
Modified Files: migrate.lisp transactions.lisp Log Message: Final migration fixes for BDB and restructuring of BDB default transaction handling to allow for nested controllers and transactions; migration info
--- /project/elephant/cvsroot/elephant/src/elephant/migrate.lisp 2007/02/16 23:02:53 1.6 +++ /project/elephant/cvsroot/elephant/src/elephant/migrate.lisp 2007/02/17 12:13:19 1.7 @@ -21,12 +21,13 @@
;; ;; The generic function Migrate provides an interface to moving objects between -;; repositories +;; repositories and is used by the upgrade interface. ;;
;; NOTES AND LIMITATIONS: ;; - Migrate currently will not handle circular list objects -;; - Migrate does not support arrays with nested persistent objects +;; - Migrate does not support arrays or standard objects with nested persistent objects +;; - There are potential problems with graphs and other deep structures ;; ;; - Indexed classes only have their class index copied if you use the ;; top level migration. Objects will be copied without slot data if you @@ -68,7 +69,7 @@ ;; to the target repository which you can then overwrite. To avoid the ;; default persistent slot copying, bind the dynamic variable ;; *inhibit-slot-writes* in your user method using -;; (with-inhibited-slot-copy () ...) a convenience macro +;; (with-inhibited-slot-copy () ...), a convenience macro. ;;
@@ -132,20 +133,21 @@ ;; Class indexes should never be copied already; this checks ;; for users breaking the class-index abstraction (assert (not (object-was-copied-p classidx))) + (format t "Migrating class indexes for: ~A~%" classname) (let ((newcidx - (ensure-transaction (:store-controller dst) + (with-transaction (:store-controller dst) (build-indexed-btree dst)))) ;; Add inverse indices to new main class index (map-indices (lambda (name srciidx) (let ((key-form (key-form srciidx))) - (ensure-transaction (:store-controller dst) + (with-transaction (:store-controller dst) (add-index newcidx :index-name name :key-form key-form :populate nil)))) classidx) ;; Add the class index to the class root - (ensure-transaction (:store-controller dst) + (with-transaction (:store-controller dst) (setf (get-value classname (controller-class-root dst)) newcidx)) ;; Update the class to point at objects in the new store (setf (%index-cache (find-class classname)) newcidx) @@ -156,6 +158,7 @@ (register-copied-object classidx newcidx))) (controller-class-root src)) ;; Copy all other reachable objects + (format t "Copying the root:~%") (map-btree (lambda (key value) (let ((newval (migrate dst value))) (unless (eq key *elephant-properties-label*) @@ -165,9 +168,12 @@ dst)
(defun copy-cindex-contents (new old) - (let ((sc (get-con new))) + (let ((sc (get-con new)) + (count 1)) (map-btree (lambda (oldoid oldinst) (declare (ignore oldoid)) + (when (= (mod (1- (incf count)) 1000) 0) + (format t "~A objects copied~%" count)) (let ((newinst (migrate sc oldinst))) (ensure-transaction (:store-controller sc) ;; This isn't redundant in most cases, but we may have @@ -243,10 +249,10 @@
(defun copy-persistent-slots (dstsc class src dst) "Copy only persistent slots from src to dst" - (loop for slot-def in (persistent-slot-defs class) do - (when (slot-boundp-using-class class src slot-def) - (let ((value (migrate dstsc (slot-value-using-class class src slot-def)))) - (ensure-transaction (:store-controller dstsc) + (ensure-transaction (:store-controller dstsc) + (loop for slot-def in (persistent-slot-defs class) do + (when (slot-boundp-using-class class src slot-def) + (let ((value (migrate dstsc (slot-value-using-class class src slot-def)))) (setf (slot-value-using-class class dst slot-def) value))))))
@@ -282,7 +288,6 @@
(defmethod copy-btree-contents ((sc store-controller) dst src) (map-btree (lambda (key value) - (format t "Migrating btree entry: ~A ~A~%" key value) (let ((newval (migrate sc value)) (newkey (migrate sc key))) (setf (get-value newkey dst) newval))) @@ -304,7 +309,6 @@ :rehash-size (hash-table-rehash-size src) :rehash-threshold (hash-table-rehash-threshold src)))) (maphash (lambda (key value) - (format t "Migrating hash entry: ~A ~A~%" key value) (setf (gethash key newhash) (migrate dst value))) src))) --- /project/elephant/cvsroot/elephant/src/elephant/transactions.lisp 2007/02/16 23:02:53 1.7 +++ /project/elephant/cvsroot/elephant/src/elephant/transactions.lisp 2007/02/17 12:13:19 1.8 @@ -78,10 +78,20 @@ "Get the store that owns the transaction from a transaction record" (car txnrec))
+(define-compiler-macro transaction-store (&whole form arg) + (if (atom arg) + `(car ,arg) + form)) + (defun transaction-object (txnrec) "Get the backend-specific transaction object" (cdr txnrec))
+(define-compiler-macro transaction-object (&whole form arg) + (if (atom arg) + `(cdr ,arg) + form)) + (defun transaction-object-p (txnrec) (consp txnrec))