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

Modified Files: classindex.lisp controller.lisp Log Message: Added legacy upgrade support, fixed some store-controller base class functionality for SQL to properly delete connections on close

--- /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp 2006/03/01 18:57:34 1.6 +++ /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp 2006/03/07 14:12:22 1.7 @@ -368,9 +368,9 @@ (get-instances-by-value (find-class class) slot-name value))

(defmethod get-instances-by-value ((class persistent-metaclass) slot-name value) - (declare - (optimize (speed 3) (safety 1) (space 1)) - (type (or string symbol) slot-name)) +;; (declare +;; (optimize (speed 3) (safety 1) (space 1)) +;; (type (or string symbol) slot-name)) (let ((instances nil)) (with-btree-cursor (cur (find-inverted-index class slot-name)) (multiple-value-bind (exists? skey val pkey) (cursor-pset cur value) @@ -388,9 +388,9 @@ (get-instances-by-range (find-class class) slot-name start end))

(defmethod get-instances-by-range ((class persistent-metaclass) idx-name start end) - (declare (optimize speed (safety 1) (space 1)) - (type fixnum start end) - (type string idx-name)) +;; (declare (optimize speed (safety 1) (space 1)) +;; (type fixnum start end) +;; (type string idx-name)) (with-inverted-cursor (cur class idx-name) (labels ((next-range (instances) (multiple-value-bind (exists? skey val pkey) (cursor-pnext-nodup cur) --- /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2006/02/21 19:40:03 1.6 +++ /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2006/03/07 14:12:22 1.7 @@ -178,7 +178,8 @@ (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 :sc sc)))) + (make-instance (handle-legacy-classes class-name) + :from-oid oid :sc sc))))

(defmethod flush-instance-cache ((sc store-controller)) "Reset the instance cache (flush object lookups). Useful @@ -187,6 +188,24 @@ (setf (instance-cache sc) (make-cache-table :test 'eql)))

+(defun handle-legacy-classes (name) + (let ((entry (assoc (symbol->string-pair name) *legacy-conversions-db* :test #'equal))) + (if entry + (string-pair->symbol (cdr entry)) + name))) + +(defun symbol->string-pair (name) + (cons (string-downcase (package-name (symbol-package name))) + (string-downcase (symbol-name name)))) + +(defun string-pair->symbol (name) + (intern (string-upcase (cdr name)) (car name))) + +(defparameter *legacy-conversions-db* + '((("elephant" . "bdb-btree") . ("sleepycat" . "bdb-btree")) + (("elephant" . "bdb-indexed-btree") . ("sleepycat" . "bdb-indexed-btree")) + (("elephant" . "bdb-btree-index") . ("sleepycat" . "bdb-btree-index")))) + ;; ;; STORE CONTROLLER PROTOCOL ;; @@ -212,6 +231,12 @@ (:documentation "Provides a persistent source of unique id's"))

+;; Handling dbconnection specs + +(defmethod close-controller :after ((sc store-controller)) + "Delete connection spec so object ops on cached db info fail" + (remhash (controller-spec sc) *dbconnection-spec*)) + ;; Low-level support for metaclass protocol

(defgeneric persistent-slot-reader (sc instance name) @@ -262,4 +287,23 @@ "Map over all key-value pairs in the root" (map-btree fn (controller-root store-controller)))

+;; +;; Explicit storage reclamation +;; + +(defmethod drop-pobject ((inst persistent-object)) + "Reclaim persistent object storage by unbinding slot values. + This also drops references to the instance from any index + it partipates in. This does not delete the cached object + instance or any serialized references still in the db. + Need a migration or GC for that!" + (when (indexed (class-of inst)) + (drop-instances (list inst))) + (let ((pslots (persistent-slots (class-of inst)))) + (dolist (slot pslots) + (slot-makunbound inst slot)))) +;; (slot-makunbound-using-class (class-of inst) +;; inst +;; (find-effective-slot-def (class-of inst) slot))))) +