Permalink
Browse files

Work on implementing dbm interfaces

  • Loading branch information...
1 parent 91d7ed4 commit fafb56024372ed796f402521d0563727f489d84f @isterin committed with kraison Aug 4, 2010
Showing with 540 additions and 61 deletions.
  1. +1 −0 .gitignore
  2. +22 −1 cl-kyoto-cabinet-package.lisp
  3. +2 −0 cl-kyoto-cabinet.asd
  4. +63 −0 kyoto-cabinet-dbm.lisp
  5. +54 −45 kyoto-cabinet-ffi.lisp
  6. +398 −15 kyoto-cabinet.lisp
View
@@ -0,0 +1 @@
+*.fasl
@@ -1,6 +1,27 @@
(defpackage :kyoto-cabinet-ffi
(:use #:common-lisp #:cffi)
- (:export)
+ (:export :kcdbnew
+ :kcdbopen
+ :kcdbecode
+ :kcdbemsg
+ :kcdbdel
+ :kcdbclose
+ :kcdbclear
+ :kcdbbegintran
+ :kcdbendtran
+ :kcdbset
+ :kcdbadd
+ :kcdbget
+
+ :KCOREADER
+ :KCOWRITER
+ :KCOCREATE
+ :KCOTRUNCATE
+ :KCOAUTOTRAN
+ :KCOAUTOSYNC
+ :KCONOLOCK
+ :KCOTRYLOCK
+ :KCONOREPAIR)
(:documentation "CFFI interface to Kyoto Cabinet functions. The
original C function names are preserved."))
View
@@ -50,5 +50,7 @@
:depends-on ("cl-kyoto-cabinet-package"))
(:file "kyoto-cabinet"
:depends-on ("cl-kyoto-cabinet-package" "kyoto-cabinet-ffi"))
+ (:file "kyoto-cabinet-dbm"
+ :depends-on ("cl-kyoto-cabinet-package" "kyoto-cabinet" "kyoto-cabinet-ffi"))
))
View
@@ -0,0 +1,63 @@
+(in-package :kyoto-cabinet)
+
+(defmethod initialize-instance :after ((db kc-dbm) &key)
+ (with-slots (ptr)
+ db
+ (setf ptr (kcdbnew))))
+
+(defmethod raise-error ((db kc-dbm) &optional (message "")
+ &rest message-arguments)
+ (let* ((code (kcdbecode (ptr-of db)))
+ (msg (kcdbemsg code)))
+ (error 'dbm-error :error-code code :error-msg msg
+ :text (apply #'format nil message message-arguments))))
+
+
+;(defmethod maybe-raise-error ((db kc-dbm) &optional message
+; &rest message-arguments)
+; (let ((ecode (kcdbecode (ptr-of db))))
+; (cond ((= +tcesuccess+ ecode)
+; t)
+; ((= +kcenorec+ ecode)
+; nil)
+; (t
+; (apply #'raise-error db message message-arguments)))))
+
+(defmethod dbm-open ((db kc-dbm) filename &rest mode)
+ (let ((db-ptr (ptr-of db)))
+ (check-open-mode mode)
+ (unless (kcdbopen db-ptr filename mode) ; opens db by side-effect
+ (let* ((code (kcdbecode db-ptr))
+ (msg (kcdbemsg code)))
+ (kcdbdel db-ptr) ; clean up on error
+ (error 'dbm-error :error-code code :error-msg msg))))
+ db)
+
+
+(defmethod dbm-close ((db kc-dbm))
+ (kcdbclose (ptr-of db)))
+
+(defmethod dbm-delete ((db kc-dbm))
+ (kcdbdel (ptr-of db)))
+
+(defmethod dbm-clear ((db kc-dbm))
+ (kcdbclear (ptr-of db)))
+
+(defmethod dbm-begin ((db kc-dbm) &rest hard)
+ (kcdbbegintran (ptr-of db) hard))
+
+(defmethod dbm-commit ((db kc-dbm))
+ (kcdbendtran (ptr-of db) T))
+
+(defmethod dbm-rollback ((db kc-dbm) commit)
+ (kcdbendtran (ptr-of db) NIL))
+
+(defmethod dbm-put ((db kc-dbm) key value &key mode overwrite-if-exists)
+ (let ((func (if overwrite-if-exists
+ #'kcdbset
+ #'kcdbadd)))
+ (funcall func (ptr-of db) key (length key) value (length value))))
+
+
+(defmethod dbm-get ((db kc-dbm) (key string) &optional (type :string))
+ (get-string->string db key #'kcdbget))
View
@@ -62,29 +62,31 @@
(cffi:defcunion KCDB
(db :pointer))
-(defanonenum
- KCESUCCESS
- KCENOIMPL
- KCEINVALID
- KCENOFILE
- KCENOPERM
- KCEBROKEN
- KCEDUPREC
- KCENOREC
- KCELOGIC
- KCESYSTEM
- (KCEMISC #.15))
-
-(defanonenum
- (KCOREADER #.(cl:ash 1 0))
- (KCOWRITER #.(cl:ash 1 1))
- (KCOCREATE #.(cl:ash 1 2))
- (KCOTRUNCATE #.(cl:ash 1 3))
- (KCOAUTOTRAN #.(cl:ash 1 4))
- (KCOAUTOSYNC #.(cl:ash 1 5))
- (KCONOLOCK #.(cl:ash 1 6))
- (KCOTRYLOCK #.(cl:ash 1 7))
- (KCONOREPAIR #.(cl:ash 1 8)))
+(defbitfield dbm-open-flags
+ :success
+ :noimpl
+ :invalid
+ :nofile
+ :noperm
+ :broken
+ :duprec
+ :norec
+ :logic
+ :system)
+
+(defanonenum
+ (kcemisc #.15))
+
+(defbitfield dbm-open-flags
+ :read
+ :write
+ :create
+ :truncate
+ :autotran
+ :autosync
+ :nolock
+ :trylock
+ :norepair)
(cffi:defcvar ("KCVERSION" KCVERSION)
:string)
@@ -136,15 +138,38 @@
(cffi:defcfun ("kcecodename" kcecodename) :string
(code :pointer))
+
+
(cffi:defcfun ("kcdbnew" kcdbnew) :pointer)
+(cffi:defcfun ("kcdbopen" kcdbopen) :boolean
+ (db :pointer)
+ (path :string)
+ (mode dbm-open-flags))
+
(cffi:defcfun ("kcdbdel" kcdbdel) :void
(db :pointer))
-(cffi:defcfun ("kcdbopen" kcdbopen) :pointer
+(cffi:defcfun ("kcdbset" kcdbset) :boolean
(db :pointer)
- (path :string)
- (mode :pointer))
+ (kbuf :string)
+ (ksiz :uint32)
+ (vbuf :string)
+ (vsiz :uint32))
+
+(cffi:defcfun ("kcdbadd" kcdbadd) :boolean
+ (db :pointer)
+ (kbuf :string)
+ (ksiz :uint32)
+ (vbuf :string)
+ (vsiz :uint32))
+
+(cffi:defcfun ("kcdbget" kcdbget) :pointer
+ (db :pointer)
+ (kbuf :string)
+ (ksiz :uint32)
+ (sp :pointer))
+
(cffi:defcfun ("kcdbclose" kcdbclose) :pointer
(db :pointer))
@@ -170,19 +195,7 @@
(opq :pointer)
(writable :pointer))
-(cffi:defcfun ("kcdbset" kcdbset) :pointer
- (db :pointer)
- (kbuf :string)
- (ksiz :pointer)
- (vbuf :string)
- (vsiz :pointer))
-(cffi:defcfun ("kcdbadd" kcdbadd) :pointer
- (db :pointer)
- (kbuf :string)
- (ksiz :pointer)
- (vbuf :string)
- (vsiz :pointer))
(cffi:defcfun ("kcdbappend" kcdbappend) :pointer
(db :pointer)
@@ -217,11 +230,7 @@
(kbuf :string)
(ksiz :pointer))
-(cffi:defcfun ("kcdbget" kcdbget) :string
- (db :pointer)
- (kbuf :string)
- (ksiz :pointer)
- (sp :pointer))
+
(cffi:defcfun ("kcdbgetbuf" kcdbgetbuf) :pointer
(db :pointer)
@@ -245,11 +254,11 @@
(cffi:defcfun ("kcdbbegintran" kcdbbegintran) :pointer
(db :pointer)
- (hard :pointer))
+ (hard :boolean))
(cffi:defcfun ("kcdbbegintrantry" kcdbbegintrantry) :pointer
(db :pointer)
- (hard :pointer))
+ (hard :boolean))
(cffi:defcfun ("kcdbendtran" kcdbendtran) :pointer
(db :pointer)
Oops, something went wrong.

0 comments on commit fafb560

Please sign in to comment.