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)))