[elephant-cvs] CVS elephant/src/elephant

[ieslick]

Update of /project/elephant/cvsroot/elephant/src/elephant
In directory clnet:/tmp/cvs-serv28175

Modified Files:
	classindex.lisp 
Log Message:

BUGFIX: Allow enable-class-indexing to connect to existing database index
when class definition is out of synch with actual db indexing. 



--- /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp	2006/04/26 21:41:24	1.11
+++ /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp	2006/04/30 01:01:05	1.12
@@ -182,22 +182,30 @@
   (let ((croot (controller-class-root sc)))
     (multiple-value-bind (btree found)
 	(get-value (class-name class) croot)
-      (declare (ignore btree))
-      (when found (error "Class is already enabled for indexing!  Run disable class indexing to clean up.")))
-    ;; Put class instance index into the class root & cache it in the class object
-    (update-indexed-record class indexed-slot-names :class-indexed t)
-    (with-transaction (:store-controller sc)
-      (let ((class-idx (build-indexed-btree sc)))
-	(setf (get-value (class-name class) croot) class-idx)
-	(setf (%index-cache class) class-idx)
+      (when found 
+	  (if (indexed class)
+	      (error "Class is already enabled for indexing!  Run disable class indexing to clean up.")
+	      (progn
+		(let ((slots nil))
+		  (map-indices (lambda (k v) (declare (ignore v)) (push k slots)) btree)
+		  (warn "Class has pre-existing database index, enabling indexing for slots: ~A" 
+			(setf indexed-slot-names (union slots indexed-slot-names)))))))
+      ;; Put class instance index into the class root & cache it in the class object
+      (update-indexed-record class indexed-slot-names :class-indexed t)
+      (with-transaction (:store-controller sc)
+	(when (not found)
+	  (let ((class-idx (build-indexed-btree sc)))
+	    (setf (get-value (class-name class) croot) class-idx)
+	    (setf (%index-cache class) class-idx)))
 	;; Add all the indexes
 	(loop for slot in indexed-slot-names do
-	     (add-class-slot-index class slot :populate nil :sc sc))
+	     (unless (find-inverted-index class slot :null-on-fail t)
+	       (add-class-slot-index class slot :populate nil :sc sc))))
 	;; Sanity check
-	(let ((record (indexed-record class)))
-	  (declare (ignorable record))
-	  (assert (indexed class)))
-	class-idx))))
+      (let ((record (indexed-record class)))
+	(declare (ignorable record))
+	(assert (indexed class)))
+      (find-class-index class :sc sc :errorp t))))
   
 (defmethod disable-class-indexing ((class-name symbol) &key (errorp t) (sc *store-controller*))
   (let ((class (find-class class-name errorp)))