Skip to content
Browse files

Fixed bugs and added some functionality. Cursor/iterator stuff is sti…

…ll shaky, more fixin' to do.
  • Loading branch information...
1 parent 054a391 commit 77c5368d69dbf656abc82efc296950441f4fc723 @isterin committed with kraison
Showing with 122 additions and 33 deletions.
  1. +10 −0 cl-kyoto-cabinet-package.lisp
  2. +63 −3 kyoto-cabinet-dbm.lisp
  3. +7 −11 kyoto-cabinet-ffi.lisp
  4. +42 −19 kyoto-cabinet.lisp
10 cl-kyoto-cabinet-package.lisp
@@ -13,6 +13,16 @@
+ :kcdbremove
+ :kcdbcursor
+ :kccurdel
+ :kccurjump
+ :kccurstep
+ :kccurget
+ :kccurkey
+ :kccurvalue
+ :kccurdb
66 kyoto-cabinet-dbm.lisp
@@ -1,10 +1,14 @@
(in-package #:kyoto-cabinet)
(defmethod initialize-instance :after ((db kc-dbm) &key)
- (with-slots (ptr)
- db
+ (with-slots (ptr) db
(setf ptr (kcdbnew))))
+(defmethod initialize-instance :after ((iter kc-iterator) &key)
+ (with-slots (ptr) iter
+ (setf ptr iter)))
(defmethod raise-error ((db kc-dbm) &optional (message "")
&rest message-arguments)
(let* ((code (kcdbecode (ptr-of db)))
@@ -99,4 +103,60 @@
(let ((fn #'kcdbget))
(ecase type
(:string (get-octets->string db key fn))
- (:octets (get-octets->octets db key fn)))))
+ (:octets (get-octets->octets db key fn)))))
+;; Define overloaded remove methods
+(defmethod dbm-remove ((db kc-dbm) (key string))
+ (rem-string->value db key))
+(defmethod dbm-remove ((db kc-dbm) (key integer))
+ (rem-int32->value db key))
+(defmethod dbm-remove ((db kc-dbm) (key vector))
+ (rem-octets->value db key))
+;; Define iterator methods below
+(defmethod iter-open ((db kc-dbm))
+ (let ((iterator (make-instance 'kc-iterator)))
+ (with-slots ((iter-ptr ptr)) iterator
+ (with-slots ((db-ptr ptr)) db
+ (setf iter-ptr (kcdbcursor db-ptr))))
+ iterator))
+(defmethod iter-item ((iter kc-iterator))
+ (let ((key-size (foreign-alloc :pointer))
+ (value-size (foreign-alloc :pointer))
+ (value-ptr (foreign-alloc :pointer)))
+ (with-string-value (key-ptr (kccurget (ptr-of iter) key-size value-ptr value-size NIL))
+ (foreign-free key-size)
+ (foreign-free value-size)
+ (format t "KEY: ~a~%" key-ptr)
+ (format t "VALUE: ~a~%" (foreign-string-to-lisp value-ptr))
+ (let ((key (foreign-string-to-lisp key-ptr)) (value (foreign-string-to-lisp value-ptr)))
+ (foreign-free key-ptr)
+ (foreign-free value-ptr)
+ (if (null-pointer-p key-ptr)
+ (maybe-raise-error (kccurdb (ptr-of iter)))
+ (list key value))))))
+(defmethod iter-first ((iter kc-iterator))
+ (kccurjump (ptr-of iter)))
+(defmethod iter-next ((iter kc-iterator))
+ (kccurstep (ptr-of iter)))
+;; (defmethod iter-key ((iter kc-iterator))
+;;(defmethod iter-iterate ((iter kc-iterator) (fn function))
+;; (iter-first iter)
+;; (loop while (iter-next iter) do
+;; (funcall fn
18 kyoto-cabinet-ffi.lisp
@@ -137,7 +137,6 @@
(code :pointer))
(cffi:defcfun ("kcdbnew" kcdbnew) :pointer)
(cffi:defcfun ("kcdbopen" kcdbopen) :boolean
@@ -199,7 +198,7 @@
(db :pointer)
(fullproc :pointer)
(opq :pointer)
- (writable :pointer))
+ (writable :boolean))
(cffi:defcfun ("kcdbincrint" kcdbincrint) :pointer
@@ -223,12 +222,10 @@
(ovbuf :string)
(ovsiz :pointer))
-(cffi:defcfun ("kcdbremove" kcdbremove) :pointer
+(cffi:defcfun ("kcdbremove" kcdbremove) :boolean
(db :pointer)
(kbuf :string)
- (ksiz :pointer))
+ (ksiz :uint32))
(cffi:defcfun ("kcdbgetbuf" kcdbgetbuf) :pointer
(db :pointer)
@@ -319,9 +316,9 @@
(ksp :pointer)
(vbp :pointer)
(vsp :pointer)
- (step :pointer))
+ (step :boolean))
-(cffi:defcfun ("kccurjump" kccurjump) :pointer
+(cffi:defcfun ("kccurjump" kccurjump) :boolean
(cur :pointer))
(cffi:defcfun ("kccurjumpkey" kccurjumpkey) :pointer
@@ -329,7 +326,7 @@
(kbuf :string)
(ksiz :pointer))
-(cffi:defcfun ("kccurstep" kccurstep) :pointer
+(cffi:defcfun ("kccurstep" kccurstep) :boolean
(cur :pointer))
(cffi:defcfun ("kccurdb" kccurdb) :pointer
@@ -340,5 +337,4 @@
(cffi:defcfun ("kccuremsg" kccuremsg) :string
(cur :pointer))
61 kyoto-cabinet.lisp
@@ -155,16 +155,34 @@ treated. :STRING indicates that the value should be converted to a
Lisp string, while :OCTETS indicates that the byte vector should be
-(defgeneric dbm-rem (db key &key remove-dups)
+(defgeneric dbm-rem (db key)
(:documentation "Removes the value under KEY in DB. If REMOVE-DUPS
is T, duplicate values will be removed from a B+ tree database."))
+;;; Iterator based methods below
+(defgeneric iter-item (db)
+ (:documentation "Returns the current item in the iterator. ** DOES NOT advance the cursor **"))
+(defgeneric iter-iterate (db fn)
+ (:documentation "Iterates through all records and calls function fn for each record.
+- db (object): A KC dbm object.
+- fn (function): A callback function
+- Boolean representing true for success or false for failure."))
(defgeneric iter-open (db)
(:documentation "Opens an iterator on DB.
-- db (object): A TC dbm object.
+- db (object): A KC dbm object.
- A TC iterator object."))
@@ -526,32 +544,37 @@ integer and the value is an octet vector."
(or (funcall fn (ptr-of db) key-ptr key-len value-ptr value-len)
(maybe-raise-error db "(key ~a) (value ~a)" key value)))))
-(defun rem-string->value (db key fn)
- "Removes value from DB under KEY using FN where the key is a
- (declare (optimize (speed 3)))
- (declare (type function fn))
- (or (funcall fn (ptr-of db) key)
- (maybe-raise-error db "(key ~a)" key)))
-(defun rem-string->duplicates (db key fn)
- "Removes all values from DB under KEY using FN where the key is a
+(defun rem-string->value (db key)
+ "Removes value from DB under KEY where the key is a
(declare (optimize (speed 3)))
(declare (type function fn))
- (with-foreign-string ((key-ptr key-len) key :null-terminated-p nil)
- (or (funcall fn (ptr-of db) key key-len)
- (maybe-raise-error db "(key ~a)" key))))
+ (with-foreign-string ((key-ptr key-len) key)
+ (or (kcdbremove (ptr-of db) key key-len)
+ (maybe-raise-error db "(key ~a)" key))))
-(defun rem-int32->value (db key fn)
- "Removes value from DB under KEY using FN where the key is a 32-bit
+(defun rem-int32->value (db key)
+ "Removes value from DB under KEY where the key is a 32-bit
(declare (optimize (speed 3)))
(declare (type function fn))
(with-foreign-object (key-ptr :int32)
(setf (mem-ref key-ptr :int32) key)
- (or (funcall fn (ptr-of db) key-ptr (foreign-type-size :int32))
- (maybe-raise-error db "(key ~a)" key))))
+ (or (kcdbremove (ptr-of db) key-ptr (foreign-type-size :int32))
+ (maybe-raise-error db "(key ~a)" key))))
+(defun rem-octets->value (db key)
+ "Removes value from DB under KEY where the key is a octet vector"
+ (declare (optimize (speed 3)))
+ (declare (type function fn))
+ (let ((key-len (length key)))
+ (with-foreign-object (key-ptr :unsigned-char key-len)
+ (loop
+ for i from 0 below key-len
+ do (setf (mem-aref key-ptr :unsigned-char i) (aref key i)))
+ (or (kcdbremove (ptr-of db) key-ptr key-len)
+ (maybe-raise-error db "(key ~a)" key)))))
(declaim (inline copy-foreign-value))
(defun copy-foreign-value (value-ptr size-ptr)

0 comments on commit 77c5368

Please sign in to comment.
Something went wrong with that request. Please try again.