[elephant-cvs] CVS elephant/src/elephant

[ieslick]

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))