Permalink
Browse files

Make more or less complete interface and add simple readme.

  • Loading branch information...
1 parent b9581cc commit c6a4ac5303b17611f4b7bc44b051fe8a6ac74d22 @Ramarren committed Nov 30, 2009
Showing with 77 additions and 1 deletion.
  1. +7 −0 README.markdown
  2. +60 −0 interface.lisp
  3. +10 −1 package.lisp
View
@@ -0,0 +1,7 @@
+# cffi-gdbm
+
+This are bindings for `GNU dbm`. It should be obvious what expored symbols do.
+
+## Note
+
+GDBM extensively uses structures as arguments and return values passed by value. This bindings will not work if those are implemented differently than for my system.
View
@@ -19,3 +19,63 @@
(unwind-protect
(progn ,@body)
(db-close *gdbm*))))
+
+(defun store (key content &optional (flag :insert) (gdbm *gdbm*))
+ (let ((retval (datum-store key content flag gdbm)))
+ (ecase retval
+ (-1 (error "Not writer or invalid data, error: ~a" gdbm-errno))
+ (+1 (error "Key ~a already exists, error: ~a" key gdbm-errno))
+ (0 t))))
+
+(defun exists (key &optional (gdbm *gdbm*))
+ (not (zerop (datum-exists key gdbm))))
+
+(defun decode-datum (dptr dsize as)
+ (unless (null-pointer-p dptr)
+ (prog1
+ (case as
+ (:string
+ (nth-value 0 (foreign-string-to-lisp dptr :count dsize)))
+ (t
+ (assert (zerop (mod dsize (foreign-type-size as))))
+ (coerce (loop for i below (/ dsize (foreign-type-size as))
+ collect (mem-aref dptr as i))
+ `(vector ,(case as
+ (:uint8 '(unsigned-byte 8))
+ (:uint32 '(unsigned-byte 32))
+ (t t))))))
+ (foreign-free dptr))))
+
+(defun fetch (key &optional (as :string) (gdbm *gdbm*))
+ (multiple-value-call #'decode-datum (datum-fetch key gdbm) as))
+
+(defun db-delete (key &optional (gdbm *gdbm*))
+ (let ((retval (datum-delete key gdbm)))
+ (ecase retval
+ (-1 (error "Key ~a does not exist or not a writer, error ~a" key gdbm-errno))
+ (0 t))))
+
+(defun make-key-iterator (&optional (as :string) (gdbm *gdbm*))
+ (let ((key nil)
+ (done nil))
+ #'(lambda ()
+ (if (and key (not done))
+ (setf key (multiple-value-call #'decode-datum
+ (datum-nextkey key gdbm) as))
+ (setf key (multiple-value-call #'decode-datum
+ (datum-firstkey gdbm) as)))
+ (unless key
+ (setf done t))
+ key)))
+
+(defun sync (&optional (gdbm *gdbm*))
+ (%gdbm-sync gdbm)
+ t)
+
+(defun reorganize (&optional (gdbm *gdbm*))
+ (let ((retval (%gdbm-reorganize gdbm)))
+ (cond ((zerop retval) t)
+ ((minusp retval) (error "Reorganization error: ~a" gdbm-errno)))))
+
+(defun get-error-string ()
+ (%gdbm-strerror gdbm-errno-raw))
View
@@ -4,4 +4,13 @@
(:export #:*gdbm*
#:db-open
#:db-close
- #:with-gdbm))
+ #:with-gdbm
+ #:store
+ #:store
+ #:exists
+ #:fetch
+ #:db-delete
+ #:make-key-iterator
+ #:sync
+ #:reorganize
+ #:get-error-string))

0 comments on commit c6a4ac5

Please sign in to comment.