changelog shortlog graph tags branches changeset files revisions annotate raw help

Mercurial > demo / src/db.lisp

changeset 22: ba323d8c0f93
parent: db.lisp@4230ce61dcfa
author: ellis <ellis@rwest.io>
date: Sat, 03 Jun 2023 22:48:46 -0400
permissions: -rw-r--r--
description: refactor1 
     1 (in-package :demo)
     2 
     3 (define-foreign-library rocksdb
     4   (:win32 "rocksdb")
     5   (t (:default "librocksdb")))
     6 
     7 (use-foreign-library rocksdb)
     8 
     9 (defcfun ("rocksdb_options_create" create-options) :pointer)
    10 (defcfun ("rocksdb_options_destroy" destroy-options) :void (options :pointer))
    11 (defcfun ("rocksdb_options_increase_parallelism" increase-parallelism) :void (opt :pointer) (total-threads :int))
    12 (defcfun ("rocksdb_options_optimize_level_style_compaction" optimize-level-style-compaction) :void (opt :pointer) (memtable_memory_budget :uint64))
    13 (defcfun ("rocksdb_options_set_create_if_missing" set-create-if-missing) :void (opt :pointer) (val :boolean))
    14 
    15 (defcfun ("rocksdb_writeoptions_create" create-writeoptions) :pointer)
    16 (defcfun ("rocksdb_writeoptions_destroy" destroy-writeoptions) :void (opt :pointer))
    17 (defcfun ("rocksdb_readoptions_create" create-readoptions) :pointer)
    18 (defcfun ("rocksdb_readoptions_destroy" destroy-readoptions) :void (opt :pointer))
    19 
    20 (defcfun ("rocksdb_open" open-db*) :pointer (opt :pointer) (name :string) (errptr :pointer))
    21 (defcfun ("rocksdb_close" close-db) :void (opt :pointer))
    22 (defcfun ("rocksdb_cancel_all_background_work" cancel-all-background-work) :void (db :pointer) (wait :boolean))
    23 
    24 (defcfun ("rocksdb_put" put*) :void (db :pointer) (options :pointer) (key :pointer) (keylen :unsigned-int) (val :pointer) (vallen :unsigned-int) (errptr :pointer))
    25 (defcfun ("rocksdb_get" get*) :pointer (db :pointer) (options :pointer) (key :pointer) (keylen :unsigned-int) (vallen :pointer) (errptr :pointer))
    26 
    27 (defcfun ("rocksdb_create_iterator" create-iter*) :pointer (db :pointer) (opt :pointer))
    28 (defcfun ("rocksdb_iter_destroy" destroy-iter) :void (iter :pointer))
    29 (defcfun ("rocksdb_iter_seek_to_first" move-iter-to-first) :void (iter :pointer))
    30 (defcfun ("rocksdb_iter_valid" valid-iter-p) :boolean (iter :pointer))
    31 (defcfun ("rocksdb_iter_next" move-iter-forward) :void (iter :pointer))
    32 (defcfun ("rocksdb_iter_prev" move-iter-backward) :void (iter :pointer))
    33 (defcfun ("rocksdb_iter_key" iter-key*) :pointer (iter :pointer) (klen-ptr :pointer))
    34 (defcfun ("rocksdb_iter_value" iter-value*) :pointer (iter :pointer) (vlen-ptr :pointer))
    35 
    36 (define-condition unable-to-open-db (error)
    37   ((db-path :initarg :db-path
    38             :reader db-path)
    39    (error-message :initarg :error-message
    40                   :reader error-message)))
    41 
    42 (defmethod print-object ((obj unable-to-open-db) stream)
    43   (print-unreadable-object (obj stream :type t :identity t)
    44     (format stream "error-message=~A" (error-message obj))))
    45 
    46 (define-condition unable-to-put-key-value-to-db (error)
    47   ((db :initarg :db
    48        :reader db)
    49    (key :initarg :key
    50         :reader key)
    51    (val :initarg :val
    52         :reader val)
    53    (error-message :initarg :error-message
    54                   :reader error-message)))
    55 
    56 (define-condition unable-to-get-value-to-db (error)
    57   ((db :initarg :db
    58        :reader db)
    59    (key :initarg :key
    60         :reader key)
    61    (error-message :initarg :error-message
    62                   :reader error-message)))
    63 
    64 (defun open-db (db-path &optional opt)
    65   (unless opt
    66     (setq opt (create-options)))
    67   (let ((errptr (foreign-alloc :pointer)))
    68     (setf (mem-ref errptr :pointer) (null-pointer))
    69     (let* ((db-path (if (pathnamep db-path)
    70                         (namestring db-path)
    71                         db-path))
    72            (db (open-db* opt db-path errptr))
    73            (err (mem-ref errptr :pointer)))
    74       (unless (null-pointer-p err)
    75         (error 'unable-to-open-db
    76                :db-path db-path
    77                :error-message (foreign-string-to-lisp err)))
    78       db)))
    79 
    80 (defmacro clone-octets-to-foreign (lisp-array foreign-array)
    81   (let ((i (gensym)))
    82     `(loop for ,i from 0 below (length ,lisp-array)
    83            do (setf (mem-aref ,foreign-array :unsigned-char ,i)
    84                     (aref ,lisp-array ,i)))))
    85 
    86 (defmacro clone-octets-from-foreign (foreign-array lisp-array len)
    87   (let ((i (gensym)))
    88     `(loop for ,i from 0 below ,len
    89            do (setf (aref ,lisp-array ,i)
    90                     (mem-aref ,foreign-array :unsigned-char ,i)))))
    91 
    92 (defun put-kv (db key val &optional opt)
    93   (unless opt
    94     (setq opt (create-writeoptions)))
    95   (with-foreign-objects ((errptr :pointer)
    96                          (key* :unsigned-char (length key))
    97                          (val* :unsigned-char (length val)))
    98     (clone-octets-to-foreign key key*)
    99     (clone-octets-to-foreign val val*)
   100     (setf (mem-ref errptr :pointer) (null-pointer))
   101     (put* db
   102           opt
   103           key*
   104           (length key)
   105           val*
   106           (length val)
   107           errptr)
   108     (let ((err (mem-ref errptr :pointer)))
   109       (unless (null-pointer-p err)
   110         (error 'unable-to-put-key-value-to-db
   111                :db db
   112                :key key
   113                :val val
   114                :error-message (foreign-string-to-lisp err))))))
   115 
   116 (defun put-kv-str (db key val &optional opt)
   117   (let ((key-octets (babel:string-to-octets key))
   118         (val-octets (babel:string-to-octets val)))
   119     (put-kv db key-octets val-octets opt)))
   120 
   121 (defun get-kv (db key &optional opt)
   122   (unless opt
   123     (setq opt (create-readoptions)))
   124 
   125   (with-foreign-objects ((val-len-ptr :unsigned-int)
   126                          (errptr :pointer)
   127                          (key* :unsigned-char (length key)))
   128     (clone-octets-to-foreign key key*)
   129     (setf (mem-ref errptr :pointer) (null-pointer))
   130     (let ((val (get* db
   131                      opt
   132                      key*
   133                      (length key)
   134                      val-len-ptr
   135                      errptr)))
   136       (let ((err (mem-ref errptr :pointer)))
   137         (unless (null-pointer-p err)
   138           (error 'unable-to-get-value-to-db
   139                  :db db
   140                  :key key
   141                  :error-message (foreign-string-to-lisp err)))
   142         
   143         (unless (null-pointer-p val)
   144           (let* ((val-len (mem-ref val-len-ptr :unsigned-int))
   145                  (val* (make-array val-len
   146                                       :element-type '(unsigned-byte 8))))
   147             (clone-octets-from-foreign val val* val-len)
   148             val*))))))
   149 
   150 (defun get-kv-str (db key &optional opt)
   151   (let ((key-octets (babel:string-to-octets key)))
   152     (let ((#1=val-octets (get-kv db key-octets opt)))
   153       (when #1#
   154         (babel:octets-to-string #1#)))))
   155 
   156 (defun create-iter (db &optional opt)
   157   (unless opt
   158     (setq opt (create-readoptions)))
   159   (create-iter* db opt))
   160 
   161 (defun iter-key (iter)
   162   (with-foreign-objects ((klen-ptr :unsigned-int))
   163     (setf (mem-ref klen-ptr :unsigned-int) 0)
   164     (let* ((key-ptr (iter-key* iter klen-ptr))
   165            (klen (mem-ref klen-ptr :unsigned-int))
   166            (key (make-array klen :element-type '(unsigned-byte 8))))
   167       (clone-octets-from-foreign key-ptr key klen)
   168       key)))
   169 
   170 (defun iter-key-str (iter)
   171   (let ((#1=key-octets (iter-key iter)))
   172     (when #1#
   173       (babel:octets-to-string #1#))))
   174 
   175 (defun iter-value (iter)
   176   (with-foreign-objects ((len-ptr :unsigned-int))
   177     (setf (mem-ref len-ptr :unsigned-int) 0)
   178     (let* ((value-ptr (iter-value* iter len-ptr))
   179            (vlen (mem-ref len-ptr :unsigned-int))
   180            (value* (make-array vlen :element-type '(unsigned-byte 8))))
   181       (clone-octets-from-foreign value-ptr value* vlen)
   182       value*)))
   183 
   184 (defun iter-value-str (iter)
   185   (let ((#1=val-octets (iter-value iter)))
   186     (when #1#
   187       (babel:octets-to-string #1#))))
   188 
   189 (defmacro with-open-db ((db-var db-path &optional opt) &body body)
   190   `(let ((,db-var (open-db ,db-path ,opt)))
   191      (unwind-protect (progn ,@body)
   192        (close-db ,db-var))))
   193 
   194 (defmacro with-iter ((iter-var db &optional opt) &body body)
   195   `(let ((,iter-var (create-iter ,db ,opt)))
   196      (unwind-protect (progn ,@body)
   197        (destroy-iter ,iter-var))))