Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv16382/src/elephant
Modified Files: controller.lisp package.lisp serializer.lisp serializer1.lisp serializer2.lisp Log Message: char to unsigned char fix in BDB; cleaned up modular serializer initialization in BDB and SQL backends and main protocol
--- /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2007/02/03 04:09:13 1.28 +++ /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2007/02/04 04:34:57 1.29 @@ -98,48 +98,6 @@ (asdf:operate 'asdf:load-op dep))) dep-list))
-;; ================================================ -;; -;; USER API TO CONTROLLER OPS -;; -;; ================================================ - - -;; -;; Open a Store -;; - -(defun open-store (spec &rest args) - "Conveniently open a store controller. Set *store-controller* to the new controller - unless it is already set (opening a second controller means you must keep track of - controllers yourself. *store-controller* is a convenience variable for single-store - applications" - (assert (consp spec)) - (let ((controller (get-controller spec))) - (unless *store-controller* - (setq *store-controller* controller)) - (load-user-configuration controller) - (initialize-serializer controller) - (apply #'open-controller controller args) - controller)) - -(defun close-store (&optional sc) - "Conveniently close the store controller." - (when (or sc *store-controller*) - (close-controller (or sc *store-controller*))) - (unless sc - (setf *store-controller* nil))) - -(defmacro with-open-store ((spec) &body body) - "Executes the body with an open controller, -unconditionally closing the controller on exit." - `(let ((*store-controller* nil)) - (declare (special *store-controller*)) - (open-store ,spec) - (unwind-protect - (progn ,@body) - (close-store *store-controller*)))) - ;; ;; COMMON STORE CONTROLLER FUNCTIONALITY ;; @@ -160,7 +118,6 @@ (instance-cache-lock :accessor instance-cache-lock :initform (ele-make-lock) :documentation "Protection for updates to the cache from multiple threads") ;; Upgradable serializer strategy - (database-version :accessor controller-version-cached :initform nil) (serializer-version :accessor controller-serializer-version :initform nil) (serialize :accessor controller-serialize :initform nil) (deserialize :accessor controller-deserialize :initform nil) @@ -170,25 +127,25 @@ handles, the cache, table creation, counters, locks, the root (for garbage collection,) et cetera."))
-;; User configuration parameters for the controller - -(defun load-user-configuration (controller) - ;; Placeholder - (declare (ignorable controller)) - nil) - -(defun initialize-serializer (sc) - "Establish serializer version on controller startup" - (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)) - (t - (setf (controller-serializer-version sc) 2) - (setf (controller-serialize sc) 'elephant-serializer2::serialize) - (setf (controller-deserialize sc) 'elephant-serializer2::deserialize)))) - +;; +;; Database versioning +;;
+(defgeneric database-version (sc) + (:documentation "Backends implement this to store the serializer version. + The protocol requires that backends report their database + version. On new database creation, the database is written with the + *elephant-code-version* so that is returned by database-version. + If a legacy database does not have a version according to the method + then it should return nil")) + +(defmethod database-version :around (sc) + "Default version assumption for unmarked databases is 0.6.0" +;; NOTE: It is possible to check for 0.5.0 databases, but it is not +;; implemented now due to the low (none?) number of users still on 0.5.0" + (let ((db-version (call-next-method))) + (if db-version db-version + '(0 6 0))))
(defun prior-version-p (v1 v2) "Is v1 an equal or earlier version than v2" @@ -197,42 +154,73 @@ ((and (not (null v1)) (null v2)) nil) ((< (car v1) (car v2)) t) ((> (car v1) (car v2)) nil) - ((= (car v1) (car v2)) + ((= (car v1) (car v2)) (prior-version-p (cdr v1) (cdr v2))) - (t (error "Version problem!")))) + (t (error "Version comparison problem: (prior-version-p ~A ~A)" v1 v2))))
;; -;; OBJECT CACHE +;; Database upgrade paths ;;
-(defun cache-instance (sc obj) - "Cache a persistent object with the controller." - (declare (type store-controller sc)) - (ele-with-lock ((instance-cache-lock sc)) - (setf (get-cache (oid obj) (instance-cache sc)) obj))) +(defparameter *elephant-upgrade-table* + '( ((0 6 0) (0 5 0)) + ((0 6 1) (0 6 0)) + ))
-(defun get-cached-instance (sc oid class-name) - "Get a cached instance, or instantiate!" - (declare (type store-controller sc) - (type fixnum oid)) - (let ((obj (get-cache oid (instance-cache sc)))) - (if obj obj - ;; Should get cached since make-instance calls cache-instance - (make-instance (handle-legacy-classes class-name nil) - :from-oid oid :sc sc)))) +(defmethod up-to-date-p ((sc store-controller)) + (equal (database-version sc) *elephant-code-version*))
-(defmethod flush-instance-cache ((sc store-controller)) - "Reset the instance cache (flush object lookups). Useful - for testing. Does not reclaim existing objects so there - will be duplicate instances with identical functionality" - (ele-with-lock ((instance-cache-lock sc)) - (setf (instance-cache sc) - (make-cache-table :test 'eql)))) +(defmethod upgradable-p ((sc store-controller)) + "Determine if this store can be brought up to date using the upgrade function" + (unwind-protect + (let ((row (assoc *elephant-code-version* *elephant-upgrade-table* :test #'equal)) + (ver (database-version sc))) + (when (member ver (rest row) :test #'equal)) t) + nil)) + +(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" + (controller-spec sc) + (database-version sc) + *elephant-code-version* + *elephant-upgrade-table*)) + (warn "Please read the current limitations on migrate-based upgrade in migrate.lisp to ensure your + data does not require any unsupported features") + (let ((source sc) + (target (open-store target-spec))) + (migrate target source) + (close-store target))) + + +;; +;; Modular serializer support and default serializers for a version +;; + +(defmethod initialize-serializer ((sc store-controller)) + "Establish serializer version on controller startup. Backends call this before + they need the serializer to be valid and after they enable their database-version + call. If the backend shadows this, it has to keep track of serializer versions + 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)) + (t + (setf (controller-serializer-version sc) 2) + (setf (controller-serialize sc) 'elephant-serializer2::serialize) + (setf (controller-deserialize sc) 'elephant-serializer2::deserialize)))) + +;; +;; Handling package changes in legacy databases +;;
(defparameter *legacy-conversions-db* - '((("elephant" . "bdb-btree") . ("sleepycat" . "bdb-btree")) + '(;; 0.5.0 support + (("elephant" . "bdb-btree") . ("sleepycat" . "bdb-btree")) (("elephant" . "bdb-indexed-btree") . ("sleepycat" . "bdb-indexed-btree")) (("elephant" . "bdb-btree-index") . ("sleepycat" . "bdb-btree-index")) + ;; 0.6.0 support (("sleepycat" . "bdb-btree") . ("db-bdb" . "bdb-btree")) (("sleepycat" . "bdb-indexed-btree") . ("db-bdb" . "bdb-indexed-btree")) (("sleepycat" . "bdb-btree-index") . ("db-bdb" . "bdb-btree-index")))) @@ -252,19 +240,40 @@ (defun string-pair->symbol (name) (intern (string-upcase (cdr name)) (car name)))
- - ;; -;; VERSIONING +;; Per-controller instance caching ;;
-(defgeneric database-version (sc) - (:documentation "Backends implement this to store the serializer version") - ) +(defun cache-instance (sc obj) + "Cache a persistent object with the controller." + (declare (type store-controller sc)) + (ele-with-lock ((instance-cache-lock sc)) + (setf (get-cache (oid obj) (instance-cache sc)) obj))) + +(defun get-cached-instance (sc oid class-name) + "Get a cached instance, or instantiate!" + (declare (type store-controller sc) + (type fixnum oid)) + (let ((obj (get-cache oid (instance-cache sc)))) + (if obj obj + ;; Should get cached since make-instance calls cache-instance + (make-instance (handle-legacy-classes class-name nil) + :from-oid oid :sc sc))))
+(defmethod flush-instance-cache ((sc store-controller)) + "Reset the instance cache (flush object lookups). Useful + for testing. Does not reclaim existing objects so there + will be duplicate instances with identical functionality" + (ele-with-lock ((instance-cache-lock sc)) + (setf (instance-cache sc) + (make-cache-table :test 'eql)))) + + +;; ================================================================================ ;; -;; STORE CONTROLLER PROTOCOL -;; +;; BACKEND STORE CONTROLLER PROTOCOL +;; +;; ================================================================================
(defgeneric open-controller (sc &key recover recover-fatal thread &allow-other-keys) (:documentation @@ -276,6 +285,11 @@ "Close the db handles and environment. Tries to wipe out references to the db handles."))
+(defmethod close-controller :after ((sc store-controller)) + "Delete connection spec so store-controller operations on cached + controller information fail" + (remhash (controller-spec sc) *dbconnection-spec*)) + (defgeneric connection-is-indeed-open (controller) (:documentation "Validate the controller and the db that it is connected to") (:method ((controller t)) t)) @@ -289,9 +303,70 @@ "Tell the backend to reclaim any storage caused by key deletion, if possible. This should default to return space to the filesystem rather than just to the free list."))
+;; +;; Low-level support for metaclass protocol +;; + +(defgeneric persistent-slot-reader (sc instance name) + (:documentation + "Backend specific slot reader function")) + +(defgeneric persistent-slot-writer (sc new-value instance name) + (:documentation + "Backend specific slot writer function"))
+(defgeneric persistent-slot-boundp (sc instance name) + (:documentation + "Backend specific slot bound test function")) + +(defgeneric persistent-slot-makunbound (sc instance name) + (:documentation + "Backend specific slot makunbound handler")) + + +;; ================================================================================ ;; -;; Object Root Operations +;; CONTROLLER USER API +;; +;; ================================================================================ + + +;; +;; Opening and closing backend stores +;; + +(defun open-store (spec &rest args) + "Conveniently open a store controller. Set *store-controller* to the new controller + unless it is already set (opening a second controller means you must keep track of + controllers yourself. *store-controller* is a convenience variable for single-store + applications or single-store per thread apps" + (assert (consp spec)) + (let ((controller (get-controller spec))) + (apply #'open-controller controller args) + (if *store-controller* + controller + (setq *store-controller* controller)))) + +(defun close-store (&optional sc) + "Conveniently close the store controller." + (when (or sc *store-controller*) + (close-controller (or sc *store-controller*))) + (unless sc + (setf *store-controller* nil))) + +(defmacro with-open-store ((spec) &body body) + "Executes the body with an open controller, + unconditionally closing the controller on exit." + `(let ((*store-controller* nil)) + (declare (special *store-controller*)) + (open-store ,spec) + (unwind-protect + (progn ,@body) + (close-store *store-controller*)))) + + +;; +;; Operations on the root index ;;
(defun add-to-root (key value &key (store-controller *store-controller*)) @@ -299,7 +374,7 @@ retrieve it in a later session. N.B. this means it (and everything it points to) won't get gc'd." (declare (type store-controller store-controller)) -;; (assert (not (eq key *elephant-properties-label*))) + (assert (not (eq key *elephant-properties-label*))) (setf (get-value key (controller-root store-controller)) value))
(defun get-from-root (key &key (store-controller *store-controller*)) @@ -324,15 +399,23 @@ (map-btree fn (controller-root store-controller)))
;; -;; Handling dbconnection specs +;; Explicit storage reclamation ;;
-(defmethod close-controller :after ((sc store-controller)) - "Delete connection spec so object ops on cached db info fail" - (remhash (controller-spec sc) *dbconnection-spec*)) +(defmethod drop-pobject ((inst persistent-object)) + "Reclaim persistent object storage by unbinding slot values. + This does not delete the cached object instance or any + serialized references still in the db. + Need a migration or GC for that!" + (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)))))
;; -;; DATABASE PROPERTY INTERFACE (Not used by system as of 0.6.1) +;; DATABASE PROPERTY INTERFACE (Not used by system as of 0.6.1, but supported) ;;
(defvar *restricted-properties* '() @@ -358,42 +441,6 @@ (when entry (cdr entry))))
- -;; -;; Upgrade paths -;; - -(defmethod up-to-date-p ((sc store-controller)) - (equal (database-version sc) *elephant-code-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" - (controller-spec sc) - (database-version sc) - *elephant-code-version* - *elephant-upgrade-table*)) - (warn "Please read the current limitations on migrate-based upgrade in migrate.lisp to ensure your - data does not require any unsupported features") - (let ((source sc) - (target (open-store target-spec))) - (migrate target source) - (close-store target))) - -(defparameter *elephant-upgrade-table*
[57 lines skipped] --- /project/elephant/cvsroot/elephant/src/elephant/package.lisp 2007/02/03 00:57:34 1.10 +++ /project/elephant/cvsroot/elephant/src/elephant/package.lisp 2007/02/04 04:34:57 1.11 @@ -30,8 +30,6 @@ #:with-elephant-variables
#:store-controller #:controller-root #:controller-class-root - #:controller-version #:controller-serializer-version - #:controller-serialize #:controller-deserialize #:open-store #:close-store #:with-open-store #:add-to-root #:get-from-root #:remove-from-root #:root-existsp #:get-cached-instance #:flush-instance-cache @@ -39,6 +37,15 @@ #:controller-fast-symbols-p #:optimize-storage
+ #:controller-version #:controller-serializer-version + #:controller-serialize #:controller-deserialize + #:serialize-database-version-key + #:serialize-database-version-value + #:deserialize-database-version-value + #:serialize-database-serializer-version-value + #:deserialize-database-serializer-version-value + #:initialize-serializer + #:with-transaction #:ensure-transaction #:start-ele-transaction #:commit-transaction #:abort-transaction
--- /project/elephant/cvsroot/elephant/src/elephant/serializer.lisp 2007/02/02 23:51:58 1.20 +++ /project/elephant/cvsroot/elephant/src/elephant/serializer.lisp 2007/02/04 04:34:57 1.21 @@ -64,7 +64,64 @@ target (cl-base64::base64-string-to-usb8-array string)) sc))) + +;; +;; Serializer independant system information +;; +;; We'll can this for now, can expose as API for backend later + +(defconstant +reserved-dbinfo+ #xF0)
+(defconstant +elephant-version+ 1) +(defconstant +elephant-serializer-version+ 2) + +;; Database Version (a list of integers = [version major minor]) + +(defun serialize-database-version-key (bs) + (serialize-reserved-tag bs) + (serialize-system-tag +elephant-version+ bs)) + +(defun serialize-database-version-value (version bs) + "Simple serializes a list containing three integers" + (assert (consp version)) + (destructuring-bind (version major minor) version + (serialize-system-integer version bs) + (serialize-system-integer major bs) + (serialize-system-integer minor bs))) + +(defun deserialize-database-version-value (bs) + (let ((version (deserialize-system-integer bs)) + (major (deserialize-system-integer bs)) + (minor (deserialize-system-integer bs))) + (list version major minor))) + +;; +;; Serializer version (so you know what encoding is/was used in the db) +;; + +(defun serialize-database-serializer-version-key (bs) + (serialize-reserved-tag bs) + (serialize-system-tag +elephant-serializer-version+ bs)) + +(defun serialize-database-serializer-version-value (version bs) + (serialize-system-integer version bs)) + +(defun deserialize-database-serializer-version-value (bs) + (deserialize-system-integer bs)) + +;; Simple API for basic byte and integer operations + +(defun serialize-reserved-tag (bs) + (elephant-memutil::buffer-write-byte +reserved-dbinfo+ bs)) + +(defun serialize-system-tag (byte bs) + (elephant-memutil::buffer-write-byte byte bs)) + +(defun serialize-system-integer (int bs) + (elephant-memutil::buffer-write-int32 int bs)) +(defun deserialize-system-integer (bs) + (elephant-memutil::buffer-read-int32 bs)) +
;; (defclass blob () ;; ((slot1 :accessor slot1 :initarg :slot1) --- /project/elephant/cvsroot/elephant/src/elephant/serializer1.lisp 2007/02/01 04:03:27 1.3 +++ /project/elephant/cvsroot/elephant/src/elephant/serializer1.lisp 2007/02/04 04:34:57 1.4 @@ -71,6 +71,8 @@ (defconstant +object+ 18) (defconstant +array+ 19)
+(defconstant +reserved-dbinfo+ #xF0) + (defconstant +fill-pointer-p+ #x40) (defconstant +adjustable-p+ #x80)
--- /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp 2007/02/03 00:57:34 1.11 +++ /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp 2007/02/04 04:34:57 1.12 @@ -77,6 +77,7 @@ (defconstant +class+ 21)
(defconstant +nil+ #x3F) +(defconstant +reserved-dbinfo+ #xF0)
;; Arrays (defconstant +fill-pointer-p+ #x20)