Update of /project/elephant/cvsroot/elephant/src In directory common-lisp.net:/tmp/cvs-serv23899/src
Modified Files: controller.lisp Log Message: the great simplification effort - specials
Date: Thu Aug 26 19:58:09 2004 Author: blee
Index: elephant/src/controller.lisp diff -u elephant/src/controller.lisp:1.1.1.1 elephant/src/controller.lisp:1.2 --- elephant/src/controller.lisp:1.1.1.1 Thu Aug 19 10:05:14 2004 +++ elephant/src/controller.lisp Thu Aug 26 19:58:09 2004 @@ -1,21 +1,14 @@ (in-package "ELEPHANT")
-(defparameter *store-controller* nil - "The default store controller which persistent objects talk to.") - (defclass store-controller () - ((path :reader path + ((path :type (or pathname string) + :reader path :initarg :path) - (environment :accessor environment) + (environment :type (or null pointer-void) :accessor environment) + (db :type (or null pointer-void) :accessor db) (root :accessor root) - ;(oid-counter :reader oid-counter) - (persistent-classes :accessor persistent-classes - :initform (make-hash-table)) - (collections :accessor collections - :initform (make-hash-table :test 'eql)) (instance-cache :accessor instance-cache - :initform (make-hash-table :test 'eql)) - (dbs :accessor dbs :initform nil)) + :initform (make-cache-table :test 'eql))) (:documentation "Class of objects responsible for handling the book-keeping of holding DB handles, the cache, table creation, counters, locks, the root and garbage collection, @@ -33,112 +26,58 @@ "Get a persistent thing from the root." (get-value key (root sc)))
-(defmethod register-class-slots ((sc store-controller) class slots) - "Register a user-defined subclass of persistent-class with -the controller." - (setf (gethash class (persistent-classes sc)) slots)) - -(defmethod register-class-slots (sc class slots) - nil) - -(defmethod register-collection ((sc store-controller) col) - "Register a collection instance with the controller." - (setf (gethash (oid col) (collections sc)) col)) - -(defmethod register-instance ((sc store-controller) obj) +(defmethod cache-instance ((sc store-controller) obj) "Register an instance of a user persistent-class with the controller." - (setf (gethash (oid obj) (instance-cache sc)) obj)) + (setf (get-cache (oid obj) (instance-cache sc)) obj))
-(defmethod open-controller ((sc store-controller) &key recover) +(defmethod get-cached-instance ((sc store-controller) oid class-name) + (let ((obj (get-cache oid (instance-cache sc) nil))) + (if obj obj + ;; Should get cached since make-instance calls cache-instance + (make-instance class-name :from-oid oid)))) + +(defmethod open-controller ((sc store-controller)) "Opens the underlying environment and all the necessary -database tables. Initializes registered persistent-classes." - (let ((env (db-create-environment))) +database tables." + (let ((env (db-env-create))) ;; thread stuff? - (db-open-environment env (path sc) :create t :recover recover) (setf (environment sc) env) - (let ((root (make-instance 'p-btree :from-oid -1 - :store-controller sc))) - (setf (root sc) root) - (initialize-classes sc) - sc))) - -(defmethod initialize-classes ((sc store-controller)) - "Setup class slots which point to the tables which store -the persisted slots. This is hacky because i don't know how -to set the class-slots of a class without an instance" - (loop for pclass being the hash-key in (persistent-classes sc) using (hash-value slots) - for obj = (make-instance pclass :from-oid -1 :store-controller sc) - do - (remhash -1 (instance-cache sc)) - (loop for slot in slots - for db = (create-table sc (concatenate 'string "CLASS:" - (symbol-name pclass)) - (symbol-name slot) - :type :btree) - do (setf (slot-value obj slot) db)))) + (db-env-open env (path sc) :create t :init-txn t :init-lock t + :init-mpool t :init-log t :thread t :recover-fatal t) + (let ((db (db-create env))) + (setf (db sc) db) + (db-open db :auto-commit t :type DB-BTREE :create t :thread t) + (let ((root (make-instance 'btree :from-oid -1))) + (setf (root sc) root) + sc))))
(defmethod close-controller ((sc store-controller)) "Close the db handles and environment. Tries to wipe out references to the db handles." ; no root (setf (root sc) nil) - ; clean collections - (maphash #'(lambda (k v) (declare (ignore k)) - (setf (db v) nil)) - (collections sc)) - (setf (collections sc) (make-hash-table :test 'eql)) - ; clean classes - (deinitialize-classes sc) - ;(setf (persistent-classes sc) (make-hash-table)) - ; close dbs - (mapc #'(lambda (v) (db-close v)) (dbs sc)) - (setf (dbs sc) nil) ; clean instance cache - (setf (instance-cache sc) (make-hash-table :test 'eql)) + (setf (instance-cache sc) (make-cache-table :test 'eql)) ; close environment - (db-close (environment sc)) + (db-close (db sc)) + (setf (db sc) nil) + (db-env-close (environment sc)) (setf (environment sc) nil) - t) - -(defmethod deinitialize-classes ((sc store-controller)) - (loop for pclass being the hash-key in (persistent-classes sc) using (hash-value slots) - for obj = (make-instance pclass :from-oid -1) - do - (remhash -1 (instance-cache sc)))) - -;; diked out, since our new methodology doesn't allow this -;; (loop for slot in slots -;; do (setf obj slot nil)))) - -(defmethod create-table ((sc store-controller) file name &rest args) - (let ((db (db-create :environment (environment sc)))) - (apply #'db-open `(,db ,file ,name :create t :auto-commit t ,@args)) - (push db (dbs sc)) - db)) - -(defmethod get-instance ((sc store-controller) oid classname) - (let ((obj (gethash oid (instance-cache sc) nil))) - (if obj obj - (setf (gethash oid (instance-cache sc)) - (make-instance (find-class (intern classname)) - :from-oid oid))))) - -(defmethod get-collection ((sc store-controller) oid class) - (gethash oid (collections sc) - :default (make-instance class :from-oid oid))) - -(defconstant max-oid (- (expt 2 64) 1)) - -(defmethod next-oid ((sc store-controller)) - (random max-oid)) + nil)
-(defmacro with-open-controller ((&optional (sc *store-controller*) - &key recover) +(defmacro with-open-controller ((&optional (sc *store-controller*)) &body body) `(unwind-protect (progn - (open-controller ,sc :recover ,recover) + (open-controller ,sc) ,@body) (close-controller ,sc))) + +;; This stuff is all a hack until sequences appear in Sleepycat 4.3 +(defconstant max-oid most-positive-fixnum) + +(defmethod next-oid ((sc store-controller)) + (random max-oid)) +