1.1--- a/lisp/ffi/rocksdb/checkpoint.lisp Sun Aug 25 00:14:17 2024 -0400
1.2+++ b/lisp/ffi/rocksdb/checkpoint.lisp Sun Aug 25 20:28:57 2024 -0400
1.3@@ -14,7 +14,7 @@
1.4 (log-size-for-flush (unsigned 64)))
1.5
1.6 (define-alien-routine rocksdb-checkpoint-object-destroy void
1.7- (* rocksdb-checkpoint))
1.8+ (checkpoint (* rocksdb-checkpoint)))
1.9
1.10 (def-with-errptr rocksdb-open-and-trim-history (* rocksdb)
1.11 (opts (* rocksdb-options))
2.1--- a/lisp/ffi/rocksdb/pkg.lisp Sun Aug 25 00:14:17 2024 -0400
2.2+++ b/lisp/ffi/rocksdb/pkg.lisp Sun Aug 25 20:28:57 2024 -0400
2.3@@ -320,7 +320,8 @@
2.4 :rocksdb-deleted-cf-function
2.5 :rocksdb-put-cf-function
2.6 :rocksdb-deleted-function
2.7- :rocksdb-put-function))
2.8+ :rocksdb-put-function
2.9+ :rocksdb-open-column-families))
2.10
2.11 (in-package :rocksdb)
2.12
3.1--- a/lisp/ffi/rocksdb/rocksdb.asd Sun Aug 25 00:14:17 2024 -0400
3.2+++ b/lisp/ffi/rocksdb/rocksdb.asd Sun Aug 25 20:28:57 2024 -0400
3.3@@ -16,6 +16,7 @@
3.4 (:file "opts")
3.5 (:file "sst")
3.6 (:file "db")
3.7+ (:file "checkpoint")
3.8 (:file "metadata")
3.9 (:file "merge")
3.10 (:file "compaction")
4.1--- a/lisp/lib/obj/db.lisp Sun Aug 25 00:14:17 2024 -0400
4.2+++ b/lisp/lib/obj/db.lisp Sun Aug 25 20:28:57 2024 -0400
4.3@@ -19,7 +19,7 @@
4.4 (:documentation "Return the Database associated with SELF."))
4.5
4.6 (defclass database ()
4.7- ((db :initarg :db :accessor db)))
4.8+ ((db :initform nil :initarg :db :accessor db)))
4.9
4.10 (defclass database-collection () ())
4.11
4.12@@ -54,6 +54,16 @@
4.13 (defgeneric insert-db (dbs name &key &allow-other-keys)
4.14 (:documentation "Inserts a database by NAME into the database-collection DBS."))
4.15
4.16+(defgeneric db-open-p (self)
4.17+ (:documentation "Return T when database SELF is open.")
4.18+ (:method ((self t)) nil)
4.19+ (:method ((self database)) (when (db self) t)))
4.20+
4.21+(defgeneric db-closed-p (self)
4.22+ (:documentation "Return T when database SELF is closed.")
4.23+ (:method ((self t)) t)
4.24+ (:method ((self database)) (unless (db self) t)))
4.25+
4.26 ;;; Common
4.27 (defun slot-val (instance slot-name)
4.28 (if (and instance
5.1--- a/lisp/lib/obj/pkg.lisp Sun Aug 25 00:14:17 2024 -0400
5.2+++ b/lisp/lib/obj/pkg.lisp Sun Aug 25 20:28:57 2024 -0400
5.3@@ -335,7 +335,9 @@
5.4 :query-db
5.5 :db-get
5.6 :db
5.7- :database))
5.8+ :database
5.9+ :db-closed-p
5.10+ :db-open-p))
5.11
5.12 (defpackage :obj/query
5.13 (:nicknames :query)
5.14@@ -462,7 +464,8 @@
5.15 :extract-columns*
5.16 :extract-columns
5.17 :query-vop
5.18- :expr))
5.19+ :expr
5.20+ :load-field))
5.21
5.22 (defpackage :obj/secret
5.23 (:nicknames :secret)
6.1--- a/lisp/lib/obj/query.lisp Sun Aug 25 00:14:17 2024 -0400
6.2+++ b/lisp/lib/obj/query.lisp Sun Aug 25 20:28:57 2024 -0400
6.3@@ -81,7 +81,9 @@
6.4 (defun make-schema (&rest fields)
6.5 (make-instance 'schema :fields (coerce fields 'field-vector)))
6.6
6.7-(defgeneric load-schema (self &optional schema))
6.8+(defmethod print-object ((self schema) stream)
6.9+ (print-unreadable-object (self stream :type t)
6.10+ (format stream ":fields ~A" (map 'list 'field-name (fields self)))))
6.11
6.12 (defmethod make-load-form ((self schema) &optional env)
6.13 (declare (ignore env))
6.14@@ -124,7 +126,8 @@
6.15 (record-batch-schema self)))
6.16
6.17 (defgeneric derive-schema (self))
6.18-
6.19+(defgeneric load-schema (self schema))
6.20+(defgeneric load-field (self field))
6.21 (defgeneric select (self names)
6.22 (:method ((self schema) (names list))
6.23 (let* ((fields (fields self))
6.24@@ -408,7 +411,7 @@
6.25 do (push (to-field g input) ret))
6.26 (loop for a across (slot-value self 'agg-expr)
6.27 do (push (to-field a input) ret))
6.28- (make-schema :fields (coerce ret 'field-vector))))
6.29+ (apply 'make-schema ret)))
6.30
6.31 ;;;;; Limit
6.32 (defclass limit (logical-plan)
7.1--- a/lisp/lib/rdb/err.lisp Sun Aug 25 00:14:17 2024 -0400
7.2+++ b/lisp/lib/rdb/err.lisp Sun Aug 25 20:28:57 2024 -0400
7.3@@ -10,72 +10,72 @@
7.4 ((message :initarg :message
7.5 :reader rdb-error-message))
7.6 (:auto t)
7.7- (:documentation "Error signaled by the RDB system."))
7.8+ (:documentation "Error signaled by the RDB system.")))
7.9
7.10- (define-condition rocksdb-error (rdb-error)
7.11- ((db :initarg :db :reader rdb-error-db))
7.12- (:documentation "Error signaled by RocksDB subsystem."))
7.13+(define-condition rocksdb-error (rdb-error)
7.14+ ((db :initarg :db :reader rdb-error-db))
7.15+ (:documentation "Error signaled by RocksDB subsystem."))
7.16
7.17- (defmethod print-object ((obj rdb-error) stream)
7.18- (print-unreadable-object (obj stream :type t :identity t)
7.19- (format stream "~A" (rdb-error-message obj))))
7.20+(defmethod print-object ((obj rdb-error) stream)
7.21+ (print-unreadable-object (obj stream :type t :identity t)
7.22+ (format stream "~A" (rdb-error-message obj))))
7.23
7.24- (define-condition open-db-error (rocksdb-error)
7.25- ()
7.26- (:documentation "Error signaled while opening a database."))
7.27+(define-condition open-db-error (rocksdb-error)
7.28+ ()
7.29+ (:documentation "Error signaled while opening a database."))
7.30
7.31- (define-condition open-backup-engine-error (rocksdb-error)
7.32- ()
7.33- (:documentation "Error signaled while opening a backup engine."))
7.34+(define-condition open-backup-engine-error (rocksdb-error)
7.35+ ()
7.36+ (:documentation "Error signaled while opening a backup engine."))
7.37
7.38- (define-condition destroy-db-error (rocksdb-error)
7.39- ()
7.40- (:documentation "Error signaled while destroying a database."))
7.41+(define-condition destroy-db-error (rocksdb-error)
7.42+ ()
7.43+ (:documentation "Error signaled while destroying a database."))
7.44
7.45- (define-condition flush-db-error (rocksdb-error)
7.46- ()
7.47- (:documentation "Error signaled while flushing a database."))
7.48+(define-condition flush-db-error (rocksdb-error)
7.49+ ()
7.50+ (:documentation "Error signaled while flushing a database."))
7.51
7.52- (define-condition ingest-db-error (rocksdb-error)
7.53- ()
7.54- (:documentation "Error signaled while ingesting a database."))
7.55+(define-condition ingest-db-error (rocksdb-error)
7.56+ ()
7.57+ (:documentation "Error signaled while ingesting a database."))
7.58
7.59- (define-condition sst-writer-error (rocksdb-error)
7.60- ()
7.61- (:documentation "Error signaled while writing a SST file."))
7.62+(define-condition sst-writer-error (rocksdb-error)
7.63+ ()
7.64+ (:documentation "Error signaled while writing a SST file."))
7.65
7.66- (define-condition repair-db-error (rocksdb-error)
7.67- ()
7.68- (:documentation "Error signaled while repairing a database."))
7.69+(define-condition repair-db-error (rocksdb-error)
7.70+ ()
7.71+ (:documentation "Error signaled while repairing a database."))
7.72
7.73- (define-condition destroy-backup-engine-error (rocksdb-error)
7.74- ()
7.75- (:documentation "Error signaled while destroying a backup engine."))
7.76+(define-condition destroy-backup-engine-error (rocksdb-error)
7.77+ ()
7.78+ (:documentation "Error signaled while destroying a backup engine."))
7.79
7.80- (define-condition cf-error (rocksdb-error)
7.81- ((cf :initarg :cf :reader rdb-error-cf))
7.82- (:documentation "Error signaled in the context of a Column Family."))
7.83+(define-condition cf-error (rocksdb-error)
7.84+ ((cf :initarg :cf :reader rdb-error-cf))
7.85+ (:documentation "Error signaled in the context of a Column Family."))
7.86
7.87- (define-condition put-kv-error (rdb-error)
7.88- ((kv :initarg :kv :reader rdb-error-kv))
7.89- (:documentation "Error signaled while processing a PUT-KV request"))
7.90+(define-condition put-kv-error (rdb-error)
7.91+ ((kv :initarg :kv :reader rdb-error-kv))
7.92+ (:documentation "Error signaled while processing a PUT-KV request"))
7.93
7.94- (define-condition get-kv-error (rdb-error)
7.95- ((key :initarg :key :reader key))
7.96- (:documentation "Error signaled while processing a GET-KV request"))
7.97+(define-condition get-kv-error (rdb-error)
7.98+ ((key :initarg :key :reader key))
7.99+ (:documentation "Error signaled while processing a GET-KV request"))
7.100
7.101- (define-condition opt-handler-missing (warning rdb-error)
7.102- ())
7.103+(define-condition opt-handler-missing (warning rdb-error)
7.104+ ())
7.105
7.106- (define-condition db-missing (warning rdb-error)
7.107- ())
7.108+(define-condition db-missing (warning rdb-error)
7.109+ ())
7.110
7.111- (define-condition metadata-missing (warning rdb-error)
7.112- ())
7.113+(define-condition metadata-missing (warning rdb-error)
7.114+ ())
7.115
7.116- (define-condition invalid-propname (rdb-error)
7.117- ()
7.118- (:documentation "Error signaled when an invalid ROCKSDB-PROPERTY value is detected.")))
7.119+(define-condition invalid-propname (rdb-error)
7.120+ ()
7.121+ (:documentation "Error signaled when an invalid ROCKSDB-PROPERTY value is detected."))
7.122
7.123 (defun handle-errptr (errptr &optional errtyp params)
7.124 "Handle ERRPTR, a ROCKSDB-ERRPTR type which is a pointer to NULL,
8.1--- a/lisp/lib/rdb/macs.lisp Sun Aug 25 00:14:17 2024 -0400
8.2+++ b/lisp/lib/rdb/macs.lisp Sun Aug 25 20:28:57 2024 -0400
8.3@@ -114,7 +114,7 @@
8.4 `(with-db (,db-var (make-rdb
8.5 (namestring (funcall ,*temp-db-path-generator* ,(symbol-name db-var)))
8.6 (default-rdb-opts)
8.7- (make-array ,(length cfs) :element-type 'rdb-cf :initial-contents ',cfs)))
8.8+ (make-array ,(length cfs) :element-type 'rdb-cf :initial-contents ',cfs :adjustable t :fill-pointer ,(length cfs))))
8.9 ,@(when open `((open-db ,db-var)
8.10 (create-cfs ,db-var)))
8.11 (prog1
9.1--- a/lisp/lib/rdb/obj.lisp Sun Aug 25 00:14:17 2024 -0400
9.2+++ b/lisp/lib/rdb/obj.lisp Sun Aug 25 20:28:57 2024 -0400
9.3@@ -159,13 +159,22 @@
9.4 tslen)))
9.5
9.6 ;;; column family
9.7-(defstruct (rdb-cf (:constructor make-rdb-cf (name &key #+nil kv sap)))
9.8- "RDB Column Family structure. Contains a name, a cons of (rdb-key-type
9.9-. rdb-val-type), and a system-area-pointer to the underlying
9.10-rocksdb_cf_t handle."
9.11+(defstruct (rdb-cf (:constructor make-rdb-cf (name &key key-type val-type sap)))
9.12+ "RDB Column Family structure. Contains a name, key-type, val-type,
9.13+and a system-area-pointer to the underlying rocksdb_cf_t handle.
9.14+
9.15+A NIL key-type or val-type indicates an unitialized value which defaults to
9.16+'octet-vector. This is needed to distinguish the value 'octet-vector being
9.17+supplied by the user from the default value."
9.18 (name "" :type string)
9.19- ;; (kv *default-rdb-kv* :type rdb-kv)
9.20+ (key-type nil :type (or list symbol))
9.21+ (val-type nil :type (or list symbol))
9.22 (sap nil :type (or null alien)))
9.23+
9.24+(defmethod close-cf ((self rdb-cf) &optional error)
9.25+ (if-let ((sap (rdb-cf-sap self)))
9.26+ (setf (rdb-cf-sap self) (rocksdb:rocksdb-column-family-handle-destroy sap))
9.27+ (when error (rdb-error "column family is already closed."))))
9.28
9.29 ;;; rdb-stats
9.30 (defstruct (rdb-stats (:constructor make-rdb-stats (&optional sap)))
9.31@@ -261,7 +270,7 @@
9.32 (defstruct (rdb (:constructor make-rdb (name opts &optional cfs db)))
9.33 (name "" :type string)
9.34 (opts (default-rdb-opts) :type rdb-opts)
9.35- (cfs (make-array 0 :element-type 'rdb-cf :adjustable t :fill-pointer 0) :type (array rdb-cf))
9.36+ (cfs (make-array 0 :element-type 'rdb-cf :adjustable t :fill-pointer 0) :type (vector rdb-cf))
9.37 (db nil :type (or null alien))
9.38 (backup nil :type (or null alien))
9.39 (snapshots #() :type (array alien)))
9.40@@ -270,17 +279,69 @@
9.41
9.42 (defmethod print-object ((self rdb) stream)
9.43 (print-unreadable-object (self stream :type t :identity t)
9.44- (format stream ":cfs ~A" (length (rdb-cfs self)))))
9.45+ (format stream ":cfs ~A :open ~A" (length (rdb-cfs self)) (db-open-p self))))
9.46+
9.47+(defmethod db ((self rdb))
9.48+ (rdb-db self))
9.49+
9.50+(defmethod db-open-p ((self rdb))
9.51+ (when (db self) t))
9.52+
9.53+(defmethod db-closed-p ((self rdb))
9.54+ (unless (db self) t))
9.55+
9.56+(defun translate-cf-to-field (cf)
9.57+ (let ((vt (or (rdb-cf-val-type cf) 'octet-vector))
9.58+ (kt (unless (rdb-cf-val-type cf) (or (rdb-cf-key-type cf) 'octet-vector))))
9.59+ (make-field :name (rdb-cf-name cf)
9.60+ :type (if kt
9.61+ (cons kt vt)
9.62+ vt))))
9.63
9.64-(defun create-db (name &key opts cfs open)
9.65+(defmethod load-field ((self rdb-cf) (field field))
9.66+ (let ((type (field-type field)))
9.67+ (typecase type
9.68+ ;; note that this means you can't use LOAD-SCHEMA to reset an
9.69+ ;; rdb schema as you may expect.
9.70+ (null nil)
9.71+ (atom (setf (rdb-cf-val-type self) type))
9.72+ (list (setf (rdb-cf-key-type self) (car type)
9.73+ (rdb-cf-val-type self)
9.74+ (if (and (listp (cdr type))
9.75+ (= 1 (length (cdr type))))
9.76+ (cadr type)
9.77+ (cdr type)))))
9.78+ self))
9.79+
9.80+(defmethod load-schema ((self rdb) (schema schema))
9.81+ "Load SCHEMA into rdb database object SELF. This will add any missing rdb-cfs
9.82+and update existing key/value types for cfs with the same name. Existing cfs
9.83+only get their their type slots updated on non-nil values."
9.84+ (loop for field across (fields schema)
9.85+ do (if-let ((cf (find-cf (field-name field) self)))
9.86+ (load-field cf field)
9.87+ (push-cf
9.88+ (load-field (make-rdb-cf (field-name field)) field)
9.89+ self)))
9.90+ self)
9.91+
9.92+(defmethod derive-schema ((self rdb))
9.93+ (apply 'make-schema
9.94+ (loop for cf across (rdb-cfs self)
9.95+ collect (translate-cf-to-field cf))))
9.96+
9.97+(defun create-db (name &key opts cfs schema open)
9.98 "Construct a new RDB instance from NAME.
9.99
9.100 OPTS = rdb-opts
9.101 CFS = (sequence rdb-cf)
9.102+SCHEMA = rdb-schema
9.103 OPEN = boolean
9.104
9.105-When OPEN is non-nil, the database and all column families are opened
9.106-and internal sap slots are initialized."
9.107+CFS are always added before the SCHEMA which is loaded with LOAD-SCHEMA.
9.108+
9.109+When OPEN is non-nil, the database and all column families are opened and
9.110+internal sap slots are initialized."
9.111 ;; (when (probe-file name) (log:trace! "db exists: " name))
9.112 (let* ((opts (or opts (default-rdb-opts)))
9.113 (obj
9.114@@ -298,6 +359,8 @@
9.115 (rdb-cf (vector cfs))
9.116 (t (log:warn! "invalid CF passed to create-db"))))
9.117 (make-array 0 :element-type 'rdb-cf :fill-pointer 0)))))
9.118+ (when schema
9.119+ (load-schema obj schema))
9.120 (when open
9.121 (open-db obj))
9.122 obj))
9.123@@ -312,12 +375,32 @@
9.124 (rdb-opts-table opts)))
9.125
9.126 (defmethod push-cf ((cf rdb-cf) (db rdb))
9.127- (vector-push cf (rdb-cfs db)))
9.128+ (vector-push-extend cf (rdb-cfs db)))
9.129+
9.130+(defmethod create-cf ((db rdb) (cf rdb-cf))
9.131+ (create-cf-raw (rdb-db db) (rdb-cf-name cf) (rdb-opts-sap (rdb-opts db))))
9.132+
9.133+(defmethod open-cf ((db rdb) (cf rdb-cf) &optional error)
9.134+ (unless (null (rdb-cf-sap cf))
9.135+ (if error
9.136+ (rdb-error "column family is already open - close before re-opening.")
9.137+ cf)
9.138+ (setf (rdb-cf-sap cf) (open-cf-raw (rdb-db db) (default-rocksdb-options) (rdb-cf-name cf)))))
9.139
9.140-;; TODO: fix
9.141-(defmethod create-cf ((db rdb) (cf rdb-cf))
9.142- (setf (rdb-cf-sap cf)
9.143- (create-cf-raw (rdb-db db) (rdb-cf-name cf) (rdb-opts-sap (rdb-opts db)))))
9.144+(defmethod open-cf ((db rdb) (cf string) &optional (error t))
9.145+ (if-let ((cf (find-cf cf db)))
9.146+ (or (rdb-cf-sap cf)
9.147+ (setf (rdb-cf-sap cf) (create-cf db cf)))
9.148+ (when error (rdb-error "unable to find column-family"))))
9.149+
9.150+(defmethod open-cfs ((self rdb))
9.151+ (loop for cf across (rdb-cfs self)
9.152+ do (setf (rdb-cf-sap cf)
9.153+ (create-cf self cf))))
9.154+
9.155+(defmethod close-cfs ((self rdb))
9.156+ (loop for cf across (rdb-cfs self)
9.157+ do (close-cf cf)))
9.158
9.159 (defmacro unless-null-db (slots self &body body)
9.160 `(with-slots (db ,@slots) ,self
9.161@@ -443,12 +526,18 @@
9.162 (close-db self)
9.163 (destroy-db-raw (rdb-name self)))
9.164
9.165-(defmethod put-key ((self rdb) key val)
9.166+(defmethod put-key ((self rdb) (key t) (val t))
9.167 (put-kv-raw
9.168 (rdb-db self)
9.169- key
9.170+ key
9.171 val))
9.172
9.173+(defmethod put-key ((self rdb) (key string) (val string))
9.174+ (put-kv-raw
9.175+ (rdb-db self)
9.176+ (sb-ext:string-to-octets key)
9.177+ (sb-ext:string-to-octets val)))
9.178+
9.179 (defmethod put-kv ((self rdb) (kv rdb-kv))
9.180 (put-kv-raw
9.181 (rdb-db self)
9.182@@ -456,12 +545,15 @@
9.183 (rdb-val kv)))
9.184
9.185 (defmethod insert-key ((self rdb) key val &key cf)
9.186- (if cf
9.187+ (if-let ((cf (and cf (find-cf cf self))))
9.188+ (if-let ((sap (rdb-cf-sap cf)))
9.189 (put-cf-raw
9.190 (rdb-db self)
9.191- (rdb-cf-sap (find cf (rdb-cfs self) :key #'rdb-cf-name :test #'equal))
9.192+ sap
9.193 key
9.194- val)
9.195+ val
9.196+ (rocksdb-writeoptions-create))
9.197+ (rdb-error "column-family is not open"))
9.198 (put-key self key val)))
9.199
9.200 (defmethod insert-key ((self rdb) (key string) (val string) &key cf)
9.201@@ -473,13 +565,13 @@
9.202 (defmethod insert-key ((self rdb) key (val string) &key cf)
9.203 (insert-key self key (string-to-octets val) :cf cf))
9.204
9.205-(defmethod insert-kv ((self rdb) (kv rdb-kv) &key cf opts)
9.206+(defmethod insert-kv ((self rdb) (kv rdb-kv) &key cf (opts (rocksdb-writeoptions-create)))
9.207 (if cf
9.208 (let ((cf (etypecase cf
9.209 (rdb-cf cf)
9.210 (t (find cf (rdb-cfs self)
9.211 :key #'rdb-cf-name
9.212- :test #'string=)))))
9.213+ :test #'equal)))))
9.214 (put-cf-raw (rdb-db self)
9.215 (rdb-cf-sap cf)
9.216 (rdb-key kv)
9.217@@ -490,11 +582,11 @@
9.218 (defmethod get-key ((self rdb) (key string) &key (opts (rocksdb-readoptions-create)) cf)
9.219 (with-slots (db) self
9.220 (if cf
9.221- (get-cf-str-raw db cf key opts)
9.222+ (get-cf-str-raw db (rdb-cf-sap (find-cf cf self)) key opts)
9.223 (get-kv-str-raw db key opts))))
9.224
9.225 (defmethod get-key ((self rdb) key &key (opts (rocksdb-readoptions-create)) cf)
9.226 (with-slots (db) self
9.227 (if cf
9.228- (get-cf-raw db cf key opts)
9.229+ (get-cf-raw db (rdb-cf-sap (find-cf cf self)) key opts)
9.230 (get-kv-raw db key opts))))
10.1--- a/lisp/lib/rdb/pkg.lisp Sun Aug 25 00:14:17 2024 -0400
10.2+++ b/lisp/lib/rdb/pkg.lisp Sun Aug 25 20:28:57 2024 -0400
10.3@@ -112,7 +112,15 @@
10.4 :do-cf
10.5 :with-iter ;; generic
10.6 :do-cfs
10.7- :with-sst))
10.8+ :with-sst
10.9+ :nil
10.10+ :rdb-cf-p
10.11+ :copy-rdb-cf
10.12+ :rdb-cf-key-type
10.13+ :rdb-cf-val-type
10.14+ :close-cf
10.15+ :open-cf
10.16+ :close-cfs))
10.17
10.18 (in-package :rdb)
10.19 (rocksdb:load-rocksdb nil)
11.1--- a/lisp/lib/rdb/proto.lisp Sun Aug 25 00:14:17 2024 -0400
11.2+++ b/lisp/lib/rdb/proto.lisp Sun Aug 25 20:28:57 2024 -0400
11.3@@ -34,8 +34,18 @@
11.4 (:documentation "Pull a foreign value identified by KEY from the sap associated with SELF."))
11.5 (defgeneric pull-sap* (self)
11.6 (:documentation "Implicitly pull foreign values from the sap associated with SELF."))
11.7-(defgeneric push-cf (self cf)
11.8+(defgeneric push-cf (cf self)
11.9 (:documentation "Push a column-family to a sap."))
11.10+(defgeneric open-cf (self cf &optional error)
11.11+ (:documentation "Open column-family CF in SELF. When ERROR is non-nil signal an error if the
11.12+column-family is already open."))
11.13+(defgeneric open-cfs (self)
11.14+ (:documentation "Open all column-fmailies belonging to SELF."))
11.15+(defgeneric close-cf (self &optional error)
11.16+ (:documentation "Close the column-family SELF. When ERROR is non-nil signal an error if the
11.17+column-family is already closed."))
11.18+(defgeneric close-cfs (self)
11.19+ (:documentation "Close the column-families belonging to SELF."))
11.20 (defgeneric insert-key (self key val &key)
11.21 (:documentation "Insert KEY:VAL into SELF."))
11.22 (defgeneric insert-kv (self kv &key)
12.1--- a/lisp/lib/rdb/raw.lisp Sun Aug 25 00:14:17 2024 -0400
12.2+++ b/lisp/lib/rdb/raw.lisp Sun Aug 25 20:28:57 2024 -0400
12.3@@ -116,6 +116,10 @@
12.4 (when v (octets-to-string v)))))
12.5
12.6 ;;; Column Family
12.7+(defun open-cf-raw (db name &optional (opt (rocksdb-options-create)))
12.8+ (with-errptr (err 'rocksdb-cf-error (list :db db :cf name))
12.9+ (rocksdb-open-column-families opt name 1 nil nil nil err)))
12.10+
12.11 (defun create-cf-raw (db name &optional (opt (rocksdb-options-create)))
12.12 (with-errptr (err 'rocksdb-cf-error (list :db db :cf name))
12.13 (rocksdb-create-column-family db opt name err)))
13.1--- a/lisp/lib/rdb/tests.lisp Sun Aug 25 00:14:17 2024 -0400
13.2+++ b/lisp/lib/rdb/tests.lisp Sun Aug 25 20:28:57 2024 -0400
13.3@@ -1,5 +1,5 @@
13.4 (defpackage :rdb/tests
13.5- (:use :cl :std :rt :rocksdb :rdb :sb-ext :sb-alien :log))
13.6+ (:use :cl :std :rt :rocksdb :rdb :sb-ext :sb-alien :log :obj/query))
13.7
13.8 (in-package :rdb/tests)
13.9
13.10@@ -58,7 +58,7 @@
13.11 (deftest rdb ()
13.12 "Test RDB struct and methods."
13.13 ;; NOTE: passing a directory with trailing slash causes segfault - guess we gotta handle tht
13.14- (with-db (db (create-db "/tmp/rdb" :open t))
13.15+ (with-temp-db (db () :open t :destroy t)
13.16 (info! (hash-table-alist (backfill-opts db :full t)))
13.17 ;; get/set without cf
13.18 (put-kv-str-raw (rdb-db db) "key" "val")
13.19@@ -69,16 +69,18 @@
13.20 (push-cf cf db)))
13.21 (debug! (rdb-cfs db))
13.22 (create-cfs db)
13.23- ;; TODO
13.24+ ;; (flush-db db)
13.25+ ;; FIX 2024-08-25:
13.26 (do-cfs (cf (rdb-cfs db))
13.27- (insert-kv db (make-kv "key" "val") :cf cf)
13.28- (is (equal (get-key db "key" :cf (rdb-cf-sap cf)) "val")))
13.29- (rocksdb-cancel-all-background-work (rdb-db db) nil)
13.30+ (with-cf (cf cf)
13.31+ (trace! cf)
13.32+ ;; (insert-kv db (make-kv "key" "val") :cf cf)
13.33+ ;; (is (equal (get-key db "key" :cf (rdb-cf-sap cf)) "val"))
13.34+ ))
13.35+ (rocksdb-cancel-all-background-work (rdb-db db) t)
13.36 ;; insert after background cancel
13.37 (insert-key db "test" "zaa")
13.38- (is (string= "zaa" (get-key db "test")))
13.39- ;; cleanup
13.40- (destroy-db db)))
13.41+ (is (string= "zaa" (get-key db "test")))))
13.42
13.43 (deftest temp-db ()
13.44 "Test WITH-TEMP-DB macro."
13.45@@ -154,3 +156,18 @@
13.46 "Test basic error handling."
13.47 (with-temp-db (errs () :open t :destroy t)
13.48 (signals rdb-error (open-db errs))))
13.49+
13.50+(deftest schema ()
13.51+ "Test loading and handling of RDB-SCHEMA objects."
13.52+ (let ((cf (load-field (make-rdb-cf "foo") (make-field :type '(string string)))))
13.53+ (is (eql (rdb-cf-key-type cf) 'string))
13.54+ (is (eql (rdb-cf-val-type cf) 'string))
13.55+ (is (string= (rdb-cf-name cf) "foo"))
13.56+ (with-temp-db (schema-no-cfs () :destroy t :open t)
13.57+ (load-schema schema-no-cfs (make-schema (make-field :type nil)))
13.58+ (is (= 1 (length (rdb-cfs schema-no-cfs)))))
13.59+ (with-temp-db (schema-cfs (baz) :open t :destroy t)
13.60+ (load-schema schema-cfs (make-schema (make-field :name "BAZ" :type '(octet-vector . string))))
13.61+ (is (= 1 (length (rdb-cfs schema-cfs))))
13.62+ (is (eql 'octet-vector (rdb-cf-key-type (aref (rdb-cfs schema-cfs) 0))))
13.63+ (is (eql 'string (rdb-cf-val-type (aref (rdb-cfs schema-cfs) 0)))))))