Commits

llibra  committed 5078448

Implemented LVDB.DB:PUT and LVDB.DB:GET.

- Added a line to .hgignore to ignore the test database.
- options.lisp was renamed opt.lisp.
- Added util.lisp.
- Added the new package LVDB.UTIL.
- Defined size_t in LVDB.FFI.
- Defined LEVELDB-PUT and LEVELDB-GET in LVDB.FFI.
- Added the new package LVDB.DB.FS for low-level database APIs.
- Implemented LVDB.DB.FS:PUT and LVDB.DB.FS:GET.
- Defined C functions for read/write option in LVDB.FFI.
- Added the new packages, LVDB.ROPT and LVDB.WOPT.
- Implemented read/write option APIs.
- More package nicknames.

  • Participants
  • Parent commits d946f79

Comments (0)

Files changed (8)

 .*~$
 ^test.lisp$
+^test1$
                         :serial t
                         :components ((:file "packages")
                                      (:file "ffi")
-                                     (:file "options")
+                                     (:file "util")
+                                     (:file "opt")
                                      (:file "db")))))
+(in-package :lvdb.db.fs)
+
+(defun put (db opt key-fs key-len val-fs val-len)
+  (with-error-pointer (err-ptr)
+    (leveldb-put db opt key-fs key-len val-fs val-len err-ptr)
+    (handle-error-pointer err-ptr)
+    (values)))
+
+(defun get (db opt key-fs key-len)
+  (with-foreign-object (val-len-ptr 'size_t)
+    (with-error-pointer (err-ptr)
+      (let ((val-ptr (leveldb-get db opt key-fs key-len val-len-ptr err-ptr)))
+        (handle-error-pointer err-ptr)
+        (with-malloced-pointer (val-ptr)
+          (let ((val-len (mem-aref val-len-ptr 'size_t)))
+            (foreign-string-to-lisp val-ptr :count val-len)))))))
+
 (in-package :lvdb.db)
 
 (defun open (opt name)
 
 (defun close (db)
   (leveldb-close db))
+
+(defun put (db opt key val)
+  (with-foreign-strings (((key-fs key-len) key :null-terminated-p nil)
+                         ((val-fs val-len) val :null-terminated-p nil))
+    (lvdb.db.fs:put db opt key-fs key-len val-fs val-len)))
+
+(defun get (db opt key)
+  (with-foreign-string ((key-fs key-len) key :null-terminated-p nil)
+    (lvdb.db.fs:get db opt key-fs key-len)))

File src/ffi.lisp

 
 (use-foreign-library libleveldb)
 
+(defctype size_t #+x86-64 :uint64 #-x86-64 :uint32)
+
 (defcfun "leveldb_options_create" :pointer)
 
 (defcfun "leveldb_options_destroy" :void
   (opt :pointer)
   (v :uchar))
 
+(defcfun "leveldb_writeoptions_create" :pointer)
+
+(defcfun "leveldb_writeoptions_destroy" :void
+  (opt :pointer))
+
+(defcfun "leveldb_writeoptions_set_sync" :void
+  (opt :pointer)
+  (v :uchar))
+
+(defcfun "leveldb_readoptions_create" :pointer)
+
+(defcfun "leveldb_readoptions_destroy" :void
+  (opt :pointer))
+
+(defcfun "leveldb_readoptions_set_verify_checksums" :void
+  (opt :pointer)
+  (v :uchar))
+
+(defcfun "leveldb_readoptions_set_fill_cache" :void
+  (opt :pointer)
+  (v :uchar))
+
 (defcfun "leveldb_open" :pointer
   (options :pointer)
   (name :pointer)
 (defcfun "leveldb_close" :void
   (db :pointer))
 
+(defcfun "leveldb_put" :void
+  (db :pointer)
+  (options :pointer)
+  (key :pointer)
+  (keylen size_t)
+  (val :pointer)
+  (vallen size_t)
+  (errptr :pointer))
+
+(defcfun "leveldb_get" :pointer
+  (db :pointer)
+  (options :pointer)
+  (key :pointer)
+  (keylen size_t)
+  (vallen :pointer)
+  (errptr :pointer))
+
 (defcfun "free" :void
   (ptr :pointer))

File src/opt.lisp

+(in-package :lvdb.opt)
+
+(defun set (opt
+            &key
+            (create-if-missing nil create-if-missing-p))
+  (when create-if-missing-p
+    (let ((v (convert-to-foreign create-if-missing :boolean)))
+      (leveldb-options-set-create-if-missing opt v))))
+
+(defun create (&rest args)
+  (let ((opt (leveldb-options-create)))
+    (apply #'set opt args)
+    opt))
+
+(defun destroy (opt)
+  (leveldb-options-destroy opt))
+
+(defmacro with-options ((var &rest args) &body body)
+  `(let ((,var (create ,@args)))
+     (unwind-protect (progn ,@body)
+       (destroy ,var))))
+
+(in-package :lvdb.wopt)
+
+(defun set (opt &key (sync nil sync-p))
+  (when sync-p
+    (let ((v (convert-to-foreign sync :boolean)))
+      (leveldb-writeoptions-set-sync opt v))))
+
+(defun create (&rest args)
+  (let ((opt (leveldb-writeoptions-create)))
+    (apply #'set opt args)
+    opt))
+
+(defun destroy (opt)
+  (leveldb-writeoptions-destroy opt))
+
+(defmacro with-write-options ((var &rest args) &body body)
+  `(let ((,var (create ,@args)))
+     (unwind-protect (progn ,@body)
+       (destroy ,var))))
+
+(in-package :lvdb.ropt)
+
+(defun set (opt
+            &key
+            (verify-checksums nil verify-checksums-p)
+            (fill-cache t fill-cache-p))
+  (when verify-checksums-p
+    (let ((v (convert-to-foreign verify-checksums :boolean)))
+      (leveldb-readoptions-set-verify-checksums opt v)))
+  (when fill-cache-p
+    (let ((v (convert-to-foreign fill-cache :boolean)))
+      (leveldb-readoptions-set-fill-cache opt v))))
+
+(defun create (&rest args)
+  (let ((opt (leveldb-readoptions-create)))
+    (apply #'set opt args)
+    opt))
+
+(defun destroy (opt)
+  (leveldb-readoptions-destroy opt))
+
+(defmacro with-read-options ((var &rest args) &body body)
+  `(let ((,var (create ,@args)))
+     (unwind-protect (progn ,@body)
+       (destroy ,var))))

File src/options.lisp

-(in-package :lvdb.opt)
-
-(defun set (opt
-            &key
-            (create-if-missing nil create-if-missing-p))
-  (when create-if-missing-p
-    (let ((v (convert-to-foreign create-if-missing :boolean)))
-      (leveldb-options-set-create-if-missing opt v))))
-
-(defun create (&rest args)
-  (let ((opt (leveldb-options-create)))
-    (apply #'set opt args)
-    opt))
-
-(defun destroy (opt)
-  (leveldb-options-destroy opt))
-
-(defmacro with-options ((var &rest args) &body body)
-  `(let ((,var (create ,@args)))
-     (unwind-protect (progn ,@body)
-       (destroy ,var))))

File src/packages.lisp

 (defpackage :leveldb.ffi
   (:nicknames :lvdb.ffi)
   (:use :cl :cffi)
-  (:export :free
+  (:export :size_t
+
+           :free
 
            :leveldb-options-create :leveldb-options-destroy
            :leveldb-options-set-create-if-missing
-           :leveldb-open :leveldb-close))
+
+           :leveldb-writeoptions-create :leveldb-writeoptions-destroy
+           :leveldb-writeoptions-set-sync
+
+           :leveldb-readoptions-create :leveldb-readoptions-destroy
+           :leveldb-readoptions-set-verify-checksums
+           :leveldb-readoptions-set-fill-cache
+
+           :leveldb-open :leveldb-close :leveldb-put :leveldb-get))
+
+(defpackage :leveldb.utilities
+  (:nicknames :leveldb.util :lvdb.util)
+  (:use :cl :cffi :lvdb.ffi)
+  (:export :with-error-pointer :with-malloced-pointer :handle-error-pointer))
 
 (defpackage :leveldb.options
-  (:nicknames :lvdb.opt)
+  (:nicknames :leveldb.opt :lvdb.opt)
   (:use :cl :cffi :lvdb.ffi)
   (:shadow :set)
   (:export :set :create :destroy :with-options))
 
+(defpackage :leveldb.write-options
+  (:nicknames :leveldb.writeopt :lvdb.writeopt :lvdb.wopt)
+  (:use :cl :cffi :lvdb.ffi)
+  (:shadow :set)
+  (:export :set :create :destroy :with-write-options))
+
+(defpackage :leveldb.read-options
+  (:nicknames :leveldb.readopt :lvdb.readopt :lvdb.ropt)
+  (:use :cl :cffi :lvdb.ffi)
+  (:shadow :set)
+  (:export :set :create :destroy :with-read-options))
+
 (defpackage :leveldb.database
-  (:nicknames :lvdb.db)
-  (:use :cl :cffi :lvdb.ffi)
-  (:shadow :open :close)
-  (:export :open :close))
+  (:nicknames :leveldb.db :lvdb.db)
+  (:use :cl :cffi :lvdb.ffi :lvdb.util)
+  (:shadow :close :get :open)
+  (:export :open :close :put :get))
+
+(defpackage :leveldb.database.foreign-string
+  (:nicknames :leveldb.db.fs :lvdb.db.fs)
+  (:use :cl :cffi :lvdb.ffi :lvdb.util)
+  (:shadow :get)
+  (:export :put :get))

File src/util.lisp

+(in-package :lvdb.util)
+
+(defmacro with-error-pointer ((var) &body body)
+  `(with-foreign-object (,var :pointer)
+     (setf (mem-aref ,var :pointer) (null-pointer))
+     ,@body))
+
+(defmacro with-malloced-pointer ((ptr) &body body)
+  `(unwind-protect (progn ,@body)
+     (free ,ptr)))
+
+(defun handle-error-pointer (err-ptr)
+  (let ((ptr (mem-aref err-ptr :pointer)))
+    (unless (null-pointer-p ptr)
+      (with-malloced-pointer (ptr)
+        (error (foreign-string-to-lisp ptr))))))