[elephant-cvs] CVS elephant/src/elephant
ieslick
ieslick at common-lisp.net
Fri Mar 30 23:36:54 UTC 2007
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")))
More information about the Elephant-cvs
mailing list