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

Modified Files: backend.lisp classes.lisp collections.lisp controller.lisp metaclasses.lisp serializer2.lisp variables.lisp Log Message: Sanitize class indexing option; more documentation stuff

--- /project/elephant/cvsroot/elephant/src/elephant/backend.lisp 2007/03/30 17:46:14 1.14 +++ /project/elephant/cvsroot/elephant/src/elephant/backend.lisp 2007/03/30 23:36:53 1.15 @@ -76,6 +76,9 @@ #:transaction-store #:transaction-object #:execute-transaction + #:controller-start-transaction + #:controller-abort-transaction + #:controller-commit-transaction

;; Registration #:register-backend-con-init --- /project/elephant/cvsroot/elephant/src/elephant/classes.lisp 2007/03/24 12:16:03 1.24 +++ /project/elephant/cvsroot/elephant/src/elephant/classes.lisp 2007/03/30 23:36:53 1.25 @@ -47,30 +47,16 @@ ;; METACLASS INITIALIZATION AND CHANGES ;; ================================================

-(defmethod ensure-class-using-class :around ((class null) name &rest args &key index) - "Support the :index class option" - (let ((result (apply #'call-next-method class name (remove-keywords '(:index) args)))) - (when (and index (subtypep (type-of result) 'persistent-metaclass)) - (update-indexed-record result nil :class-indexed t)) - result)) - -(defmethod ensure-class-using-class ((class persistent-metaclass) name &rest args &key index) - "Support the :index class option on redefinition" - (let ((result (apply #'call-next-method class name (remove-keywords '(:index) args)))) - (when index - (update-indexed-record result nil :class-indexed t)) - result)) - -(defmethod shared-initialize :around ((class persistent-metaclass) slot-names &rest args &key direct-superclasses) +(defmethod shared-initialize :around ((class persistent-metaclass) slot-names &rest args &key direct-superclasses index) "Ensures we inherit from persistent-object." (let* ((persistent-metaclass (find-class 'persistent-metaclass)) (persistent-object (find-class 'persistent-object)) (not-already-persistent (loop for superclass in direct-superclasses never (eq (class-of superclass) persistent-metaclass)))) + (when index + (update-indexed-record class nil :class-indexed t)) (if (and (not (eq class persistent-object)) not-already-persistent) (apply #'call-next-method class slot-names -;; :direct-superclasses (cons persistent-object -;; direct-superclasses) args) :direct-superclasses (append direct-superclasses (list persistent-object)) args) (call-next-method))))

--- /project/elephant/cvsroot/elephant/src/elephant/collections.lisp 2007/03/25 14:57:49 1.19 +++ /project/elephant/cvsroot/elephant/src/elephant/collections.lisp 2007/03/30 23:36:53 1.20 @@ -339,15 +339,18 @@ (defun lisp-compare-equal (a b) (equal a b))

+(defgeneric map-btree (fn btree &rest args &key start end value) + (:documentation "Map btree maps over a btree from the value start to the value of end. + If values are not provided, then it maps over all values. BTrees + do not have duplicates, but map-btree can also be used with indices + in the case where you don't want access to the primary key so we + require a value argument as well for mapping duplicate value sets.")) + ;; NOTE: the use of nil for the last element in a btree only works because the C comparison ;; function orders by type tag and nil is the highest valued type tag so nils are the last ;; possible element in a btree ordered by value. + (defmethod map-btree (fn (btree btree) &rest args &key start end (value nil value-set-p)) - "Map btree maps over a btree from the value start to the value of end. - If values are not provided, then it maps over all values. BTrees - do not have duplicates, but map-btree can also be used with indices - in the case where you don't want access to the primary key so we - require a value argument as well for mapping duplicate value sets." (let ((end (if value-set-p value end))) (ensure-transaction (:store-controller (get-con btree)) (with-btree-cursor (curs btree) @@ -368,8 +371,8 @@ (funcall fn k v) (return nil)))))))))

-(defmethod map-index (fn (index btree-index) &rest args &key start end (value nil value-set-p)) - "Map-index is like map-btree but for secondary indices, it +(defgeneric map-index (fn btree &rest args &key start end value) + (:documentation "Map-index is like map-btree but for secondary indices, it takes a function of three arguments: key, value and primary key. As with map-btree the keyword arguments start and end determine the starting element and ending element, inclusive. @@ -377,7 +380,9 @@ the last element in the index. If you want to traverse only a set of identical key values, for example all nil values, then use the value keyword which will override any values of start - and end." + and end.")) + +(defmethod map-index (fn (index btree-index) &rest args &key start end (value nil value-set-p)) (declare (dynamic-extent args) (ignorable args)) (let ((sc (get-con index)) --- /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2007/03/30 14:34:35 1.42 +++ /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2007/03/30 23:36:53 1.43 @@ -250,6 +250,12 @@ (when (member ver (rest row) :test #'equal)) t) nil))

+(defgeneric upgrade (sc spec) + (:documentation "Given an open store controller from a prior version, + open a new store specified by spec and migrate the + data from the original store to the new one, upgrading + it to the latest version")) + (defmethod upgrade ((sc store-controller) target-spec) (unless (upgradable-p sc) (error "Cannot upgrade ~A from version ~A to version ~A~%Valid upgrades are:~%~A" @@ -275,12 +281,16 @@ associated with the database version that is opened." (cond ((prior-version-p (database-version sc) '(0 6 0)) (setf (controller-serializer-version sc) 1) - (setf (controller-serialize sc) 'elephant-serializer1::serialize) - (setf (controller-deserialize sc) 'elephant-serializer1::deserialize)) + (setf (controller-serialize sc) + (intern "SERIALIZE" (find-package :ELEPHANT-SERIALIZER1))) + (setf (controller-deserialize sc) + (intern "DESERIALIZE" (find-package :ELEPHANT-SERIALIZER1)))) (t (setf (controller-serializer-version sc) 2) - (setf (controller-serialize sc) 'elephant-serializer2::serialize) - (setf (controller-deserialize sc) 'elephant-serializer2::deserialize)))) + (setf (controller-serialize sc) + (intern "SERIALIZE" (find-package :ELEPHANT-SERIALIZER2))) + (setf (controller-deserialize sc) + (intern "SERIALIZE" (find-package :ELEPHANT-SERIALIZER2))))))

;; ;; Handling package changes in legacy databases --- /project/elephant/cvsroot/elephant/src/elephant/metaclasses.lisp 2007/03/23 16:08:10 1.13 +++ /project/elephant/cvsroot/elephant/src/elephant/metaclasses.lisp 2007/03/30 23:36:53 1.14 @@ -23,8 +23,11 @@ (declaim #-elephant-without-optimize (optimize (speed 3) (safety 1)))

(defclass persistent () - ((%oid :accessor oid :initarg :from-oid) - (dbconnection-spec-pst :type (or list string) :accessor dbcn-spc-pst :initarg :dbconnection-spec-pst)) + ((%oid :accessor oid :initarg :from-oid + :documentation "All persistent objects have an oid") + (dbconnection-spec-pst :type (or list string) :accessor dbcn-spc-pst :initarg :dbconnection-spec-pst + :documentation "Persistent objects use a spec pointer to identify which store + they are connected to")) (:documentation "Abstract superclass for all persistent classes (common to user-defined classes and collections.)"))

--- /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp 2007/03/30 14:34:35 1.34 +++ /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp 2007/03/30 23:36:53 1.35 @@ -24,8 +24,6 @@ (:import-from :elephant *circularity-initial-hash-size* get-cached-instance - controller-symbol-cache - controller-symbol-id-cache slot-definition-allocation slot-definition-name compute-slots --- /project/elephant/cvsroot/elephant/src/elephant/variables.lisp 2007/03/30 17:45:41 1.13 +++ /project/elephant/cvsroot/elephant/src/elephant/variables.lisp 2007/03/30 23:36:53 1.14 @@ -64,10 +64,11 @@ ;; properly load in asdf due to some circular dependencies ;; between lisp files

-(eval-when (load-toplevel compile-toplevel) +(eval-when (:compile-toplevel :load-toplevel) (mapcar (lambda (symbol) (intern symbol :elephant)) - '(get-cached-instance))) + '("GET-CACHED-INSTANCE" + "SET-DB-SYNCH")))