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

[blee at common-lisp.net]

Update of /project/elephant/cvsroot/elephant/src
In directory common-lisp.net:/tmp/cvs-serv23923/src

Modified Files:
	collections.lisp 
Log Message:
integrated with new serializer

Date: Thu Aug 26 19:58:28 2004
Author: blee

Index: elephant/src/collections.lisp
diff -u elephant/src/collections.lisp:1.1.1.1 elephant/src/collections.lisp:1.2
--- elephant/src/collections.lisp:1.1.1.1	Thu Aug 19 10:05:14 2004
+++ elephant/src/collections.lisp	Thu Aug 26 19:58:28 2004
@@ -3,93 +3,51 @@
 ;;; collection types
 ;;; abstract hash-like collections
 ;;; equal hashing (except probably for array, hashe, instance keys!)
-(defclass collection ()
-  ((%db :accessor db))
-  (:metaclass persistent-metaclass))
-
-(defmethod initialize-instance :before ((instance collection)
-					&rest initargs
-					&key store-controller
-					&allow-other-keys)
-  (declare (ignore initargs))
-  (setf (get-store-controller instance) store-controller))
-
-(defmethod initialize-instance :after ((instance collection)
-				       &rest initargs)
-  (declare (ignore initargs))
-  (register-collection (get-store-controller instance) instance))
+(defclass collection (persistent) ())
 
 (defgeneric get-value (key ht &rest args))
 (defgeneric remove-kv (key ht &rest args))
 
-;;; auto-serialize keys, values
-(defclass serial-hash-mixin () ())
-
-(defmethod get-value (key (ht serial-hash-mixin) &rest args)
-  (deserialize (apply #'db-get (db ht) (serialize key) args)
-	       (get-store-controller ht)))
-
-(defmethod (setf get-value) (value key (ht serial-hash-mixin) &rest args
-				   &key (transaction *transaction*)
-				   &allow-other-keys)
-  (apply #'%db-put (db ht) (serialize key) (serialize value)
-	   :transaction transaction args))
-
-(defmethod remove-kv (key (ht serial-hash-mixin) &rest args
-			  &key (transaction *transaction*) &allow-other-keys)
-  (apply #'%db-remove (db ht) (serialize key) :transaction transaction args))
-
-;;; string keys, values
-(defclass string-hash-mixin () ())
-
-(defmethod get-value (key (ht string-hash-mixin) &rest args)
-  (apply #'db-get (db ht) key args))
-
-(defmethod (setf get-value) (value key (ht string-hash-mixin) &rest args
-				   &key (transaction *transaction*)
-				   &allow-other-keys)
-  (apply #'%db-put (db ht) key value :transaction transaction args))
-
-(defmethod remove-kv (key (ht string-hash-mixin) &rest args
-			  &key (transaction *transaction*) &allow-other-keys)
-  (apply #'%db-remove (db ht) key :transaction transaction args))
-
 ;;; btree access
-(defclass %btree (collection) ()
-  (:metaclass persistent-metaclass))
-
-(defmethod initialize-instance :after ((instance %btree) &rest initargs)
-  (declare (ignore initargs))
-  (setf (db instance)
-	(create-table (get-store-controller instance)
-		      "p-btrees"
-		      (prin1-to-string (oid instance))
-		      :type :btree)))
-
-;;; persistent serialized object btrees
-(defclass p-btree (%btree serial-hash-mixin) ()
-  (:metaclass persistent-metaclass))
-
-;;; persistent string btree
-(defclass p-string-btree (%btree string-hash-mixin) ()
-  (:metaclass persistent-metaclass))
-
-;;; hash-table access
-(defclass %hash-table (collection) ()
-  (:metaclass persistent-metaclass))
-
-(defmethod initialize-instance :after ((instance %hash-table) &rest initargs)
-  (declare (ignore initargs))
-  (setf (db instance)
-	(create-table (get-store-controller instance)
-		      "p-hash-tables"
-		      (prin1-to-string (oid instance))
-		      :type :hash)))
-
-;;; persistent serialized object hash-tables
-(defclass p-hash-table (%hash-table serial-hash-mixin) ()
-  (:metaclass persistent-metaclass))
+(defclass btree (collection) ())
 
-;;; persistent string hash-tables
-(defclass p-string-hash-table (%hash-table string-hash-mixin) ()
-  (:metaclass persistent-metaclass))
+(defmethod get-value (key (ht btree) &rest args)
+  (declare (ignore args))
+  (buffer-write-int (oid ht) *key-buf*)
+  (let ((key-length (serialize key *key-buf*)))
+    (handler-case 
+	(values
+	 (deserialize (db-get-key-buffered (db *store-controller*) 
+					   (buffer-stream-buffer *key-buf*)
+					   key-length))
+	 t)
+      (db-error (err)
+	(if (= (db-error-errno err) DB_NOTFOUND)
+	    (values nil nil)
+	    (error err))))))
+
+(defmethod (setf get-value) (value key (ht btree) &rest args
+			     &key (transaction *current-transaction*)
+			     (auto-commit *auto-commit*)
+			     &allow-other-keys)
+  (declare (ignore args))
+  (buffer-write-int (oid ht) *key-buf*)
+  (let ((key-length (serialize key *key-buf*))
+	(val-length (serialize value *out-buf*)))
+    (db-put-buffered (db *store-controller*) 
+		     (buffer-stream-buffer *key-buf*) key-length
+		     (buffer-stream-buffer *out-buf*) val-length
+		     :transaction transaction
+		     :auto-commit auto-commit)))
+
+(defmethod remove-kv (key (ht btree) &rest args
+		      &key (transaction *current-transaction*) 
+		      (auto-commit *auto-commit*)
+		      &allow-other-keys)
+  (declare (ignore args))
+  (buffer-write-int (oid ht) *key-buf*)
+  (let ((key-length (serialize key *key-buf*)))
+    (db-delete-buffered (db *store-controller*) 
+			(buffer-stream-buffer *key-buf*) key-length
+			:transaction transaction
+			:auto-commit auto-commit)))