Mercurial > core / lisp/lib/rdb/obj.lisp
changeset 680: |
5f88b237ce29 |
parent: |
12287fab15d0
|
author: |
Richard Westhaver <ellis@rwest.io> |
date: |
Fri, 27 Sep 2024 20:19:10 -0400 |
permissions: |
-rw-r--r-- |
description: |
added skc, fixed alien c-string functions, upgrades and fixes for rocksdb/rdb |
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 :initform nil :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 sap) (%table table)) self 33 ;; initialize slots - remember, initargs doesn't refer to slot 34 ;; names, they're opt names. 35 (setf %table (or (cdr (remprop 'initargs :table)) (make-hash-table :test 'equal)) 36 %sap (or (cdr (remprop 'initargs :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 (defun make-rdb-opts* (alien) 51 "Coerce ALIEN into an RDB-OPTS struct. This function doesn't populate the 52 values in Lisp, just binds the sap." 53 (make-instance 'rdb-opts :sap alien)) 55 (defmethod get-opt ((self rdb-opts) key) 56 "Return the current value of KEY in SELF if found, else return nil." 57 (gethash key (rdb-opts-table self))) 59 (defmethod set-opt ((self rdb-opts) key val &key push) 60 "Set the VAL of KEY in SELF with '(setf (gethash SELF KEY) VAL)'." 62 (setf (gethash key (rdb-opts-table self)) val) 63 (when push (push-sap self key)))) 65 (defmethod push-sap ((self rdb-opts) key) 66 "Push KEY from slot :TABLE to the instance :SAP." 67 (%set-rocksdb-option (rdb-opts-sap self) key (get-opt self key))) 69 (defmethod push-sap* ((self rdb-opts)) 70 "Initialized the SAP slot with values from TABLE." 71 (with-slots (table) self 72 (loop for k in (hash-table-keys table) 73 ;; note how we don't handle any special cases here - we can 74 ;; always set an opt but sometimes we can't get it. 75 do (push-sap self k)))) 77 (defmethod pull-sap ((self rdb-opts) key) 78 (setf (gethash key (rdb-opts-table self)) (%get-rocksdb-option (rdb-opts-sap self) key))) 80 (defmethod pull-sap* ((self rdb-opts)) 81 (with-slots (table) self 82 (loop for k in (hash-table-keys table) 83 unless (opt-no-setter-p k) 87 (defmethod backfill-opts ((self rdb-opts) &key full) 88 "Backfill the TABLE slot with values from SAP. 90 When FULL is non-nil, retrieve the full set of options available, not 91 just the keys currently present in TABLE." 93 (loop for k across *rocksdb-options* 94 unless (opt-no-setter-p k) 97 (rdb-opts-table self)) 99 (defun default-rdb-opts () 100 (make-rdb-opts :create-if-missing t :create-missing-column-families t 101 :parallelism (num-cpus))) 104 ((key :initarg :key :type octet-vector :accessor rdb-key) 105 (val :initarg :val :type octet-vector :accessor rdb-val))) 107 (defmethod make-kv (key val) 108 (make-instance 'rdb-kv 110 :val (make-val val))) 112 (defvar *default-rdb-kv* (make-kv #() #())) 115 (defclass rdb-iter (sequence) 116 ((sap :initform nil :initarg :sap :type (or null alien) :accessor rdb-iter-sap))) 118 (defmethod iter-valid-p ((self rdb-iter)) 119 (rocksdb-iter-valid (rdb-iter-sap self))) 121 (defmethod iter-seek-to-first ((self rdb-iter)) 122 (rocksdb-iter-seek-to-first (rdb-iter-sap self))) 124 (defmethod iter-seek-to-last ((self rdb-iter)) 125 (rocksdb-iter-seek-to-last (rdb-iter-sap self))) 127 (defmethod iter-seek-for-prev ((self rdb-iter) (key vector) &key) 128 (rocksdb-iter-seek-for-prev (rdb-iter-sap self) key (length key))) 130 (defmethod iter-seek ((self rdb-iter) (key simple-vector) &key) 131 (rocksdb-iter-seek (rdb-iter-sap self) key (length key))) 133 (defmethod iter-next ((self rdb-iter)) 134 (rocksdb-iter-next (rdb-iter-sap self))) 136 (defmethod iter-prev ((self rdb-iter)) 137 (rocksdb-iter-prev (rdb-iter-sap self))) 139 (defmethod iter-key ((self rdb-iter)) 140 (with-alien ((klen size-t)) 141 (let ((key (rocksdb-iter-key (rdb-iter-sap self) (addr klen)))) 142 (let ((k (make-array klen :element-type 'octet))) 143 (clone-octets-from-alien key k klen) 148 (defmethod iter-val ((self rdb-iter)) 149 (with-alien ((vlen size-t)) 150 (let ((val (rocksdb-iter-value (rdb-iter-sap self) (addr vlen)))) 151 (let ((v (make-array vlen :element-type 'octet))) 152 (clone-octets-from-alien val v vlen) 157 (defmethod iter-kv ((self rdb-iter)) 158 (make-kv (iter-key self) (iter-val self))) 160 (defmethod iter-timestamp ((self rdb-iter)) 161 (with-alien ((tslen size-t)) 163 (rocksdb-iter-timestamp (rdb-iter-sap self) (addr tslen)) 167 (defstruct (rdb-cf (:constructor make-rdb-cf (name &key opts key-type val-type sap))) 168 "RDB Column Family structure. Contains a name, key-type, val-type, 169 and a system-area-pointer to the underlying rocksdb_cf_t handle. 171 A NIL key-type or val-type indicates an unitialized value which defaults to 172 'octet-vector. This is needed to distinguish the value 'octet-vector being 173 supplied by the user from the default value." 174 (name "" :type string) 175 (opts (default-rdb-opts) :type rdb-opts) 176 (key-type nil :type (or list symbol)) 177 (val-type nil :type (or list symbol)) 178 (sap nil :type (or null alien))) 180 (defmethod close-cf ((self rdb-cf) &optional error) 181 (if-let ((sap (rdb-cf-sap self))) 182 (setf (rdb-cf-sap self) (rocksdb:rocksdb-column-family-handle-destroy sap)) 183 (when error (rdb-error "column family is already closed.")))) 186 (defstruct (rdb-stats (:constructor make-rdb-stats (&optional sap))) 187 (sap nil :type (or null alien))) 190 (defstruct rdb-cf-metadata 191 (name "default" :type string) 192 (size 0 :type fixnum) 193 (level-count 7 :type fixnum) 194 (file-count 0 :type fixnum) 195 (sap nil :type (or null alien))) 197 (defmethod get-metadata ((self rdb-cf-metadata) &optional (level 0)) 198 (with-slots (sap) self 200 (warn 'metadata-missing :message "ignoring attempt to pull fields from null sap.") 201 (make-rdb-level-metadata :sap (rocksdb-column-family-metadata-get-level-metadata sap level))))) 203 (defmethod print-object ((self rdb-cf-metadata) stream) 204 (print-unreadable-object (self stream :type t) 205 (with-slots (name size level-count file-count) self 206 (format stream "~A :size ~A :levels ~A :files ~A" name size level-count file-count)))) 208 (defmethod pull-sap* ((self rdb-cf-metadata)) 209 (with-slots (name size level-count file-count sap) self 211 (warn 'metadata-missing :message "ignoring attempt to pull fields from null sap.") 212 (setf name (rocksdb-column-family-metadata-get-name sap) 213 size (rocksdb-column-family-metadata-get-size sap) 214 level-count (rocksdb-column-family-metadata-get-level-count sap) 215 file-count (rocksdb-column-family-metadata-get-file-count sap))) 218 (defstruct rdb-level-metadata 219 (level 0 :type fixnum) 220 (size 0 :type fixnum) 221 (file-count 0 :type fixnum) 222 (sap nil :type (or null alien))) 224 (defmethod get-metadata ((self rdb-level-metadata) &optional (file 0)) 225 (with-slots (sap) self 227 (warn 'metadata-missing :message "ignoring attempt to pull fields from null sap.") 228 (make-rdb-sst-file-metadata :sap (rocksdb-level-metadata-get-sst-file-metadata sap file))))) 230 (defmethod print-object ((self rdb-level-metadata) stream) 231 (print-unreadable-object (self stream :type t) 232 (with-slots (level size file-count) self 233 (format stream "~A :size ~A :files ~A" level size file-count)))) 235 (defmethod pull-sap* ((self rdb-level-metadata)) 236 (with-slots (level size file-count sap) self 238 (warn 'metadata-missing :message "ignoring attempt to pull fields from null sap.") 239 (setf level (rocksdb-level-metadata-get-level sap) 240 size (rocksdb-level-metadata-get-size sap) 241 file-count (rocksdb-level-metadata-get-file-count sap))) 244 ;; NOTE: we only store the sizes of largest and smallest key, not the 245 ;; keys themselves. This may change in the future. 246 (defstruct rdb-sst-file-metadata 247 (relative-filename "" :type string) 248 (directory "" :type string) 249 (size 0 :type fixnum) 250 (smallestkey 0 :type fixnum) 251 (largestkey 0 :type fixnum) 252 (sap nil :type (or null alien))) 254 (defmethod print-object ((self rdb-sst-file-metadata) stream) 255 (print-unreadable-object (self stream :type t) 256 (with-slots (relative-filename directory size smallestkey largestkey) self 257 (format stream "~A :dir ~A :size ~A :smallest ~A :largest ~A" 258 relative-filename directory size smallestkey largestkey)))) 260 (defmethod pull-sap* ((self rdb-sst-file-metadata)) 261 (with-slots (relative-filename directory size smallestkey largestkey sap) self 263 (warn 'metadata-missing :message "ignoring attempt to pull fields from null sap.") 264 (with-alien ((ssize size-t 0) 266 (rocksdb-sst-file-metadata-get-largestkey sap (addr lsize)) 267 (rocksdb-sst-file-metadata-get-smallestkey sap (addr ssize)) 268 (setf relative-filename (rocksdb-sst-file-metadata-get-relative-filename sap) 269 directory (rocksdb-sst-file-metadata-get-directory sap) 270 size (rocksdb-sst-file-metadata-get-size sap) 276 (defstruct (rdb (:constructor make-rdb (name opts &optional cfs db))) 277 (name "" :type string) 278 (opts (default-rdb-opts) :type rdb-opts) 279 (cfs (make-array 0 :element-type 'rdb-cf :adjustable t :fill-pointer 0) :type (vector rdb-cf)) 280 (db nil :type (or null alien)) 281 (backup nil :type (or null alien)) 282 (snapshots #() :type (array alien))) 284 (defvar *default-rdb-opts* (default-rdb-opts)) 286 (defmethod print-object ((self rdb) stream) 287 (print-unreadable-object (self stream :type t :identity t) 288 (format stream ":cfs ~A :open ~A" (length (rdb-cfs self)) (db-open-p self)))) 290 (defmethod db ((self rdb)) 293 (defmethod db-open-p ((self rdb)) 296 (defmethod db-closed-p ((self rdb)) 297 (unless (db self) t)) 299 (defun translate-cf-to-field (cf) 300 (let ((vt (or (rdb-cf-val-type cf) 'octet-vector)) 301 (kt (unless (rdb-cf-val-type cf) (or (rdb-cf-key-type cf) 'octet-vector)))) 302 (make-field :name (rdb-cf-name cf) 307 (defmethod load-field ((self rdb-cf) (field field)) 308 (let ((type (field-type field))) 310 ;; note that this means you can't use LOAD-SCHEMA to reset an 311 ;; rdb schema as you may expect. 313 (atom (setf (rdb-cf-val-type self) type)) 314 (list (setf (rdb-cf-key-type self) (car type) 315 (rdb-cf-val-type self) 316 (if (and (listp (cdr type)) 317 (= 1 (length (cdr type)))) 322 (defmethod load-schema ((self rdb) (schema schema)) 323 "Load SCHEMA into rdb database object SELF. This will add any missing rdb-cfs 324 and update existing key/value types for cfs with the same name. Existing cfs 325 only get their their type slots updated on non-nil values." 326 (loop for field across (fields schema) 327 do (if-let ((cf (find-cf (field-name field) self))) 328 (load-field cf field) 330 (load-field (make-rdb-cf (field-name field)) field) 334 (defmethod derive-schema ((self rdb)) 336 (loop for cf across (rdb-cfs self) 337 collect (translate-cf-to-field cf)))) 339 (defun create-db (name &key opts cfs schema open) 340 "Construct a new RDB instance from NAME. 343 CFS = (sequence rdb-cf) 347 CFS are always added before the SCHEMA which is loaded with LOAD-SCHEMA. 349 When OPEN is non-nil, the database and all column families are opened and 350 internal sap slots are initialized." 351 ;; (when (probe-file name) (log:trace! "db exists: " name)) 352 (let* ((opts (or opts (default-rdb-opts))) 355 (string-right-trim '(#\/) 357 (pathname (namestring name)) 359 (t (error "invalid NAME: ~S" name)))) 363 (list (coerce cfs 'vector)) 365 (rdb-cf (vector cfs)) 366 (t (log:warn! "invalid CF passed to create-db")))) 367 (make-array 0 :element-type 'rdb-cf :fill-pointer 0))))) 369 (load-schema obj schema)) 374 (defmethod backfill-opts ((self rdb) &key full) 375 (with-slots (opts) self 377 (loop for k across *rocksdb-options* 378 unless (opt-no-setter-p k) 379 do (pull-sap opts k)) 381 (rdb-opts-table opts))) 383 (defmethod push-cf ((cf rdb-cf) (db rdb)) 384 (vector-push-extend cf (rdb-cfs db))) 386 (defmethod create-cf ((db rdb) (cf rdb-cf)) 387 (create-cf-raw (rdb-db db) (rdb-cf-name cf) (rdb-opts-sap (rdb-opts db)))) 389 (defmethod open-cfs ((db rdb) &rest names) 390 (let ((cf-names) (cf-opts)) 391 (loop for cf across (rdb-cfs db) 392 do (let ((name (rdb-cf-name cf))) 393 (when (or (not names) (member name names :test 'string=)) 395 (push (rdb-opts-sap (rdb-cf-opts cf)) cf-opts))) 397 (setf cf-names (nreverse cf-names) 398 cf-opts (nreverse cf-opts))) 399 (multiple-value-bind (db-sap cfs) (open-cfs-raw (rdb-opts db) (rdb-name db) cf-names cf-opts) 400 (setf (rdb-db db) db-sap) 401 (loop for cf across (rdb-cfs db) 403 do (setf (rdb-cf-sap cf) (deref cfs i)) 407 (defmethod close-cfs ((self rdb)) 408 (loop for cf across (rdb-cfs self) 411 (defmacro unless-null-db (slots self &body body) 412 `(with-slots (db ,@slots) ,self 416 (defmethod destroy-cf ((cf rdb-cf)) 419 (setf sap (destroy-cf-raw sap))))) 421 (defmethod set-opt ((self rdb) key val &key push) 422 (with-slots (opts) self 423 (set-opt opts key val :push push))) 425 (defmethod get-opt ((self rdb) key) 426 (with-slots (opts) self 429 (defmethod push-opts ((self rdb)) 430 (with-slots (opts) self 433 (defmethod open-db ((self rdb)) 434 (with-slots (name db opts) self 436 (rdb-error "DB already opened - close before re-opening") 437 (setf db (open-db-raw name (rdb-opts-sap opts)))))) 439 (defmethod get-prop ((self rdb) (propname string)) 440 (unless-null-db () self 441 (get-property-raw db propname))) 443 (defmethod repair-db ((self rdb) &key) 444 (repair-db-raw (rdb-name self))) 446 (defmethod open-backup-db ((self rdb) &key path) 447 (with-slots (opts) self 448 (setf (rdb-backup self) (open-backup-engine-raw path (rdb-opts-sap opts))))) 450 (defmethod close-backup-db ((self rdb)) 451 (with-slots (backup) self 452 (unless (null backup) 453 (setf backup (close-backup-engine-raw backup))))) 455 (defmethod backup-db ((self rdb) &key path) 456 (unless-null-db (opts backup) self 459 (error 'open-backup-engine-error :db db) 460 (open-backup-db self :path path))) 461 (create-new-backup-raw backup db))) 463 (defmethod restore-db ((self rdb) (from string) &key id opts) 464 (unless-null-db (name backup) self 466 (open-backup-db self :path from)) 467 (restore-from-backup-raw backup name from id opts))) 469 (defmethod snapshot-db ((self rdb)) 470 (unless-null-db (snapshots) self 471 (vector-push-extend (create-snapshot-raw db) snapshots))) 473 (defmethod get-metadata ((self rdb) &optional cf) 474 (make-rdb-cf-metadata :sap (get-metadata-raw (rdb-db self) cf))) 476 (defmethod get-stats ((self rdb) &optional (htype (rocksdb-statistics-level "all"))) 477 (make-rdb-stats (get-stats-raw (rdb-opts-sap (rdb-opts self)) htype))) 479 (defmethod create-iter ((self rdb) &optional cf (opts (rocksdb-readoptions-create))) 481 (setf cf (etypecase cf 482 (rdb-cf (rdb-cf-sap cf)) 483 (string (rdb-cf-sap (find-cf cf self))) 485 (unless-null-db () self 486 (make-instance 'rdb-iter :sap (if cf 487 (create-cf-iter-raw db cf opts) 488 (create-iter-raw db opts))))) 490 (defmethod print-stats ((self rdb) &optional stream) 491 (print (rocksdb-options-statistics-get-string (rdb-opts-sap (rdb-opts self))) stream)) 493 (defmethod flush-db ((self rdb) &key) ;; todo flushopts 494 (flush-db-raw (rdb-db self))) 496 (defmethod sync-db ((self rdb) (other null) &key) 499 (defmethod shutdown-db ((self rdb) &key wait) 500 (log:trace! "shutting down database" (rdb-name self)) 501 (when-let ((db (rdb-db self))) 502 (rocksdb-cancel-all-background-work db wait) 505 (defmethod create-cfs ((self rdb) &key &allow-other-keys) 506 (if (null (rdb-db self)) 507 (warn 'db-missing :message "ignoring attempt to create column-families before opening") 508 (loop for cf across (rdb-cfs self) 509 do (create-cf self cf)))) 511 (defmethod find-cf ((cf string) (self rdb) &key) 513 (find cf (rdb-cfs self) :key 'rdb-cf-name :test 'equal)) 515 (defmethod ingest-db ((self rdb) (files list) &key cf (opts (rocksdb-ingestexternalfileoptions-create))) 517 (ingest-db-cf-raw (rdb-db self) (find-cf cf self) files opts) 518 (ingest-db-raw (rdb-db self) files opts))) 520 (defmethod destroy-cfs ((self rdb) &key &allow-other-keys) 521 (with-slots (cfs) self 522 (declare (type (array rdb-cf) cfs)) 523 (loop for cf across cfs 524 do (setf cf (destroy-cf cf))))) 526 (defmethod close-db ((self rdb) &key &allow-other-keys) 527 (with-slots (db cfs backup snapshots) self 528 (close-backup-db self) 529 (unless (zerop (length snapshots)) 530 (loop for s across snapshots do (release-snapshot-raw db s))) 533 (setf db (close-db-raw db))))) 535 (defmethod destroy-db ((self rdb)) 536 ;; close all handles before destruction ensues 538 (destroy-db-raw (rdb-name self))) 540 (defmethod put-key ((self rdb) (key t) (val t)) 546 (defmethod put-key ((self rdb) (key string) (val string)) 549 (sb-ext:string-to-octets key) 550 (sb-ext:string-to-octets val))) 552 (defmethod put-kv ((self rdb) (kv rdb-kv)) 558 (defmethod insert-key ((self rdb) key val &key cf) 559 (if-let ((cf (and cf (find-cf cf self)))) 560 (if-let ((sap (rdb-cf-sap cf))) 566 (rocksdb-writeoptions-create)) 567 (rdb-error "column-family is not open")) 568 (put-key self key val))) 570 (defmethod insert-key ((self rdb) (key string) (val string) &key cf) 571 (insert-key self (string-to-octets key) (string-to-octets val) :cf cf)) 573 (defmethod insert-key ((self rdb) (key string) val &key cf) 574 (insert-key self (string-to-octets key) val :cf cf)) 576 (defmethod insert-key ((self rdb) key (val string) &key cf) 577 (insert-key self key (string-to-octets val) :cf cf)) 579 (defmethod insert-kv ((self rdb) (kv rdb-kv) &key cf (opts (rocksdb-writeoptions-create))) 581 (let ((cf (etypecase cf 583 (t (find cf (rdb-cfs self) 586 (put-cf-raw (rdb-db self) 593 (defmethod get-key ((self rdb) (key string) &key (opts (rocksdb-readoptions-create)) cf) 594 (with-slots (db) self 596 (get-cf-str-raw db (rdb-cf-sap (find-cf cf self)) key opts) 597 (get-kv-str-raw db key opts)))) 599 (defmethod get-key ((self rdb) key &key (opts (rocksdb-readoptions-create)) cf) 600 (with-slots (db) self 602 (get-cf-raw db (rdb-cf-sap (find-cf cf self)) key opts) 603 (get-kv-raw db key opts))))