1.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2+++ b/lisp/lib/rdb/util.lisp Sun Dec 10 23:02:43 2023 -0500
1.3@@ -0,0 +1,185 @@
1.4+(in-package :rdb)
1.5+
1.6+(defmacro with-errptr (e &body body)
1.7+ `(with-alien ((,e rocksdb-errptr nil))
1.8+ ,@body
1.9+ (free-alien ,e)))
1.10+
1.11+(defun default-rocksdb-options ()
1.12+ (let ((opts (rocksdb-options-create)))
1.13+ (rocksdb-options-set-create-if-missing opts t)
1.14+ opts))
1.15+
1.16+(defun open-db-raw (db-path &optional (opts (default-rocksdb-options)))
1.17+ (with-errptr e
1.18+ (let* ((db-path (if (pathnamep db-path)
1.19+ (namestring db-path)
1.20+ db-path))
1.21+ (db (rocksdb-open opts db-path e))
1.22+ (err e))
1.23+ (unless (null-alien err)
1.24+ (error 'open-db-error
1.25+ :db-path db-path
1.26+ :error-message e))
1.27+ db)))
1.28+
1.29+(defun close-db-raw (db)
1.30+ (rocksdb-close db))
1.31+
1.32+(defun destroy-db-raw (path)
1.33+ (let ((opt (rocksdb-options-create)))
1.34+ (with-alien ((err rocksdb-errptr nil))
1.35+ (rocksdb-destroy-db opt path err))
1.36+ (rocksdb-options-destroy opt)))
1.37+
1.38+(defmacro with-open-db-raw ((db-var db-path &optional (opt (rocksdb-options-create))) &body body)
1.39+ `(let ((,db-var (open-db-raw ,db-path ,opt)))
1.40+ (unwind-protect (progn ,@body)
1.41+ (rocksdb-close ,db-var)
1.42+ (with-errptr e
1.43+ (rocksdb-destroy-db ,opt ,db-path e))
1.44+ (rocksdb-options-destroy ,opt))))
1.45+
1.46+(defun put-kv-raw (db key val &optional (opts (rocksdb-writeoptions-create)))
1.47+ (let ((klen (length key))
1.48+ (vlen (length val)))
1.49+ (with-alien ((k (* char) (make-alien char klen))
1.50+ (v (* char) (make-alien char vlen))
1.51+ (errptr rocksdb-errptr nil))
1.52+ (setfa k key)
1.53+ (setfa v val)
1.54+ (rocksdb-put db
1.55+ opts
1.56+ k
1.57+ klen
1.58+ v
1.59+ vlen
1.60+ errptr)
1.61+ (unless (null-alien errptr)
1.62+ (error 'put-kv-error
1.63+ :db db
1.64+ :key key
1.65+ :val val
1.66+ :error-message (alien-sap errptr))))))
1.67+
1.68+(defun put-kv-str-raw (db key val &optional opt)
1.69+ (let ((key-octets (string-to-octets key))
1.70+ (val-octets (string-to-octets val)))
1.71+ (put-kv-raw db key-octets val-octets opt)))
1.72+
1.73+(defun put-cf-raw (db cf key val &optional (opts (rocksdb-writeoptions-create)))
1.74+ (let ((klen (length key))
1.75+ (vlen (length val)))
1.76+ (with-alien ((k (* char) (make-alien char klen))
1.77+ (v (* char) (make-alien char vlen))
1.78+ (errptr rocksdb-errptr nil))
1.79+ (setfa k key)
1.80+ (setfa v val)
1.81+ (rocksdb-put-cf db
1.82+ opts
1.83+ cf
1.84+ k
1.85+ klen
1.86+ v
1.87+ vlen
1.88+ errptr)
1.89+ (unless (null-alien errptr)
1.90+ (error 'put-kv-error
1.91+ :db db
1.92+ :key key
1.93+ :val val
1.94+ :error-message (alien-sap errptr))))))
1.95+
1.96+(defun put-cf-str-raw (db cf key val &optional opt)
1.97+ (let ((key-octets (string-to-octets key))
1.98+ (val-octets (string-to-octets val)))
1.99+ (put-cf-raw db cf key-octets val-octets opt)))
1.100+
1.101+(defun get-kv-raw (db key &optional (opt (rocksdb-readoptions-create)))
1.102+ (let ((klen (length key)))
1.103+ (with-alien ((vlen (* size-t) (make-alien size-t 0))
1.104+ (errptr rocksdb-errptr nil)
1.105+ (k (* char) (make-alien char klen)))
1.106+ (setfa k key)
1.107+ (let* ((val (rocksdb-get db
1.108+ opt
1.109+ k
1.110+ klen
1.111+ vlen
1.112+ errptr)))
1.113+ (unless (null-alien errptr)
1.114+ (error 'get-kv-error
1.115+ :db db
1.116+ :key key
1.117+ :error-message (alien-sap errptr)))
1.118+ ;; helps if we know the vlen beforehand, would need a custom
1.119+ ;; C-side function probably.
1.120+ (let ((v (make-array (deref vlen) :element-type 'unsigned-byte)))
1.121+ (clone-octets-from-alien val v (deref vlen))
1.122+ v)))))
1.123+
1.124+(defun get-kv-str-raw (db key &optional opt)
1.125+ (let ((k (string-to-octets key)))
1.126+ (let ((v (get-kv-raw db k opt)))
1.127+ (when v (concatenate 'string (map 'vector #'code-char v))))))
1.128+
1.129+(defun get-cf-raw (db cf key &optional (opt (rocksdb-readoptions-create)))
1.130+ (let ((klen (length key)))
1.131+ (with-alien ((vlen (* size-t) (make-alien size-t 0))
1.132+ (errptr rocksdb-errptr nil)
1.133+ (k (* char) (make-alien char klen)))
1.134+ (setfa k key)
1.135+ (let* ((val (rocksdb-get-cf db
1.136+ opt
1.137+ cf
1.138+ k
1.139+ klen
1.140+ vlen
1.141+ errptr)))
1.142+ (unless (null-alien errptr)
1.143+ (error 'get-kv-error
1.144+ :db db
1.145+ :key key
1.146+ :error-message (alien-sap errptr)))
1.147+ ;; helps if we know the vlen beforehand, would need a custom
1.148+ ;; C-side function probably.
1.149+ (let ((v (make-array (deref vlen) :element-type 'unsigned-byte)))
1.150+ (clone-octets-from-alien val v (deref vlen))
1.151+ v)))))
1.152+
1.153+(defun get-cf-str-raw (db cf key &optional opt)
1.154+ (let ((k (string-to-octets key)))
1.155+ (let ((v (get-cf-raw db cf k opt)))
1.156+ (when v (concatenate 'string (map 'vector #'code-char v))))))
1.157+
1.158+(defun create-iter (db &optional (opt (rocksdb-readoptions-create)))
1.159+ (rocksdb-create-iterator db opt))
1.160+
1.161+(defun iter-key (iter)
1.162+ (with-alien ((klen-ptr (* size-t) (make-alien size-t 0)))
1.163+ (let* ((key-ptr (rocksdb-iter-key iter klen-ptr))
1.164+ (klen (deref klen-ptr))
1.165+ (k (make-array klen :element-type '(unsigned-byte 8))))
1.166+ (clone-octets-from-alien key-ptr k klen)
1.167+ k)))
1.168+
1.169+(defun iter-key-str (iter)
1.170+ (when-let ((k (iter-key iter)))
1.171+ (octets-to-string k)))
1.172+
1.173+ (defun iter-val (iter)
1.174+ (with-alien ((vlen-ptr (* size-t) (make-alien size-t 0)))
1.175+ (let* ((val-ptr (rocksdb-iter-value iter vlen-ptr))
1.176+ (vlen (deref vlen-ptr))
1.177+ (v (make-array vlen :element-type '(unsigned-byte 8))))
1.178+ (clone-octets-from-alien val-ptr v vlen)
1.179+ v)))
1.180+
1.181+ (defun iter-val-str (iter)
1.182+ (when-let ((v (iter-val iter)))
1.183+ (octets-to-string v)))
1.184+
1.185+(defmacro with-iter ((iter-var db &optional opt) &body body)
1.186+ `(let ((,iter-var (create-iter ,db ,opt)))
1.187+ (unwind-protect (progn ,@body)
1.188+ (rocksdb-iter-destroy ,iter-var))))
