[elephant-cvs] CVS update: elephant/src/controller.lisp

[blee at common-lisp.net]

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 , at 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)
 	 , at 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))
+