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