Mercurial > core / lisp/lib/rdb/obj.lisp
changeset 679: |
12287fab15d0 |
parent: |
2b7d5a8d63ac
|
child: |
5f88b237ce29 |
author: |
Richard Westhaver <ellis@rwest.io> |
date: |
Thu, 26 Sep 2024 21:16:45 -0400 |
permissions: |
-rw-r--r-- |
description: |
rocksdb load opts and env updates |
4 (defvar *rdb-opts-lookup-table* 5 (let ((table (make-hash-table :test #'equal))) 6 (mapc (lambda (x) (setf (gethash (car x) table) (cdr x))) 7 (loop for y across *rocksdb-options* 8 collect (cons y (format nil "~:@(rocksdb-options-set-~x~)" y)))) 11 (defun %set-rocksdb-option (opt key val) 12 (funcall (rdb-opt-setter key) opt val)) 14 (defun %get-rocksdb-option (opt key) 15 (if-let ((g (rdb-opt-getter key))) 17 (warn 'opt-handler-missing :message key))) 19 (defun opt-no-setter-p (k) 21 (string (string-downcase k)) 22 (symbol (string-downcase (symbol-name k))) 23 (t (string-downcase (format nil "~s" k)))))) 25 (mapcar (lambda (x) (equal k x)) (list "parallelism" "enable-statistics"))))) 28 ((table :initarg :table :type hash-table :accessor rdb-opts-table) 29 (sap :initarg :sap :type (or null alien) :accessor rdb-opts-sap))) 31 (defmethod initialize-instance ((self rdb-opts) &rest initargs &key &allow-other-keys) 32 (with-slots (sap table) self 33 ;; initialize slots - remember, initargs doesn't refer to slot 34 ;; names, they're opt names. 35 (unless (getf initargs :table) (setf table (make-hash-table :test #'equal))) 36 (unless (getf initargs :sap) (setf sap (rocksdb-options-create))) 37 (loop for (k v) on initargs by #'cddr while v 38 do (let ((k (typecase k 39 (string (string-downcase k)) 40 (symbol (string-downcase (symbol-name k))) 41 (t (string-downcase (format nil "~s" k)))))) 45 (defun make-rdb-opts (&rest values) 46 (let ((opts (apply #'make-instance 'rdb-opts values))) 50 (defmethod get-opt ((self rdb-opts) key) 51 "Return the current value of KEY in SELF if found, else return nil." 52 (gethash key (rdb-opts-table self))) 54 (defmethod set-opt ((self rdb-opts) key val &key push) 55 "Set the VAL of KEY in SELF with '(setf (gethash SELF KEY) VAL)'." 57 (setf (gethash key (rdb-opts-table self)) val) 58 (when push (push-sap self key)))) 60 (defmethod push-sap ((self rdb-opts) key) 61 "Push KEY from slot :TABLE to the instance :SAP." 62 (%set-rocksdb-option (rdb-opts-sap self) key (get-opt self key))) 64 (defmethod push-sap* ((self rdb-opts)) 65 "Initialized the SAP slot with values from TABLE." 66 (with-slots (table) self 67 (loop for k in (hash-table-keys table) 68 ;; note how we don't handle any special cases here - we can 69 ;; always set an opt but sometimes we can't get it. 70 do (push-sap self k)))) 72 (defmethod pull-sap ((self rdb-opts) key) 73 (setf (gethash key (rdb-opts-table self)) (%get-rocksdb-option (rdb-opts-sap self) key))) 75 (defmethod pull-sap* ((self rdb-opts)) 76 (with-slots (table) self 77 (loop for k in (hash-table-keys table) 78 unless (opt-no-setter-p k) 82 (defmethod backfill-opts ((self rdb-opts) &key full) 83 "Backfill the TABLE slot with values from SAP. 85 When FULL is non-nil, retrieve the full set of options available, not 86 just the keys currently present in TABLE." 88 (loop for k across *rocksdb-options* 89 unless (opt-no-setter-p k) 92 (rdb-opts-table self)) 94 (defun default-rdb-opts () 95 (make-rdb-opts :create-if-missing t :create-missing-column-families t 96 :parallelism (num-cpus))) 99 ((key :initarg :key :type octet-vector :accessor rdb-key) 100 (val :initarg :val :type octet-vector :accessor rdb-val))) 102 (defmethod make-kv (key val) 103 (make-instance 'rdb-kv 105 :val (make-val val))) 107 (defvar *default-rdb-kv* (make-kv #() #())) 110 (defclass rdb-iter (sequence) 111 ((sap :initform nil :initarg :sap :type (or null alien) :accessor rdb-iter-sap))) 113 (defmethod iter-valid-p ((self rdb-iter)) 114 (rocksdb-iter-valid (rdb-iter-sap self))) 116 (defmethod iter-seek-to-first ((self rdb-iter)) 117 (rocksdb-iter-seek-to-first (rdb-iter-sap self))) 119 (defmethod iter-seek-to-last ((self rdb-iter)) 120 (rocksdb-iter-seek-to-last (rdb-iter-sap self))) 122 (defmethod iter-seek-for-prev ((self rdb-iter) (key vector) &key) 123 (rocksdb-iter-seek-for-prev (rdb-iter-sap self) key (length key))) 125 (defmethod iter-seek ((self rdb-iter) (key simple-vector) &key) 126 (rocksdb-iter-seek (rdb-iter-sap self) key (length key))) 128 (defmethod iter-next ((self rdb-iter)) 129 (rocksdb-iter-next (rdb-iter-sap self))) 131 (defmethod iter-prev ((self rdb-iter)) 132 (rocksdb-iter-prev (rdb-iter-sap self))) 134 (defmethod iter-key ((self rdb-iter)) 135 (with-alien ((klen size-t)) 136 (let ((key (rocksdb-iter-key (rdb-iter-sap self) (addr klen)))) 137 (let ((k (make-array klen :element-type 'octet))) 138 (clone-octets-from-alien key k klen) 143 (defmethod iter-val ((self rdb-iter)) 144 (with-alien ((vlen size-t)) 145 (let ((val (rocksdb-iter-value (rdb-iter-sap self) (addr vlen)))) 146 (let ((v (make-array vlen :element-type 'octet))) 147 (clone-octets-from-alien val v vlen) 152 (defmethod iter-kv ((self rdb-iter)) 153 (make-kv (iter-key self) (iter-val self))) 155 (defmethod iter-timestamp ((self rdb-iter)) 156 (with-alien ((tslen size-t)) 158 (rocksdb-iter-timestamp (rdb-iter-sap self) (addr tslen)) 162 (defstruct (rdb-cf (:constructor make-rdb-cf (name &key opts key-type val-type sap))) 163 "RDB Column Family structure. Contains a name, key-type, val-type, 164 and a system-area-pointer to the underlying rocksdb_cf_t handle. 166 A NIL key-type or val-type indicates an unitialized value which defaults to 167 'octet-vector. This is needed to distinguish the value 'octet-vector being 168 supplied by the user from the default value." 169 (name "" :type string) 170 (opts (default-rdb-opts) :type rdb-opts) 171 (key-type nil :type (or list symbol)) 172 (val-type nil :type (or list symbol)) 173 (sap nil :type (or null alien))) 175 (defmethod close-cf ((self rdb-cf) &optional error) 176 (if-let ((sap (rdb-cf-sap self))) 177 (setf (rdb-cf-sap self) (rocksdb:rocksdb-column-family-handle-destroy sap)) 178 (when error (rdb-error "column family is already closed.")))) 181 (defstruct (rdb-stats (:constructor make-rdb-stats (&optional sap))) 182 (sap nil :type (or null alien))) 185 (defstruct rdb-cf-metadata 186 (name "default" :type string) 187 (size 0 :type fixnum) 188 (level-count 7 :type fixnum) 189 (file-count 0 :type fixnum) 190 (sap nil :type (or null alien))) 192 (defmethod get-metadata ((self rdb-cf-metadata) &optional (level 0)) 193 (with-slots (sap) self 195 (warn 'metadata-missing :message "ignoring attempt to pull fields from null sap.") 196 (make-rdb-level-metadata :sap (rocksdb-column-family-metadata-get-level-metadata sap level))))) 198 (defmethod print-object ((self rdb-cf-metadata) stream) 199 (print-unreadable-object (self stream :type t) 200 (with-slots (name size level-count file-count) self 201 (format stream "~A :size ~A :levels ~A :files ~A" name size level-count file-count)))) 203 (defmethod pull-sap* ((self rdb-cf-metadata)) 204 (with-slots (name size level-count file-count sap) self 206 (warn 'metadata-missing :message "ignoring attempt to pull fields from null sap.") 207 (setf name (rocksdb-column-family-metadata-get-name sap) 208 size (rocksdb-column-family-metadata-get-size sap) 209 level-count (rocksdb-column-family-metadata-get-level-count sap) 210 file-count (rocksdb-column-family-metadata-get-file-count sap))) 213 (defstruct rdb-level-metadata 214 (level 0 :type fixnum) 215 (size 0 :type fixnum) 216 (file-count 0 :type fixnum) 217 (sap nil :type (or null alien))) 219 (defmethod get-metadata ((self rdb-level-metadata) &optional (file 0)) 220 (with-slots (sap) self 222 (warn 'metadata-missing :message "ignoring attempt to pull fields from null sap.") 223 (make-rdb-sst-file-metadata :sap (rocksdb-level-metadata-get-sst-file-metadata sap file))))) 225 (defmethod print-object ((self rdb-level-metadata) stream) 226 (print-unreadable-object (self stream :type t) 227 (with-slots (level size file-count) self 228 (format stream "~A :size ~A :files ~A" level size file-count)))) 230 (defmethod pull-sap* ((self rdb-level-metadata)) 231 (with-slots (level size file-count sap) self 233 (warn 'metadata-missing :message "ignoring attempt to pull fields from null sap.") 234 (setf level (rocksdb-level-metadata-get-level sap) 235 size (rocksdb-level-metadata-get-size sap) 236 file-count (rocksdb-level-metadata-get-file-count sap))) 239 ;; NOTE: we only store the sizes of largest and smallest key, not the 240 ;; keys themselves. This may change in the future. 241 (defstruct rdb-sst-file-metadata 242 (relative-filename "" :type string) 243 (directory "" :type string) 244 (size 0 :type fixnum) 245 (smallestkey 0 :type fixnum) 246 (largestkey 0 :type fixnum) 247 (sap nil :type (or null alien))) 249 (defmethod print-object ((self rdb-sst-file-metadata) stream) 250 (print-unreadable-object (self stream :type t) 251 (with-slots (relative-filename directory size smallestkey largestkey) self 252 (format stream "~A :dir ~A :size ~A :smallest ~A :largest ~A" 253 relative-filename directory size smallestkey largestkey)))) 255 (defmethod pull-sap* ((self rdb-sst-file-metadata)) 256 (with-slots (relative-filename directory size smallestkey largestkey sap) self 258 (warn 'metadata-missing :message "ignoring attempt to pull fields from null sap.") 259 (with-alien ((ssize size-t 0) 261 (rocksdb-sst-file-metadata-get-largestkey sap (addr lsize)) 262 (rocksdb-sst-file-metadata-get-smallestkey sap (addr ssize)) 263 (setf relative-filename (rocksdb-sst-file-metadata-get-relative-filename sap) 264 directory (rocksdb-sst-file-metadata-get-directory sap) 265 size (rocksdb-sst-file-metadata-get-size sap) 271 (defstruct (rdb (:constructor make-rdb (name opts &optional cfs db))) 272 (name "" :type string) 273 (opts (default-rdb-opts) :type rdb-opts) 274 (cfs (make-array 0 :element-type 'rdb-cf :adjustable t :fill-pointer 0) :type (vector rdb-cf)) 275 (db nil :type (or null alien)) 276 (backup nil :type (or null alien)) 277 (snapshots #() :type (array alien))) 279 (defvar *default-rdb-opts* (default-rdb-opts)) 281 (defmethod print-object ((self rdb) stream) 282 (print-unreadable-object (self stream :type t :identity t) 283 (format stream ":cfs ~A :open ~A" (length (rdb-cfs self)) (db-open-p self)))) 285 (defmethod db ((self rdb)) 288 (defmethod db-open-p ((self rdb)) 291 (defmethod db-closed-p ((self rdb)) 292 (unless (db self) t)) 294 (defun translate-cf-to-field (cf) 295 (let ((vt (or (rdb-cf-val-type cf) 'octet-vector)) 296 (kt (unless (rdb-cf-val-type cf) (or (rdb-cf-key-type cf) 'octet-vector)))) 297 (make-field :name (rdb-cf-name cf) 302 (defmethod load-field ((self rdb-cf) (field field)) 303 (let ((type (field-type field))) 305 ;; note that this means you can't use LOAD-SCHEMA to reset an 306 ;; rdb schema as you may expect. 308 (atom (setf (rdb-cf-val-type self) type)) 309 (list (setf (rdb-cf-key-type self) (car type) 310 (rdb-cf-val-type self) 311 (if (and (listp (cdr type)) 312 (= 1 (length (cdr type)))) 317 (defmethod load-schema ((self rdb) (schema schema)) 318 "Load SCHEMA into rdb database object SELF. This will add any missing rdb-cfs 319 and update existing key/value types for cfs with the same name. Existing cfs 320 only get their their type slots updated on non-nil values." 321 (loop for field across (fields schema) 322 do (if-let ((cf (find-cf (field-name field) self))) 323 (load-field cf field) 325 (load-field (make-rdb-cf (field-name field)) field) 329 (defmethod derive-schema ((self rdb)) 331 (loop for cf across (rdb-cfs self) 332 collect (translate-cf-to-field cf)))) 334 (defun create-db (name &key opts cfs schema open) 335 "Construct a new RDB instance from NAME. 338 CFS = (sequence rdb-cf) 342 CFS are always added before the SCHEMA which is loaded with LOAD-SCHEMA. 344 When OPEN is non-nil, the database and all column families are opened and 345 internal sap slots are initialized." 346 ;; (when (probe-file name) (log:trace! "db exists: " name)) 347 (let* ((opts (or opts (default-rdb-opts))) 350 (string-right-trim '(#\/) 352 (pathname (namestring name)) 354 (t (error "invalid NAME: ~S" name)))) 358 (list (coerce cfs 'vector)) 360 (rdb-cf (vector cfs)) 361 (t (log:warn! "invalid CF passed to create-db")))) 362 (make-array 0 :element-type 'rdb-cf :fill-pointer 0))))) 364 (load-schema obj schema)) 369 (defmethod backfill-opts ((self rdb) &key full) 370 (with-slots (opts) self 372 (loop for k across *rocksdb-options* 373 unless (opt-no-setter-p k) 374 do (pull-sap opts k)) 376 (rdb-opts-table opts))) 378 (defmethod push-cf ((cf rdb-cf) (db rdb)) 379 (vector-push-extend cf (rdb-cfs db))) 381 (defmethod create-cf ((db rdb) (cf rdb-cf)) 382 (create-cf-raw (rdb-db db) (rdb-cf-name cf) (rdb-opts-sap (rdb-opts db)))) 384 (defmethod open-cf ((db rdb) (cf rdb-cf) &optional (error t)) 385 (unless (null (rdb-cf-sap cf)) 387 (rdb-error "column family is already open - close before re-opening.") 389 (setf (rdb-cf-sap cf) (open-cf-raw (rdb-db db) (rdb-cf-opts cf) (rdb-cf-name cf))))) 391 (defmethod open-cf ((db rdb) (cf string) &optional (error t)) 392 (if-let ((cf (find-cf cf db))) 394 (setf (rdb-cf-sap cf) (create-cf db cf))) 395 (when error (rdb-error "unable to find column-family")))) 397 (defmethod open-cfs ((self rdb)) 398 (loop for cf across (rdb-cfs self) 399 do (setf (rdb-cf-sap cf) 400 (create-cf self cf)))) 402 (defmethod close-cfs ((self rdb)) 403 (loop for cf across (rdb-cfs self) 406 (defmacro unless-null-db (slots self &body body) 407 `(with-slots (db ,@slots) ,self 411 (defmethod destroy-cf ((cf rdb-cf)) 414 (setf sap (destroy-cf-raw sap))))) 416 (defmethod set-opt ((self rdb) key val &key push) 417 (with-slots (opts) self 418 (set-opt opts key val :push push))) 420 (defmethod get-opt ((self rdb) key) 421 (with-slots (opts) self 424 (defmethod push-opts ((self rdb)) 425 (with-slots (opts) self 428 (defmethod open-db ((self rdb)) 429 (with-slots (name db opts) self 431 (rdb-error "DB already opened - close before re-opening") 432 (setf db (open-db-raw name (rdb-opts-sap opts)))))) 434 (defmethod get-prop ((self rdb) (propname string)) 435 (unless-null-db () self 436 (get-property-raw db propname))) 438 (defmethod repair-db ((self rdb) &key) 439 (repair-db-raw (rdb-name self))) 441 (defmethod open-backup-db ((self rdb) &key path) 442 (with-slots (opts) self 443 (setf (rdb-backup self) (open-backup-engine-raw path (rdb-opts-sap opts))))) 445 (defmethod close-backup-db ((self rdb)) 446 (with-slots (backup) self 447 (unless (null backup) 448 (setf backup (close-backup-engine-raw backup))))) 450 (defmethod backup-db ((self rdb) &key path) 451 (unless-null-db (opts backup) self 454 (error 'open-backup-engine-error :db db) 455 (open-backup-db self :path path))) 456 (create-new-backup-raw backup db))) 458 (defmethod restore-db ((self rdb) (from string) &key id opts) 459 (unless-null-db (name backup) self 461 (open-backup-db self :path from)) 462 (restore-from-backup-raw backup name from id opts))) 464 (defmethod snapshot-db ((self rdb)) 465 (unless-null-db (snapshots) self 466 (vector-push-extend (create-snapshot-raw db) snapshots))) 468 (defmethod get-metadata ((self rdb) &optional cf) 469 (make-rdb-cf-metadata :sap (get-metadata-raw (rdb-db self) cf))) 471 (defmethod get-stats ((self rdb) &optional (htype (rocksdb-statistics-level "all"))) 472 (make-rdb-stats (get-stats-raw (rdb-opts-sap (rdb-opts self)) htype))) 474 (defmethod create-iter ((self rdb) &optional cf (opts (rocksdb-readoptions-create))) 476 (setf cf (etypecase cf 477 (rdb-cf (rdb-cf-sap cf)) 478 (string (rdb-cf-sap (find-cf cf self))) 480 (unless-null-db () self 481 (make-instance 'rdb-iter :sap (if cf 482 (create-cf-iter-raw db cf opts) 483 (create-iter-raw db opts))))) 485 (defmethod print-stats ((self rdb) &optional stream) 486 (print (rocksdb-options-statistics-get-string (rdb-opts-sap (rdb-opts self))) stream)) 488 (defmethod flush-db ((self rdb) &key) ;; todo flushopts 489 (flush-db-raw (rdb-db self))) 491 (defmethod sync-db ((self rdb) (other null) &key) 494 (defmethod shutdown-db ((self rdb) &key wait) 495 (log:trace! "shutting down database" (rdb-name self)) 496 (when-let ((db (rdb-db self))) 497 (rocksdb-cancel-all-background-work db wait) 500 (defmethod create-cfs ((self rdb) &key &allow-other-keys) 501 (if (null (rdb-db self)) 502 (warn 'db-missing :message "ignoring attempt to create column-families before opening") 503 (loop for cf across (rdb-cfs self) 504 do (create-cf self cf)))) 506 (defmethod find-cf ((cf string) (self rdb) &key) 508 (find cf (rdb-cfs self) :key 'rdb-cf-name :test 'equal)) 510 (defmethod ingest-db ((self rdb) (files list) &key cf (opts (rocksdb-ingestexternalfileoptions-create))) 512 (ingest-db-cf-raw (rdb-db self) (find-cf cf self) files opts) 513 (ingest-db-raw (rdb-db self) files opts))) 515 (defmethod destroy-cfs ((self rdb) &key &allow-other-keys) 516 (with-slots (cfs) self 517 (declare (type (array rdb-cf) cfs)) 518 (loop for cf across cfs 519 do (setf cf (destroy-cf cf))))) 521 (defmethod close-db ((self rdb) &key &allow-other-keys) 522 (with-slots (db cfs backup snapshots) self 523 (close-backup-db self) 524 (unless (zerop (length snapshots)) 525 (loop for s across snapshots do (release-snapshot-raw db s))) 528 (setf db (close-db-raw db))))) 530 (defmethod destroy-db ((self rdb)) 531 ;; close all handles before destruction ensues 533 (destroy-db-raw (rdb-name self))) 535 (defmethod put-key ((self rdb) (key t) (val t)) 541 (defmethod put-key ((self rdb) (key string) (val string)) 544 (sb-ext:string-to-octets key) 545 (sb-ext:string-to-octets val))) 547 (defmethod put-kv ((self rdb) (kv rdb-kv)) 553 (defmethod insert-key ((self rdb) key val &key cf) 554 (if-let ((cf (and cf (find-cf cf self)))) 555 (if-let ((sap (rdb-cf-sap cf))) 561 (rocksdb-writeoptions-create)) 562 (rdb-error "column-family is not open")) 563 (put-key self key val))) 565 (defmethod insert-key ((self rdb) (key string) (val string) &key cf) 566 (insert-key self (string-to-octets key) (string-to-octets val) :cf cf)) 568 (defmethod insert-key ((self rdb) (key string) val &key cf) 569 (insert-key self (string-to-octets key) val :cf cf)) 571 (defmethod insert-key ((self rdb) key (val string) &key cf) 572 (insert-key self key (string-to-octets val) :cf cf)) 574 (defmethod insert-kv ((self rdb) (kv rdb-kv) &key cf (opts (rocksdb-writeoptions-create))) 576 (let ((cf (etypecase cf 578 (t (find cf (rdb-cfs self) 581 (put-cf-raw (rdb-db self) 588 (defmethod get-key ((self rdb) (key string) &key (opts (rocksdb-readoptions-create)) cf) 589 (with-slots (db) self 591 (get-cf-str-raw db (rdb-cf-sap (find-cf cf self)) key opts) 592 (get-kv-str-raw db key opts)))) 594 (defmethod get-key ((self rdb) key &key (opts (rocksdb-readoptions-create)) cf) 595 (with-slots (db) self 597 (get-cf-raw db (rdb-cf-sap (find-cf cf self)) key opts) 598 (get-kv-raw db key opts))))