Mercurial > core / lisp/lib/rdb/obj.lisp
changeset 678: |
2b7d5a8d63ac |
parent: |
97dd03beda03
|
child: |
12287fab15d0 |
author: |
Richard Westhaver <ellis@rwest.io> |
date: |
Wed, 25 Sep 2024 21:39:39 -0400 |
permissions: |
-rw-r--r-- |
description: |
alien octets fix, workin with org-graph-db |
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 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 (key-type nil :type (or list symbol)) 171 (val-type nil :type (or list symbol)) 172 (sap nil :type (or null alien))) 174 (defmethod close-cf ((self rdb-cf) &optional error) 175 (if-let ((sap (rdb-cf-sap self))) 176 (setf (rdb-cf-sap self) (rocksdb:rocksdb-column-family-handle-destroy sap)) 177 (when error (rdb-error "column family is already closed.")))) 180 (defstruct (rdb-stats (:constructor make-rdb-stats (&optional sap))) 181 (sap nil :type (or null alien))) 184 (defstruct rdb-cf-metadata 185 (name "default" :type string) 186 (size 0 :type fixnum) 187 (level-count 7 :type fixnum) 188 (file-count 0 :type fixnum) 189 (sap nil :type (or null alien))) 191 (defmethod get-metadata ((self rdb-cf-metadata) &optional (level 0)) 192 (with-slots (sap) self 194 (warn 'metadata-missing :message "ignoring attempt to pull fields from null sap.") 195 (make-rdb-level-metadata :sap (rocksdb-column-family-metadata-get-level-metadata sap level))))) 197 (defmethod print-object ((self rdb-cf-metadata) stream) 198 (print-unreadable-object (self stream :type t) 199 (with-slots (name size level-count file-count) self 200 (format stream "~A :size ~A :levels ~A :files ~A" name size level-count file-count)))) 202 (defmethod pull-sap* ((self rdb-cf-metadata)) 203 (with-slots (name size level-count file-count sap) self 205 (warn 'metadata-missing :message "ignoring attempt to pull fields from null sap.") 206 (setf name (rocksdb-column-family-metadata-get-name sap) 207 size (rocksdb-column-family-metadata-get-size sap) 208 level-count (rocksdb-column-family-metadata-get-level-count sap) 209 file-count (rocksdb-column-family-metadata-get-file-count sap))) 212 (defstruct rdb-level-metadata 213 (level 0 :type fixnum) 214 (size 0 :type fixnum) 215 (file-count 0 :type fixnum) 216 (sap nil :type (or null alien))) 218 (defmethod get-metadata ((self rdb-level-metadata) &optional (file 0)) 219 (with-slots (sap) self 221 (warn 'metadata-missing :message "ignoring attempt to pull fields from null sap.") 222 (make-rdb-sst-file-metadata :sap (rocksdb-level-metadata-get-sst-file-metadata sap file))))) 224 (defmethod print-object ((self rdb-level-metadata) stream) 225 (print-unreadable-object (self stream :type t) 226 (with-slots (level size file-count) self 227 (format stream "~A :size ~A :files ~A" level size file-count)))) 229 (defmethod pull-sap* ((self rdb-level-metadata)) 230 (with-slots (level size file-count sap) self 232 (warn 'metadata-missing :message "ignoring attempt to pull fields from null sap.") 233 (setf level (rocksdb-level-metadata-get-level sap) 234 size (rocksdb-level-metadata-get-size sap) 235 file-count (rocksdb-level-metadata-get-file-count sap))) 238 ;; NOTE: we only store the sizes of largest and smallest key, not the 239 ;; keys themselves. This may change in the future. 240 (defstruct rdb-sst-file-metadata 241 (relative-filename "" :type string) 242 (directory "" :type string) 243 (size 0 :type fixnum) 244 (smallestkey 0 :type fixnum) 245 (largestkey 0 :type fixnum) 246 (sap nil :type (or null alien))) 248 (defmethod print-object ((self rdb-sst-file-metadata) stream) 249 (print-unreadable-object (self stream :type t) 250 (with-slots (relative-filename directory size smallestkey largestkey) self 251 (format stream "~A :dir ~A :size ~A :smallest ~A :largest ~A" 252 relative-filename directory size smallestkey largestkey)))) 254 (defmethod pull-sap* ((self rdb-sst-file-metadata)) 255 (with-slots (relative-filename directory size smallestkey largestkey sap) self 257 (warn 'metadata-missing :message "ignoring attempt to pull fields from null sap.") 258 (with-alien ((ssize size-t 0) 260 (rocksdb-sst-file-metadata-get-largestkey sap (addr lsize)) 261 (rocksdb-sst-file-metadata-get-smallestkey sap (addr ssize)) 262 (setf relative-filename (rocksdb-sst-file-metadata-get-relative-filename sap) 263 directory (rocksdb-sst-file-metadata-get-directory sap) 264 size (rocksdb-sst-file-metadata-get-size sap) 270 (defstruct (rdb (:constructor make-rdb (name opts &optional cfs db))) 271 (name "" :type string) 272 (opts (default-rdb-opts) :type rdb-opts) 273 (cfs (make-array 0 :element-type 'rdb-cf :adjustable t :fill-pointer 0) :type (vector rdb-cf)) 274 (db nil :type (or null alien)) 275 (backup nil :type (or null alien)) 276 (snapshots #() :type (array alien))) 278 (defvar *default-rdb-opts* (default-rdb-opts)) 280 (defmethod print-object ((self rdb) stream) 281 (print-unreadable-object (self stream :type t :identity t) 282 (format stream ":cfs ~A :open ~A" (length (rdb-cfs self)) (db-open-p self)))) 284 (defmethod db ((self rdb)) 287 (defmethod db-open-p ((self rdb)) 290 (defmethod db-closed-p ((self rdb)) 291 (unless (db self) t)) 293 (defun translate-cf-to-field (cf) 294 (let ((vt (or (rdb-cf-val-type cf) 'octet-vector)) 295 (kt (unless (rdb-cf-val-type cf) (or (rdb-cf-key-type cf) 'octet-vector)))) 296 (make-field :name (rdb-cf-name cf) 301 (defmethod load-field ((self rdb-cf) (field field)) 302 (let ((type (field-type field))) 304 ;; note that this means you can't use LOAD-SCHEMA to reset an 305 ;; rdb schema as you may expect. 307 (atom (setf (rdb-cf-val-type self) type)) 308 (list (setf (rdb-cf-key-type self) (car type) 309 (rdb-cf-val-type self) 310 (if (and (listp (cdr type)) 311 (= 1 (length (cdr type)))) 316 (defmethod load-schema ((self rdb) (schema schema)) 317 "Load SCHEMA into rdb database object SELF. This will add any missing rdb-cfs 318 and update existing key/value types for cfs with the same name. Existing cfs 319 only get their their type slots updated on non-nil values." 320 (loop for field across (fields schema) 321 do (if-let ((cf (find-cf (field-name field) self))) 322 (load-field cf field) 324 (load-field (make-rdb-cf (field-name field)) field) 328 (defmethod derive-schema ((self rdb)) 330 (loop for cf across (rdb-cfs self) 331 collect (translate-cf-to-field cf)))) 333 (defun create-db (name &key opts cfs schema open) 334 "Construct a new RDB instance from NAME. 337 CFS = (sequence rdb-cf) 341 CFS are always added before the SCHEMA which is loaded with LOAD-SCHEMA. 343 When OPEN is non-nil, the database and all column families are opened and 344 internal sap slots are initialized." 345 ;; (when (probe-file name) (log:trace! "db exists: " name)) 346 (let* ((opts (or opts (default-rdb-opts))) 349 (string-right-trim '(#\/) 351 (pathname (namestring name)) 353 (t (error "invalid NAME: ~S" name)))) 357 (list (coerce cfs 'vector)) 359 (rdb-cf (vector cfs)) 360 (t (log:warn! "invalid CF passed to create-db")))) 361 (make-array 0 :element-type 'rdb-cf :fill-pointer 0))))) 363 (load-schema obj schema)) 368 (defmethod backfill-opts ((self rdb) &key full) 369 (with-slots (opts) self 371 (loop for k across *rocksdb-options* 372 unless (opt-no-setter-p k) 373 do (pull-sap opts k)) 375 (rdb-opts-table opts))) 377 (defmethod push-cf ((cf rdb-cf) (db rdb)) 378 (vector-push-extend cf (rdb-cfs db))) 380 (defmethod create-cf ((db rdb) (cf rdb-cf)) 381 (create-cf-raw (rdb-db db) (rdb-cf-name cf) (rdb-opts-sap (rdb-opts db)))) 383 (defmethod open-cf ((db rdb) (cf rdb-cf) &optional error) 384 (unless (null (rdb-cf-sap cf)) 386 (rdb-error "column family is already open - close before re-opening.") 388 (setf (rdb-cf-sap cf) (open-cf-raw (rdb-db db) (default-rocksdb-options) (rdb-cf-name cf))))) 390 (defmethod open-cf ((db rdb) (cf string) &optional (error t)) 391 (if-let ((cf (find-cf cf db))) 393 (setf (rdb-cf-sap cf) (create-cf db cf))) 394 (when error (rdb-error "unable to find column-family")))) 396 (defmethod open-cfs ((self rdb)) 397 (loop for cf across (rdb-cfs self) 398 do (setf (rdb-cf-sap cf) 399 (create-cf self cf)))) 401 (defmethod close-cfs ((self rdb)) 402 (loop for cf across (rdb-cfs self) 405 (defmacro unless-null-db (slots self &body body) 406 `(with-slots (db ,@slots) ,self 410 (defmethod destroy-cf ((cf rdb-cf)) 413 (setf sap (destroy-cf-raw sap))))) 415 (defmethod set-opt ((self rdb) key val &key push) 416 (with-slots (opts) self 417 (set-opt opts key val :push push))) 419 (defmethod get-opt ((self rdb) key) 420 (with-slots (opts) self 423 (defmethod push-opts ((self rdb)) 424 (with-slots (opts) self 427 (defmethod open-db ((self rdb)) 428 (with-slots (name db opts) self 430 (rdb-error "DB already opened - close before re-opening") 431 (setf db (open-db-raw name (rdb-opts-sap opts)))))) 433 (defmethod get-prop ((self rdb) (propname string)) 434 (unless-null-db () self 435 (get-property-raw db propname))) 437 (defmethod repair-db ((self rdb) &key) 438 (repair-db-raw (rdb-name self))) 440 (defmethod open-backup-db ((self rdb) &key path) 441 (with-slots (opts) self 442 (setf (rdb-backup self) (open-backup-engine-raw path (rdb-opts-sap opts))))) 444 (defmethod close-backup-db ((self rdb)) 445 (with-slots (backup) self 446 (unless (null backup) 447 (setf backup (close-backup-engine-raw backup))))) 449 (defmethod backup-db ((self rdb) &key path) 450 (unless-null-db (opts backup) self 453 (error 'open-backup-engine-error :db db) 454 (open-backup-db self :path path))) 455 (create-new-backup-raw backup db))) 457 (defmethod restore-db ((self rdb) (from string) &key id opts) 458 (unless-null-db (name backup) self 460 (open-backup-db self :path from)) 461 (restore-from-backup-raw backup name from id opts))) 463 (defmethod snapshot-db ((self rdb)) 464 (unless-null-db (snapshots) self 465 (vector-push-extend (create-snapshot-raw db) snapshots))) 467 (defmethod get-metadata ((self rdb) &optional cf) 468 (make-rdb-cf-metadata :sap (get-metadata-raw (rdb-db self) cf))) 470 (defmethod get-stats ((self rdb) &optional (htype (rocksdb-statistics-level "all"))) 471 (make-rdb-stats (get-stats-raw (rdb-opts-sap (rdb-opts self)) htype))) 473 (defmethod create-iter ((self rdb) &optional cf (opts (rocksdb-readoptions-create))) 475 (setf cf (etypecase cf 476 (rdb-cf (rdb-cf-sap cf)) 477 (string (rdb-cf-sap (find-cf cf self))) 479 (unless-null-db () self 480 (make-instance 'rdb-iter :sap (if cf 481 (create-cf-iter-raw db cf opts) 482 (create-iter-raw db opts))))) 484 (defmethod print-stats ((self rdb) &optional stream) 485 (print (rocksdb-options-statistics-get-string (rdb-opts-sap (rdb-opts self))) stream)) 487 (defmethod flush-db ((self rdb) &key) ;; todo flushopts 488 (flush-db-raw (rdb-db self))) 490 (defmethod sync-db ((self rdb) (other null) &key) 493 (defmethod shutdown-db ((self rdb) &key wait) 494 (log:trace! "shutting down database" (rdb-name self)) 495 (when-let ((db (rdb-db self))) 496 (rocksdb-cancel-all-background-work db wait) 499 (defmethod create-cfs ((self rdb) &key &allow-other-keys) 500 (if (null (rdb-db self)) 501 (warn 'db-missing :message "ignoring attempt to create column-families before opening") 502 (loop for cf across (rdb-cfs self) 503 do (create-cf self cf)))) 505 (defmethod find-cf ((cf string) (self rdb) &key) 507 (find cf (rdb-cfs self) :key 'rdb-cf-name :test 'equal)) 509 (defmethod ingest-db ((self rdb) (files list) &key cf (opts (rocksdb-ingestexternalfileoptions-create))) 511 (ingest-db-cf-raw (rdb-db self) (find-cf cf self) files opts) 512 (ingest-db-raw (rdb-db self) files opts))) 514 (defmethod destroy-cfs ((self rdb) &key &allow-other-keys) 515 (with-slots (cfs) self 516 (declare (type (array rdb-cf) cfs)) 517 (loop for cf across cfs 518 do (setf cf (destroy-cf cf))))) 520 (defmethod close-db ((self rdb) &key &allow-other-keys) 521 (with-slots (db cfs backup snapshots) self 522 (close-backup-db self) 523 (unless (zerop (length snapshots)) 524 (loop for s across snapshots do (release-snapshot-raw db s))) 527 (setf db (close-db-raw db))))) 529 (defmethod destroy-db ((self rdb)) 530 ;; close all handles before destruction ensues 532 (destroy-db-raw (rdb-name self))) 534 (defmethod put-key ((self rdb) (key t) (val t)) 540 (defmethod put-key ((self rdb) (key string) (val string)) 543 (sb-ext:string-to-octets key) 544 (sb-ext:string-to-octets val))) 546 (defmethod put-kv ((self rdb) (kv rdb-kv)) 552 (defmethod insert-key ((self rdb) key val &key cf) 553 (if-let ((cf (and cf (find-cf cf self)))) 554 (if-let ((sap (rdb-cf-sap cf))) 560 (rocksdb-writeoptions-create)) 561 (rdb-error "column-family is not open")) 562 (put-key self key val))) 564 (defmethod insert-key ((self rdb) (key string) (val string) &key cf) 565 (insert-key self (string-to-octets key) (string-to-octets val) :cf cf)) 567 (defmethod insert-key ((self rdb) (key string) val &key cf) 568 (insert-key self (string-to-octets key) val :cf cf)) 570 (defmethod insert-key ((self rdb) key (val string) &key cf) 571 (insert-key self key (string-to-octets val) :cf cf)) 573 (defmethod insert-kv ((self rdb) (kv rdb-kv) &key cf (opts (rocksdb-writeoptions-create))) 575 (let ((cf (etypecase cf 577 (t (find cf (rdb-cfs self) 580 (put-cf-raw (rdb-db self) 587 (defmethod get-key ((self rdb) (key string) &key (opts (rocksdb-readoptions-create)) cf) 588 (with-slots (db) self 590 (get-cf-str-raw db (rdb-cf-sap (find-cf cf self)) key opts) 591 (get-kv-str-raw db key opts)))) 593 (defmethod get-key ((self rdb) key &key (opts (rocksdb-readoptions-create)) cf) 594 (with-slots (db) self 596 (get-cf-raw db (rdb-cf-sap (find-cf cf self)) key opts) 597 (get-kv-raw db key opts))))