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

Modified Files: collections.lisp Log Message: doc-strings secondary indices cursors

Date: Thu Sep 16 06:14:44 2004 Author: blee

Index: elephant/src/collections.lisp diff -u elephant/src/collections.lisp:1.6 elephant/src/collections.lisp:1.7 --- elephant/src/collections.lisp:1.6 Sun Aug 29 22:36:48 2004 +++ elephant/src/collections.lisp Thu Sep 16 06:14:44 2004 @@ -44,47 +44,774 @@

;;; collection types ;;; we're slot-less -(defclass persistent-collection (persistent) - ()) +(defclass persistent-collection (persistent) () + (:documentation "Abstract superclass of all collection types."))

;;; btree access -(defclass btree (persistent-collection) ()) +(defclass btree (persistent-collection) () + (:documentation "A hash-table like interface to a BTree, +which stores things in a semi-ordered fashion."))

(defgeneric get-value (key ht)) (defgeneric (setf get-value) (value key ht)) -(defgeneric remove-kv (key ht &key transaction auto-commit)) +(defgeneric remove-kv (key ht))

(defmethod get-value (key (ht btree)) - (declare (optimize (speed 3) (safety 0) (space 3))) - (buffer-write-int (oid ht) *key-buf*) - (let* ((key-length (serialize key *key-buf*)) - (buf (db-get-key-buffered - (controller-db *store-controller*) - (buffer-stream-buffer *key-buf*) - key-length))) - (declare (type fixnum key-length)) - (if buf (values (deserialize buf) T) - (values nil nil)))) + "Get a value from a Btree." + (declare (optimize (speed 3))) + (with-buffer-streams (key-buf value-buf) + (buffer-write-int (oid ht) key-buf) + (serialize key key-buf) + (let ((buf (db-get-key-buffered + (controller-btrees *store-controller*) + key-buf value-buf))) + (if buf (values (deserialize buf) T) + (values nil nil)))))

(defmethod (setf get-value) (value key (ht btree)) - (declare (optimize (speed 3) (safety 0))) - (buffer-write-int (oid ht) *key-buf*) - (let ((key-length (serialize key *key-buf*)) - (val-length (serialize value *out-buf*))) - (db-put-buffered (controller-db *store-controller*) - (buffer-stream-buffer *key-buf*) key-length - (buffer-stream-buffer *out-buf*) val-length - :transaction *current-transaction* + "Put a key / value pair into a BTree." + (declare (optimize (speed 3))) + (with-buffer-streams (key-buf value-buf) + (buffer-write-int (oid ht) key-buf) + (serialize key key-buf) + (serialize value value-buf) + (db-put-buffered (controller-btrees *store-controller*) + key-buf value-buf :auto-commit *auto-commit*) value))

-(defmethod remove-kv (key (ht btree) - &key (transaction *current-transaction*) - (auto-commit *auto-commit*)) - (declare (optimize (speed 3) (safety 0))) - (buffer-write-int (oid ht) *key-buf*) - (let ((key-length (serialize key *key-buf*))) - (db-delete-buffered (controller-db *store-controller*) - (buffer-stream-buffer *key-buf*) key-length - :transaction transaction - :auto-commit auto-commit))) +(defmethod remove-kv (key (ht btree)) + "Remove a key / value pair from a BTree." + (declare (optimize (speed 3))) + (with-buffer-streams (key-buf) + (buffer-write-int (oid ht) key-buf) + (serialize key key-buf) + (db-delete-buffered (controller-btrees *store-controller*) + key-buf :auto-commit *auto-commit*))) + + +;; Secondary indices + +(defclass indexed-btree (btree) + ((indices :accessor indices :initform (make-hash-table)) + (indices-cache :accessor indices-cache :initform (make-hash-table) + :transient t)) + (:metaclass persistent-metaclass) + (:documentation "A BTree which supports secondary indices.")) + +(defmethod shared-initialize :after ((instance indexed-btree) slot-names + &rest rest) + (declare (ignore slot-names rest)) + (setf (indices-cache instance) (indices instance))) + +(defgeneric add-index (ht &key index-name key-form)) +(defgeneric get-index (ht index-name)) +(defgeneric remove-index (ht index-name)) + +(defmethod add-index ((ht indexed-btree) &key index-name key-form) + "Add a secondary index. The indices are stored in an eq +hash-table, so the index-name should be a symbol. key-form +should be a symbol naming a function, or a list which +defines a lambda -- actual functions aren't supported. The +function should take 3 arguments: the secondary DB, primary +key and value, and return two values: a boolean indicating +whether to index this key / value, and the secondary key if +so." + (if (and (not (null index-name)) + (symbolp index-name) (or (symbolp key-form) (listp key-form))) + (let ((indices (indices ht)) + (index (make-instance 'btree-index :primary ht + :key-form key-form))) + (setf (gethash index-name (indices-cache ht)) index) + (setf (gethash index-name indices) index) + (setf (indices ht) indices) + index) + (error "Invalid index initargs!"))) + +(defmethod get-index ((ht indexed-btree) index-name) + "Get a named index." + (gethash index-name (indices-cache ht))) + +(defmethod remove-index ((ht indexed-btree) index-name) + "Remove a named index." + (remhash index-name (indices-cache ht)) + (let ((indices (indices ht))) + (remhash index-name indices) + (setf (indices ht) indices))) + +(defmethod (setf get-value) (value key (ht indexed-btree)) + "Set a key / value pair, and update secondary indices." + (declare (optimize (speed 3))) + (let ((indices (indices-cache ht))) + (with-buffer-streams (key-buf value-buf secondary-buf) + (buffer-write-int (oid ht) key-buf) + (serialize key key-buf) + (serialize value value-buf) + (with-transaction () + (db-put-buffered (controller-btrees *store-controller*) + key-buf value-buf) + (loop for index being the hash-value of indices + do + (multiple-value-bind (index? secondary-key) + (funcall (key-fn index) index key value) + (when index? + (buffer-write-int (oid index) secondary-buf) + (serialize secondary-key secondary-buf) + ;; should silently do nothing if the key/value already + ;; exists + (db-put-buffered (controller-indices *store-controller*) + secondary-buf key-buf) + (reset-buffer-stream secondary-buf)))) + value)))) + +(defmethod remove-kv (key (ht indexed-btree)) + "Remove a key / value pair, and update secondary indices." + (declare (optimize (speed 3))) + (with-buffer-streams (key-buf secondary-buf) + (buffer-write-int (oid ht) key-buf) + (serialize key key-buf) + (with-transaction () + (let ((value (get-value key ht))) + (when value + (let ((indices (indices-cache ht))) + (loop + for index being the hash-value of indices + do + (multiple-value-bind (index? secondary-key) + (funcall (key-fn index) index key value) + (when index? + (buffer-write-int (oid index) secondary-buf) + (serialize secondary-key secondary-buf) + ;; need to remove kv pairs with a cursor! -- + ;; this is a C performance hack + (sleepycat::db-delete-kv-buffered + (controller-indices *store-controller*) + secondary-buf key-buf) + (reset-buffer-stream secondary-buf)))) + (db-delete-buffered (controller-btrees *store-controller*) + key-buf))))))) + +(defclass btree-index (btree) + ((primary :type indexed-btree :reader primary :initarg :primary) + (key-form :reader key-form :initarg :key-form) + (key-fn :type function :accessor key-fn :transient t)) + (:metaclass persistent-metaclass) + (:documentation "Secondary index to an indexed-btree.")) + +(defmethod shared-initialize :after ((instance btree-index) slot-names + &rest rest) + (declare (ignore slot-names rest)) + (let ((key-form (key-form instance))) + (if (and (symbolp key-form) (fboundp key-form)) + (setf (key-fn instance) (fdefinition key-form)) + (setf (key-fn instance) (compile nil key-form))))) + +(defmethod get-value (key (ht btree-index)) + "Get the value in the primary DB from a secondary key." + (declare (optimize (speed 3))) + (with-buffer-streams (key-buf value-buf) + (buffer-write-int (oid ht) key-buf) + (serialize key key-buf) + (let ((buf (db-get-key-buffered + (controller-indices-assoc *store-controller*) + key-buf value-buf))) + (if buf (values (deserialize buf) T) + (values nil nil))))) + +(defmethod (setf get-value) (value key (ht btree-index)) + "Puts are not allowed on secondary indices. Try adding to +the primary." + (declare (ignore value key ht)) + (error "Puts are forbidden on secondary indices. Try adding to the primary.")) + +(defgeneric get-primary-key (key ht)) + +(defmethod get-primary-key (key (ht btree-index)) + "Get the primary key from a secondary key." + (declare (optimize (speed 3))) + (with-buffer-streams (key-buf value-buf) + (buffer-write-int (oid ht) key-buf) + (serialize key key-buf) + (let ((buf (db-get-key-buffered + (controller-indices *store-controller*) + key-buf value-buf))) + (if buf + (let ((oid (buffer-read-fixnum buf))) + (values (deserialize buf) oid)) + (values nil nil))))) + +(defmethod remove-kv (key (ht btree-index)) + "Remove a key / value, updating ALL secondary indices." + (declare (optimize (speed 3))) + (remove-kv (get-primary-key key ht) (primary ht))) + + +;; Cursor operations + +(defclass cursor () + ((handle :accessor cursor-handle :initarg :handle) + (oid :accessor cursor-oid :type fixnum :initarg :oid) + (initialized-p :accessor cursor-initialized-p + :type boolean :initform nil :initarg :initialized-p) + (btree :accessor cursor-btree :initarg :btree)) + (:documentation "A cursor for traversing (primary) BTrees.")) + +(defgeneric make-cursor (ht)) +(defgeneric cursor-close (cursor)) +(defgeneric cursor-duplicate (cursor)) +(defgeneric cursor-current (cursor)) +(defgeneric cursor-first (cursor)) +(defgeneric cursor-last (cursor)) +(defgeneric cursor-next (cursor)) +(defgeneric cursor-prev (cursor)) +(defgeneric cursor-set (cursor key)) +(defgeneric cursor-set-range (cursor key)) +(defgeneric cursor-get-both (cursor key value)) +(defgeneric cursor-get-both-range (cursor key value)) +(defgeneric cursor-delete (cursor)) +(defgeneric cursor-put (cursor value &key key)) + +(defmethod make-cursor ((ht btree)) + "Construct a cursor for traversing primary BTrees." + (declare (optimize (speed 3))) + (make-instance 'cursor + :btree ht + :handle (db-cursor (controller-btrees *store-controller*)) + :oid (oid ht))) + +(defmacro with-btree-cursor ((var ht) &body body) + "Macro which opens a named cursor on a BTree (primary or +not), evaluates the forms, then closes the cursor." + `(let ((,var (make-cursor ,ht))) + (unwind-protect + (progn ,@body) + (cursor-close ,var)))) + +(defun map-btree (fn bt) + "Like maphash." + (with-btree-cursor (curs bt) + (loop + (multiple-value-bind (more k v) (cursor-next curs) + (unless more (return nil)) + (funcall fn k v))))) + +(defmethod cursor-close ((cursor cursor)) + "Close the cursor. Make sure to close cursors before the +enclosing transaction is closed!" + (declare (optimize (speed 3))) + (db-cursor-close (cursor-handle cursor)) + (setf (cursor-initialized-p cursor) nil)) + +(defmethod cursor-duplicate ((cursor cursor)) + "Duplicate a cursor." + (declare (optimize (speed 3))) + (make-instance (type-of cursor) + :initialized-p (cursor-initialized-p cursor) + :oid (cursor-oid cursor) + :handle (db-cursor-duplicate + (cursor-handle cursor) + :position (cursor-initialized-p cursor)))) + +(defmethod cursor-current ((cursor cursor)) + "Get the key / value at the cursor position. Returns +has-pair key value, where has-pair is a boolean indicating +there was a pair." + (declare (optimize (speed 3))) + (when (cursor-initialized-p cursor) + (with-buffer-streams (key-buf value-buf) + (multiple-value-bind (key val) + (db-cursor-move-buffered (cursor-handle cursor) key-buf value-buf + :current t) + (if (and key (= (buffer-read-int key) (cursor-oid cursor))) + (progn (setf (cursor-initialized-p cursor) t) + (values t (deserialize key) (deserialize val))) + (setf (cursor-initialized-p cursor) nil)))))) + +(defmethod cursor-first ((cursor cursor)) + "Move the cursor to the beginning of the BTree, returning +has-pair key value." + (declare (optimize (speed 3))) + (with-buffer-streams (key-buf value-buf) + (buffer-write-int (cursor-oid cursor) key-buf) + (multiple-value-bind (key val) + (db-cursor-set-buffered (cursor-handle cursor) + key-buf value-buf :set-range t) + (if (and key (= (buffer-read-int key) (cursor-oid cursor))) + (progn (setf (cursor-initialized-p cursor) t) + (values t (deserialize key) (deserialize val))) + (setf (cursor-initialized-p cursor) nil))))) + +;;A bit of a hack..... +(defmethod cursor-last ((cursor cursor)) + "Move the cursor to the end of the BTree, returning +has-pair key value." + (declare (optimize (speed 3))) + (with-buffer-streams (key-buf value-buf) + (buffer-write-int (+ (cursor-oid cursor) 1) key-buf) + (if (db-cursor-set-buffered (cursor-handle cursor) + key-buf value-buf :set-range t) + (progn (reset-buffer-stream key-buf) + (reset-buffer-stream value-buf) + (multiple-value-bind (key val) + (db-cursor-move-buffered (cursor-handle cursor) + key-buf value-buf :prev t) + (if (and key (= (buffer-read-int key) (cursor-oid cursor))) + (progn + (setf (cursor-initialized-p cursor) t) + (values t (deserialize key) (deserialize val))) + (setf (cursor-initialized-p cursor) nil)))) + (multiple-value-bind (key val) + (db-cursor-move-buffered (cursor-handle cursor) key-buf + value-buf :last t) + (if (and key (= (buffer-read-int key) (cursor-oid cursor))) + (progn + (setf (cursor-initialized-p cursor) t) + (values t (deserialize key) (deserialize val))) + (setf (cursor-initialized-p cursor) nil)))))) + +(defmethod cursor-next ((cursor cursor)) + "Advance the cursor, returning has-pair key value." + (declare (optimize (speed 3))) + (if (cursor-initialized-p cursor) + (with-buffer-streams (key-buf value-buf) + (multiple-value-bind (key val) + (db-cursor-move-buffered (cursor-handle cursor) + key-buf value-buf :next t) + (if (and key (= (buffer-read-int key) (cursor-oid cursor))) + (values t (deserialize key) (deserialize val)) + (setf (cursor-initialized-p cursor) nil)))) + (cursor-first cursor))) + +(defmethod cursor-prev ((cursor cursor)) + "Move the cursor back, returning has-pair key value." + (declare (optimize (speed 3))) + (if (cursor-initialized-p cursor) + (with-buffer-streams (key-buf value-buf) + (multiple-value-bind (key val) + (db-cursor-move-buffered (cursor-handle cursor) + key-buf value-buf :prev t) + (if (and key (= (buffer-read-int key) (cursor-oid cursor))) + (values t (deserialize key) (deserialize val)) + (setf (cursor-initialized-p cursor) nil)))) + (cursor-last cursor))) + +(defmethod cursor-set ((cursor cursor) key) + "Move the cursor to a particular key, returning has-pair +key value." + (declare (optimize (speed 3))) + (with-buffer-streams (key-buf value-buf) + (buffer-write-int (cursor-oid cursor) key-buf) + (serialize key key-buf) + (multiple-value-bind (k val) + (db-cursor-set-buffered (cursor-handle cursor) + key-buf value-buf :set t) + (if k + (progn (setf (cursor-initialized-p cursor) t) + (values t key (deserialize val))) + (setf (cursor-initialized-p cursor) nil))))) + +(defmethod cursor-set-range ((cursor cursor) key) + "Move the cursor to the first key-value pair with key +greater or equal to the key argument, according to the lisp +sorter. Returns has-pair key value." + (declare (optimize (speed 3))) + (with-buffer-streams (key-buf value-buf) + (buffer-write-int (cursor-oid cursor) key-buf) + (serialize key key-buf) + (multiple-value-bind (k val) + (db-cursor-set-buffered (cursor-handle cursor) + key-buf value-buf :set-range t) + (if (and k (= (buffer-read-int k) (cursor-oid cursor))) + (progn (setf (cursor-initialized-p cursor) t) + (values t (deserialize k) (deserialize val))) + (setf (cursor-initialized-p cursor) nil))))) + +(defmethod cursor-get-both ((cursor cursor) key value) + "Moves the cursor to a particular key / value pair, +returning has-pair key value." + (declare (optimize (speed 3))) + (with-buffer-streams (key-buf value-buf) + (buffer-write-int (cursor-oid cursor) key-buf) + (serialize key key-buf) + (serialize value value-buf) + (multiple-value-bind (k v) + (db-cursor-get-both-buffered (cursor-handle cursor) + key-buf value-buf :get-both t) + (declare (ignore v)) + (if k + (progn (setf (cursor-initialized-p cursor) t) + (values t key value)) + (setf (cursor-initialized-p cursor) nil))))) + +(defmethod cursor-get-both-range ((cursor cursor) key value) + "Moves the cursor to the first key / value pair with key +equal to the key argument and value greater or equal to the +value argument. Not really useful for us since primaries +don't have duplicates. Returns has-pair key value." + (declare (optimize (speed 3))) + (with-buffer-streams (key-buf value-buf) + (buffer-write-int (cursor-oid cursor) key-buf) + (serialize key key-buf) + (serialize value value-buf) + (multiple-value-bind (k v) + (db-cursor-get-both-buffered (cursor-handle cursor) + key-buf value-buf :get-both-range t) + (if k + (progn (setf (cursor-initialized-p cursor) t) + (values t key (deserialize v))) + (setf (cursor-initialized-p cursor) nil))))) + +(defmethod cursor-delete ((cursor cursor)) + "Delete by cursor. The cursor is at an invalid position +after a successful delete." + (declare (optimize (speed 3))) + (if (cursor-initialized-p cursor) + (with-buffer-streams (key-buf value-buf) + (multiple-value-bind (key val) + (db-cursor-move-buffered (cursor-handle cursor) key-buf value-buf + :current t) + (declare (ignore val)) + (when (and key (= (buffer-read-int key) (cursor-oid cursor))) + ;; in case of a secondary index this should delete everything + ;; as specified by the BDB docs. + (remove-kv (deserialize key) (cursor-btree cursor))) + (setf (cursor-initialized-p cursor) nil))) + (error "Can't delete with uninitialized cursor!"))) + +(defmethod cursor-put ((cursor cursor) value &key (key nil key-specified-p)) + "Put by cursor. Not particularly useful since primaries +don't support duplicates. Currently doesn't properly move +the cursor." + (declare (optimize (speed 3))) + (if key-specified-p + (setf (get-value key (cursor-btree cursor)) value) + (if (cursor-initialized-p cursor) + (with-buffer-streams (key-buf value-buf) + (multiple-value-bind (k v) + (db-cursor-move-buffered (cursor-handle cursor) key-buf + value-buf :current t) + (declare (ignore v)) + (if (and k (= (buffer-read-int k) (cursor-oid cursor))) + (setf (get-value (deserialize k) (cursor-btree cursor)) + value) + (setf (cursor-initialized-p cursor) nil)))) + (error "Can't put with uninitialized cursor!")))) + +;; Secondary cursors + +(defclass secondary-cursor (cursor) () + (:documentation "Cursor for traversing secondary indices.")) + +(defgeneric cursor-pcurrent (cursor)) +(defgeneric cursor-pfirst (cursor)) +(defgeneric cursor-plast (cursor)) +(defgeneric cursor-pnext (cursor)) +(defgeneric cursor-pprev (cursor)) +(defgeneric cursor-pset (cursor key)) +(defgeneric cursor-pset-range (cursor key)) +(defgeneric cursor-pget-both (cursor key value)) +(defgeneric cursor-pget-both-range (cursor key value)) +(defgeneric cursor-next-dup (cursor)) +(defgeneric cursor-next-nodup (cursor)) +(defgeneric cursor-prev-nodup (cursor)) +(defgeneric cursor-pnext-dup (cursor)) +(defgeneric cursor-pnext-nodup (cursor)) +(defgeneric cursor-pprev-nodup (cursor)) + +(defmethod make-cursor ((ht btree-index)) + "Make a secondary-cursor from a secondary index." + (declare (optimize (speed 3))) + (make-instance 'secondary-cursor + :btree ht + :handle (db-cursor + (controller-indices-assoc *store-controller*)) + :oid (oid ht))) + +(defmethod cursor-pcurrent ((cursor secondary-cursor)) + "Returns has-tuple / secondary key / value / primary key +at the current position." + (declare (optimize (speed 3))) + (when (cursor-initialized-p cursor) + (with-buffer-streams (key-buf pkey-buf value-buf) + (multiple-value-bind (key pkey val) + (db-cursor-pmove-buffered (cursor-handle cursor) + key-buf pkey-buf value-buf + :current t) + (if (and key (= (buffer-read-int key) (cursor-oid cursor))) + (progn (setf (cursor-initialized-p cursor) t) + (values t (deserialize key) (deserialize val) + (progn (buffer-read-int pkey) (deserialize pkey)))) + (setf (cursor-initialized-p cursor) nil)))))) + +(defmethod cursor-pfirst ((cursor secondary-cursor)) + "Moves the key to the beginning of the secondary index. +Returns has-tuple / secondary key / value / primary key." + (declare (optimize (speed 3))) + (with-buffer-streams (key-buf pkey-buf value-buf) + (buffer-write-int (cursor-oid cursor) key-buf) + (multiple-value-bind (key pkey val) + (db-cursor-pset-buffered (cursor-handle cursor) + key-buf pkey-buf value-buf :set-range t) + (if (and key (= (buffer-read-int key) (cursor-oid cursor))) + (progn (setf (cursor-initialized-p cursor) t) + (values t (deserialize key) (deserialize val) + (progn (buffer-read-int pkey) (deserialize pkey)))) + (setf (cursor-initialized-p cursor) nil))))) + +;;A bit of a hack..... +(defmethod cursor-plast ((cursor secondary-cursor)) + "Moves the key to the end of the secondary index. Returns +has-tuple / secondary key / value / primary key." + (declare (optimize (speed 3))) + (with-buffer-streams (key-buf pkey-buf value-buf) + (buffer-write-int (+ (cursor-oid cursor) 1) key-buf) + (if (db-cursor-set-buffered (cursor-handle cursor) + key-buf value-buf :set-range t) + (progn (reset-buffer-stream key-buf) + (reset-buffer-stream value-buf) + (multiple-value-bind (key pkey val) + (db-cursor-pmove-buffered (cursor-handle cursor) key-buf + pkey-buf value-buf :prev t) + (if (and key (= (buffer-read-int key) (cursor-oid cursor))) + (progn + (setf (cursor-initialized-p cursor) t) + (values t (deserialize key) (deserialize val) + (progn (buffer-read-int pkey) + (deserialize pkey)))) + (setf (cursor-initialized-p cursor) nil)))) + (multiple-value-bind (key pkey val) + (db-cursor-pmove-buffered (cursor-handle cursor) key-buf + pkey-buf value-buf :last t) + (if (and key (= (buffer-read-int key) (cursor-oid cursor))) + (progn + (setf (cursor-initialized-p cursor) t) + (values t (deserialize key) (deserialize val) + (progn (buffer-read-int pkey) (deserialize pkey)))) + (setf (cursor-initialized-p cursor) nil)))))) + +(defmethod cursor-pnext ((cursor secondary-cursor)) + "Advances the cursor. Returns has-tuple / secondary key / +value / primary key." + (declare (optimize (speed 3))) + (if (cursor-initialized-p cursor) + (with-buffer-streams (key-buf pkey-buf value-buf) + (multiple-value-bind (key pkey val) + (db-cursor-pmove-buffered (cursor-handle cursor) + key-buf pkey-buf value-buf :next t) + (if (and key (= (buffer-read-int key) (cursor-oid cursor))) + (values t (deserialize key) (deserialize val) + (progn (buffer-read-int pkey) (deserialize pkey))) + (setf (cursor-initialized-p cursor) nil)))) + (cursor-pfirst cursor))) + +(defmethod cursor-pprev ((cursor secondary-cursor)) + "Moves the cursor back. Returns has-tuple / secondary key +/ value / primary key." + (declare (optimize (speed 3))) + (if (cursor-initialized-p cursor) + (with-buffer-streams (key-buf pkey-buf value-buf) + (multiple-value-bind (key pkey val) + (db-cursor-pmove-buffered (cursor-handle cursor) + key-buf pkey-buf value-buf :prev t) + (if (and key (= (buffer-read-int key) (cursor-oid cursor))) + (values t (deserialize key) (deserialize val) + (progn (buffer-read-int pkey) (deserialize pkey))) + (setf (cursor-initialized-p cursor) nil)))) + (cursor-plast cursor))) + +(defmethod cursor-pset ((cursor secondary-cursor) key) + "Moves the cursor to a particular key. Returns has-tuple +/ secondary key / value / primary key." + (declare (optimize (speed 3))) + (with-buffer-streams (key-buf pkey-buf value-buf) + (buffer-write-int (cursor-oid cursor) key-buf) + (serialize key key-buf) + (multiple-value-bind (k pkey val) + (db-cursor-pset-buffered (cursor-handle cursor) + key-buf pkey-buf value-buf :set t) + (if k + (progn (setf (cursor-initialized-p cursor) t) + (values t key (deserialize val) + (progn (buffer-read-int pkey) (deserialize pkey)))) + (setf (cursor-initialized-p cursor) nil))))) + +(defmethod cursor-pset-range ((cursor secondary-cursor) key) + "Move the cursor to the first key-value pair with key +greater or equal to the key argument, according to the lisp +sorter. Returns has-pair secondary key value primary key." + (declare (optimize (speed 3))) + (with-buffer-streams (key-buf pkey-buf value-buf) + (buffer-write-int (cursor-oid cursor) key-buf) + (serialize key key-buf) + (multiple-value-bind (k pkey val) + (db-cursor-pset-buffered (cursor-handle cursor) + key-buf pkey-buf value-buf :set-range t) + (if (and k (= (buffer-read-int k) (cursor-oid cursor))) + (progn (setf (cursor-initialized-p cursor) t) + (values t (deserialize k) (deserialize val) + (progn (buffer-read-int pkey) (deserialize pkey)))) + (setf (cursor-initialized-p cursor) nil))))) + +(defmethod cursor-pget-both ((cursor secondary-cursor) key pkey) + "Moves the cursor to a particular secondary key / primary +key pair. Returns has-tuple / secondary key / value / +primary key." + (declare (optimize (speed 3))) + (with-buffer-streams (key-buf pkey-buf value-buf) + (let ((primary-oid (oid (primary (cursor-btree cursor))))) + (buffer-write-int (cursor-oid cursor) key-buf) + (serialize key key-buf) + (buffer-write-int primary-oid pkey-buf) + (serialize pkey pkey-buf) + (multiple-value-bind (k p val) + (db-cursor-pget-both-buffered (cursor-handle cursor) + key-buf pkey-buf value-buf :get-both t) + (declare (ignore p)) + (if k + (progn (setf (cursor-initialized-p cursor) t) + (values t key (deserialize val) pkey)) + (setf (cursor-initialized-p cursor) nil)))))) + +(defmethod cursor-pget-both-range ((cursor secondary-cursor) key pkey) + "Moves the cursor to a the first secondary key / primary +key pair, with secondary key equal to the key argument, and +primary key greater or equal to the pkey argument. Returns +has-tuple / secondary key / value / primary key." + (declare (optimize (speed 3))) + (with-buffer-streams (key-buf pkey-buf value-buf) + (let ((primary-oid (oid (primary (cursor-btree cursor))))) + (buffer-write-int (cursor-oid cursor) key-buf) + (serialize key key-buf) + (buffer-write-int primary-oid pkey-buf) + (serialize pkey pkey-buf) + (multiple-value-bind (k p val) + (db-cursor-pget-both-buffered (cursor-handle cursor) key-buf + pkey-buf value-buf :get-both-range t) + (if k + (progn (setf (cursor-initialized-p cursor) t) + (values t key (deserialize val) + (progn (buffer-read-int p) (deserialize p)))) + (setf (cursor-initialized-p cursor) nil)))))) + +(defmethod cursor-delete ((cursor secondary-cursor)) + "Delete by cursor: deletes ALL secondary indices." + (declare (optimize (speed 3))) + (if (cursor-initialized-p cursor) + (with-buffer-streams (key-buf pkey-buf value-buf) + (multiple-value-bind (key pkey val) + (db-cursor-pmove-buffered (cursor-handle cursor) key-buf pkey-buf + value-buf :current t) + (declare (ignore val)) + (when (and key (= (buffer-read-int key) (cursor-oid cursor)) + (= (buffer-read-int pkey) (oid (primary + (cursor-btree cursor))))) + (remove-kv (deserialize pkey) (primary (cursor-btree cursor)))) + (setf (cursor-initialized-p cursor) nil))) + (error "Can't delete with uninitialized cursor!"))) + +(defmethod cursor-get-both ((cursor secondary-cursor) key value) + "cursor-get-both not implemented for secondary indices. +Use cursor-pget-both." + (declare (ignore cursor key value)) + (error "cursor-get-both not implemented on secondary +indices. Use cursor-pget-both.")) + +(defmethod cursor-get-both-range ((cursor secondary-cursor) key value) + "cursor-get-both-range not implemented for secondary indices. +Use cursor-pget-both-range." + (declare (ignore cursor key value)) + (error "cursor-get-both-range not implemented on secondary indices. Use cursor-pget-both-range.")) + +(defmethod cursor-put ((cursor secondary-cursor) value &rest rest) + "Puts are forbidden on secondary indices. Try adding to +the primary." + (declare (ignore rest value cursor)) + (error "Puts are forbidden on secondary indices. Try adding to the primary.")) + +(defmethod cursor-next-dup ((cursor secondary-cursor)) + "Move to the next duplicate element (with the same key.) +Returns has-pair key value." + (declare (optimize (speed 3))) + (when (cursor-initialized-p cursor) + (with-buffer-streams (key-buf value-buf) + (multiple-value-bind (key val) + (db-cursor-move-buffered (cursor-handle cursor) + key-buf value-buf :next-dup t) + (if (and key (= (buffer-read-int key) (cursor-oid cursor))) + (values t (deserialize key) (deserialize val)) + (setf (cursor-initialized-p cursor) nil)))))) + +(defmethod cursor-next-nodup ((cursor secondary-cursor)) + "Move to the next non-duplicate element (with different +key.) Returns has-pair key value." + (declare (optimize (speed 3))) + (if (cursor-initialized-p cursor) + (with-buffer-streams (key-buf value-buf) + (multiple-value-bind (key val) + (db-cursor-move-buffered (cursor-handle cursor) + key-buf value-buf :next-nodup t) + (if (and key (= (buffer-read-int key) (cursor-oid cursor))) + (values t (deserialize key) (deserialize val)) + (setf (cursor-initialized-p cursor) nil)))) + (cursor-first cursor))) + +(defmethod cursor-prev-nodup ((cursor secondary-cursor)) + "Move to the previous non-duplicate element (with +different key.) Returns has-pair key value." + (declare (optimize (speed 3))) + (if (cursor-initialized-p cursor) + (with-buffer-streams (key-buf value-buf) + (multiple-value-bind (key val) + (db-cursor-move-buffered (cursor-handle cursor) + key-buf value-buf :prev-nodup t) + (if (and key (= (buffer-read-int key) (cursor-oid cursor))) + (values t (deserialize key) (deserialize val)) + (setf (cursor-initialized-p cursor) nil)))) + (cursor-last cursor))) + +(defmethod cursor-pnext-dup ((cursor secondary-cursor)) + "Move to the next duplicate element (with the same key.) +Returns has-tuple / secondary key / value / primary key." + (declare (optimize (speed 3))) + (when (cursor-initialized-p cursor) + (with-buffer-streams (key-buf pkey-buf value-buf) + (multiple-value-bind (key pkey val) + (db-cursor-pmove-buffered (cursor-handle cursor) + key-buf pkey-buf value-buf :next-dup t) + (if (and key (= (buffer-read-int key) (cursor-oid cursor))) + (values t (deserialize key) (deserialize val) + (progn (buffer-read-int pkey) (deserialize pkey))) + (setf (cursor-initialized-p cursor) nil)))))) + +(defmethod cursor-pnext-nodup ((cursor secondary-cursor)) + "Move to the next non-duplicate element (with different +key.) Returns has-tuple / secondary key / value / primary +key." + (declare (optimize (speed 3))) + (if (cursor-initialized-p cursor) + (with-buffer-streams (key-buf pkey-buf value-buf) + (multiple-value-bind (key pkey val) + (db-cursor-pmove-buffered (cursor-handle cursor) key-buf + pkey-buf value-buf :next-nodup t) + (if (and key (= (buffer-read-int key) (cursor-oid cursor))) + (values t (deserialize key) (deserialize val) + (progn (buffer-read-int pkey) (deserialize pkey))) + (setf (cursor-initialized-p cursor) nil)))) + (cursor-pfirst cursor))) + +(defmethod cursor-pprev-nodup ((cursor secondary-cursor)) + "Move to the previous non-duplicate element (with +different key.) Returns has-tuple / secondary key / value / +primary key." + (declare (optimize (speed 3))) + (if (cursor-initialized-p cursor) + (with-buffer-streams (key-buf pkey-buf value-buf) + (multiple-value-bind (key pkey val) + (db-cursor-pmove-buffered (cursor-handle cursor) key-buf + pkey-buf value-buf :prev-nodup t) + (if (and key (= (buffer-read-int key) (cursor-oid cursor))) + (values t (deserialize key) (deserialize val) + (progn (buffer-read-int pkey) (deserialize pkey))) + (setf (cursor-initialized-p cursor) nil)))) + (cursor-plast cursor))) +