Coverage report: /home/ellis/comp/core/lib/rdb/db.lisp

Kind	Covered	All	%
expression	240	1048	22.9
branch	4	24	16.7

Key

Not instrumented

Conditionalized out

Executed

Not executed

Both branches taken

One branch taken

Neither branch taken

1

;;; rdb/db.lisp --- RDB Database API

2

3

;; RocksDB Implementation of OBJ/DB protocol.

4

5

;;; Commentary:

6

7

;; The DB protocol is also partially implemented by the low-level structures

8

;; in rdb/obj.lisp.

9

10

;; It is safe to call most functions on the same underlying Alien RocksDB

11

;; object from multiple threads. Other objects such as WriteBatch and Iterator

12

;; /may/ require a Lisp-side synchronization.

13

14

;;;; Transactions:

15

16

;; RocksDB has several variations on the concept of 'transaction':

17

18

#| TransactionDB

19

When using a TransactionDB, all keys that are written are locked internally by

20

RocksDB to perform conflict detection. If a key cannot be locked, the

21

operation will return an error. When the transaction is committed, it is

22

guaranteed to succeed as long as the database is able to be written to.

23

24

A TransactionDB can be better for workloads with heavy concurrency compared to

25

an OptimisticTransactionDB. However, there is a small locking overhead when

26

TransactionDB is used. A TransactionDB will do conflict checking for all write

27

operations (Put, Delete and Merge), including writes performed outside a

28

Transaction.

29

|#

30

31

#| WriteBatch

32

33

The WriteBatch holds a sequence of edits to be made to the database - these

34

edits within the batch are applied in order when written.

35

36

Apart from its atomicity benefits, WriteBatch may also be used to speed up

37

bulk updates by placing lots of individual mutations into the same batch.

38

39

|#

40

41

#| WBWI

42

43

The WBWI (Write Batch With Index) encapsulates a WriteBatch and an Index into

44

that WriteBatch. The index in use is a Skip List. The purpose of the WBWI is

45

to sit above the DB, and offer the same basic operations as the DB,

46

i.e. Writes - Put, Delete, and Merge, and Reads - Get, and newIterator.

47

48

Write operations on the WBWI are serialized into the WriteBatch (of the WBWI)

49

rather than acting directly on the DB. The WriteBatch can later be written

50

atomically to the DB by calling db.write(wbwi).

51

52

Read operations can either be solely against the

53

WriteBatch (e.g. GetFromBatch), or they can be read-through operations. A

54

read-through operation, (e.g. GetFromBatchAndDB), first tries to read from the

55

WriteBatch, if there is no updated entry in the WriteBatch then it

56

subsequently reads from the DB.

57

58

The WBWI can be used as a component if one wishes to build Transaction

59

Semantics atop RocksDB. The WBWI by itself isolates the Write Path to a local

60

in-memory store and allows you to RYOW (Read-Your-Own-Writes) before data is

61

atomically written to the database.

62

63

It is a key component in RocksDB's Pessimistic and Optimistic Transaction

64

utility classes.

65

66

|#

67

68

;; WBWIs are ideal as a transaction building block and should be used to build

69

;; higher-level transaction objects.

70

71

;;;; Snapshots:

72

73

;; Snapshots capture a point-in-time view of a RocksDB instance at the time of

74

;; creation. Snapshots do not persist across DB sessions and are internally

75

;; stored in a linked-list.

76

77

;;;; Checkpoints:

78

79

;; Checkpoints allow us to take a snapshot of a running RocksDB instance like

80

;; Snapshots, but in a separate directory. Checkpoints persist across DB

81

;; sessions. Checkpoints can be opened read-only or as read-write and be used

82

;; for both full and incremental backups (as long as backups are on the same

83

;; device).

84

85

;;;; Backups:

86

87

;; Backups are built on top of Checkpoints.

88

89

;; Backup Engines control a single directory that can store any number of

90

;; backups. It uses a custom on-disk format as shown below.

91

92

#| directory structure

93

/tmp/rocksdb_backup/

94

├── meta

95

│ └── 1

96

├── private

97

│ └── 1

98

│ ├── CURRENT

99

│ ├── MANIFEST-000008

100

| └── OPTIONS-000009

101

└── shared_checksum

102

└── 000007_1498774076_590.sst

103

|#

104

105

;;; Code:

106

(in-package :rdb)

107

108

;;; Backend

109

(defvar *rocksdb-backend-options* '(columns temp path (open . t)

110

destroy (close . t)

111

sap merge-op comparator prefix-op logger))

112

113

;; TODO 2024-12-31: may want to have a :STORE backend-option to allow a fresh

114

;; db to be backlined to a parent store instance.

115

(defvar *rdb-backend-options* (append *rocksdb-backend-options* '(backup secondary snapshots checkpoints)))

116

117

(defvar *rdb-default-column-name* "default")

118

119

(defmethods set-database-backend-option

120

(((db rdb) (key (eql :close)) (val (eql :auto)))

121

"Arrange for SHUTDOWN-DB to be called when there are no more references to DB."

122

(sb-ext:finalize db (lambda () (shutdown-db db))))

123

(((db rdb) (key (eql :merge-op)) val)

124

"Assign a MERGE-OP to this database."

125

(setf (db-opt db :merge-operator :push t) val))

126

(((db rdb) (key (eql :comparator)) val)

127

"Assign a custom COMPARATOR to this database."

128

(setf (db-opt db :comparator :push t) val))

129

(((db rdb) (key (eql :prefix-op)) val)

130

"Assign a custom SLICETRANSFORM to this database to be used as a prefix

131

extractor."

132

(setf (db-opt db :prefix-extractor :push t) val))

133

(((db rdb) (key (eql :logger)) val)

134

(setf (db-opt db :info-log :push t) val)))

135

136

(set-database-backend :rocksdb *rocksdb-backend-options*

137

(lambda () (load-rocksdb *save-database-backend-on-load*)))

138

139

(set-database-backend :rdb *rdb-backend-options*

140

(lambda () (db::%load-database-backend :rocksdb)))

141

142

(defmethod load-opts ((db rdb) &key backfill)

143

(with-latest-options (name db) (db-opts cf-names cf-opts)

144

(let ((cfs (coerce

145

(loop for name across cf-names

146

for opt across cf-opts

147

collect

148

(let ((cf-opts (make-rdb-opts)))

149

(setf (sap cf-opts) opt)

150

                               (when (eq backfill :full) (backfill-opts cf-opts :full t))

151

(make-rdb-cf name :opts cf-opts)))

152

'vector)))

153

(setf (db-opts db) (make-rdb-opts* db-opts))

154

(when backfill (backfill-opts (db-opts db) :full (eq backfill :full)))

155

cfs)))

156

157

(defmethod make-db ((engine (eql :rocksdb)) &rest initargs &key

158

name

159

merge-op

160

prefix-op

161

logger

162

(opts (default-rdb-opts))

163

path)

164

(declare (ignore engine initargs))

165

(when merge-op

166

(set-db-opt opts :merge-operator merge-op :push t))

167

(when prefix-op

168

(set-db-opt opts :prefix-extractor prefix-op :push t))

169

(when logger

170

(set-db-opt opts :info-log logger :push t))

171

(let ((db (make-rdb

172

:name (or name (namestring path) (string-downcase (gensym "rocksdb")))

173

:opts opts)))

174

(push-opts db)

175

db))

176

177

(defmethod query-db ((db rdb) (query (eql :get)) &key key column &allow-other-keys)

178

(declare (ignore query))

179

(get-val db key :column column))

180

181

;;; Column Families

182

(defclass rdb-column-family (rdb-column)

183

((cf :initarg :cf :type rdb-cf :accessor cf))

184

(:default-initargs :cf (make-rdb-cf (symbol-name (gensym "#"))))

185

(:documentation "High-level Lisp-side RocksDB Column Family base class. Implements the COLUMN

186

protocol and contains a CF slot which contains an RDB-CF structure

187

object. (SAP CF) is the raw pointer."))

188

189

(defaccessor name ((self rdb-column-family)) (name (cf self)))

190

(defaccessor sap ((self rdb-column-family)) (sap (cf self)))

191

(defaccessor column-opts ((self rdb-column-family)) (rdb-cf-opts (cf self)))

192

193

(defun schema-from-rdb-column-families (columns)

194

"Convert a sequence of RDB-COLUMN-FAMILYs to a SCHEMA."

195

(apply 'make-schema

196

(map 'list

197

(lambda (x)

198

(make-field :name (keywordicate (name x)) :type (column-type x)))

199

columns)))

200

201

(defmethod destroy-column ((self rdb-column-family) &optional error)

202

(destroy-column (cf self) error))

203

204

(defmethod close-column ((self rdb-column-family) &optional error)

205

(close-column (cf self) error))

206

207

(defmethod load-field ((self rdb-column-family) (field field))

208

(let ((type (field-type field))

209

(ctype (column-type self)))

210

(typecase type

211

(null nil)

212

(atom (if (atom ctype)

213

(setf ctype (cons ctype type))

214

(setf (cdr ctype) type)))

215

(list (setf (car ctype) (car type)

216

(cdr ctype)

217

(if (and (listp (cdr type))

218

(= 1 (length (cdr type))))

219

(cadr type)

220

(cdr type)))))

221

self))

222

223

(defmethod change-class ((self field) (new-class (eql 'rdb-column-family)) &key)

224

(make-instance new-class :cf (make-rdb-cf (field-name self)) :type (field-type self)))

225

226

(defmethod change-class ((self rdb-cf) (new-class (eql 'rdb-column-family)) &key)

227

(make-instance new-class :cf self))

228

229

(defmethod change-class ((self column) (new-class (eql 'rdb-column-family)) &key name)

230

(let ((ret (make-instance new-class :type (column-type self))))

231

(when name (setf (name ret) name))

232

ret))

233

234

;;; Database

235

(defclass rdb-database (database)

236

((txn :initform nil :type (or null rdb-transaction-db) :initarg :txn :accessor transaction-db)

237

(backup :initform nil :type (or null rdb-backup-engine) :initarg :backup :accessor db-backup)

238

(snapshots :initform (make-array 0 :element-type 'rdb-snapshot :adjustable t)

239

:type (vector rdb-snapshot)

240

:initarg :snapshots

241

:accessor db-snapshots)

242

(checkpoints :initform (make-array 0 :element-type 'rdb-checkpoint :adjustable t)

243

:type (vector rdb-checkpoint)

244

:initarg :checkpoints

245

:accessor db-checkpoints)

246

(secondary :initform nil :type (or null rdb-secondary-db) :initarg :secondary :accessor secondary-db)

247

(columns :initarg :columns :accessor columns))

248

(:default-initargs

249

:db (make-db :rocksdb :opts (default-rdb-opts))

250

;; Note that we don't pre-populate this slot with the 'default' column

251

;; which is present on creation of a RocksDB database. Usually there isn't

252

;; much need to access this column directly as you can just access the

253

;; database directly, which will access the default column internally.

254

:columns (make-array 0 :element-type 'rdb-column-family

255

:adjustable t

256

:fill-pointer t)))

257

258

(defmethods set-database-backend-option

259

(((db rdb-database) (key (eql :close)) (val (eql :auto)))

260

"Arrange for SHUTDOWN-DB to be called when there are no more references to DB."

261

(sb-ext:finalize db (lambda () (close-db db))))

262

(((db rdb-database) (key (eql :merge-op)) val)

263

"Assign a MERGE-OP to this database."

264

(setf (db-opt db :merge-operator :push t) val))

265

(((db rdb-database) (key (eql :comparator)) val)

266

"Assign a custom COMPARATOR to this database."

267

(setf (db-opt (db db) :comparator) val))

268

(((db rdb-database) (key (eql :prefix-op)) val)

269

"Assign a custom SLICETRANSFORM to this database to be used as a prefix

270

extractor."

271

(setf (db-opt (db db) :prefix-extractor :push t) val)))

272

273

(defmethod load-opts ((self rdb-database) &key (backfill t))

274

;; order is determined by RocksDB

275

(setf (columns self)

276

(map 'vector (lambda (x) (make-instance 'rdb-column-family :cf x))

277

(load-opts (db self) :backfill backfill)))

278

self)

279

280

(defmethod repair-db ((self rdb-database) &key)

281

(repair-db (db self)))

282

283

(defmethod merge-columns ((self rdb-database) (columns vector))

284

(loop for c across columns

285

do (if-let ((found (find-column c self)))

286

(setf (aref (columns self) (position found (columns self))) c)

287

(vector-push-extend c (columns self)))))

288

289

(defmethod backfill-opts ((self rdb-database) &key)

290

(backfill-opts (db-opts self)))

291

292

(defmethod reset ((self rdb-database) &key (columns t) (opts t))

293

(when columns

294

(close-columns self)

295

(setf (columns self)

296

(make-array 0 :element-type 'rdb-column-family

297

:adjustable t

298

:fill-pointer t)))

299

(when opts

300

(setf (db-opts self) (if (eql t opts) (default-rdb-opts) opts))))

301

302

(defmethod open-column ((self rdb-database) (col string) &key)

303

(open-column (db self) (cf (find-column col self))))

304

305

(defmethod open-column ((self rdb-database) (col symbol) &key)

306

(open-column (db self) (cf (find-column (string-downcase col) self))))

307

308

(defmethod open-column ((self rdb-database) (col rdb-column-family) &key)

309

(open-column (db self) (cf col)))

310

311

(defmethod open-columns ((self rdb-database) &rest columns)

312

(dolist (c columns)

313

(open-column self c)))

314

315

(defmethod find-column ((cf string) (self rdb-database) &key)

316

(find cf (columns self) :key 'name :test 'equal))

317

318

(defmethod add-column ((cf rdb-cf) (db rdb-database))

319

(vector-push-extend (make-instance 'rdb-column-family :cf cf) (columns db)))

320

321

(defmethod open-with-columns ((db rdb-database) &rest names)

322

(let ((cols

323

(coerce

324

(if (null names)

325

(columns db)

326

(loop for n in names

327

collect (if-let ((col (find-column n db)))

328

col

329

(add-column

330

(make-instance 'rdb-column-family

331

:cf (make-rdb-cf n))

332

db))))

333

'vector)))

334

(multiple-value-bind (db-sap cfs) (open-cfs-raw (db-opts db) (name db)

335

                                                     (loop for c across cols

336

                                                           collect (name c))

337

                                                     (loop for c across cols

338

                                                           collect (sap (column-opts c))))

339

(setf (sap db) db-sap)

340

(loop for c across cfs

341

do (when-let ((col (find-column (name c) db)))

342

(setf (sap (cf col)) c)))

343

db)))

344

345

(defmethod open-columns* ((self rdb-database))

346

(let ((names) (opts))

347

(loop for c across (columns self)

348

do (push (name c) names)

349

do (push (sap (column-opts c)) opts))

350

(nreversef names)

351

(nreversef opts)

352

(unless (member *rdb-default-column-name* names :test 'string=)

353

(push *rdb-default-column-name* names)

354

(push (sap (db-opts self)) opts))

355

(multiple-value-bind (db cfs)

356

(open-cfs-raw (sap (db-opts self)) (name self) names opts)

357

(setf (sap self) db)

358

(let ((len (length names)))

359

(loop for n in names

360

for i below len

361

for cf = (deref cfs i)

362

do (when-let ((c (find-column (pop names) self)))

363

(setf (sap c) cf)))

364

self))))

365

366

(defmethod close-columns ((self rdb-database))

367

(loop for cf across (columns self)

368

;; unless (string= (name cf) *rdb-default-column-name*)

369

do (close-column cf)))

370

371

(defmethods insert-key

372

(((self rdb-database) key val &key column)

373

(if-let ((column (and column (find-column column self))))

374

(if-let ((sap (sap column)))

375

(put-cf-raw

376

(sap self)

377

sap

378

key

379

val

380

(rocksdb-writeoptions-create))

381

(rdb-error "column-family is not open"))

382

(put-key self key val)))

383

(((self rdb-database) (key string) (val string) &key column)

384

(if-let ((column (and column (find-column column self))))

385

(if-let ((sap (sap column)))

386

(put-cf-raw

387

(sap self)

388

sap

389

(string-to-octets key)

390

(string-to-octets val)

391

(rocksdb-writeoptions-create))

392

(rdb-error "column-family is not open"))

393

(put-key self key val)))

394

(((self rdb-database) (key string) val &key column)

395

(if-let ((column (and column (find-column column self))))

396

(if-let ((sap (sap column)))

397

(put-cf-raw

398

(sap self)

399

sap

400

(string-to-octets key)

401

val

402

(rocksdb-writeoptions-create))

403

(rdb-error "column-family is not open"))

404

(put-key self key val)))

405

(((self rdb-database) key (val string) &key column)

406

(if-let ((column (and column (find-column column self))))

407

(if-let ((sap (sap column)))

408

(put-cf-raw

409

(sap self)

410

sap

411

key

412

(string-to-octets val)

413

(rocksdb-writeoptions-create))

414

(rdb-error "column-family is not open"))

415

(put-key self key val)))

416

(((self rdb) (key string) (val string) &key column)

417

(insert-key self (string-to-octets key) (string-to-octets val) :column column))

418

(((self rdb) (key string) val &key column)

419

(insert-key self (string-to-octets key) val :column column))

420

(((self rdb) key (val string) &key column)

421

(insert-key self key (string-to-octets val) :column column)))

422

423

(defmethod insert-kv ((self rdb) (kv kv) &key column (opts (rocksdb-writeoptions-create)))

424

(if column

425

(let ((column (etypecase column

426

(rdb-cf column)

427

(t (find column (columns self)

428

:key 'name

429

:test 'equal)))))

430

(put-cf-raw (sap self)

431

(sap column)

432

(kv-key kv)

433

(kv-val kv)

434

opts))

435

(put-kv self kv)))

436

437

(defmethod iter ((self rdb-database) &key column (opts (rocksdb-readoptions-create)))

438

(typecase column

439

(rdb-column-family (iter (db self) :cf (cf column) :opts opts))

440

(null (iter (db self) :opts opts))

441

(symbol (iter (db self) :cf (cf (find-column column self)) :opts opts))

442

(simple-string (iter (db self) :cf (cf (find-column column self)) :opts opts))

443

(rdb-cf (iter (db self) :cf column :opts opts))

444

(t (iter (db self) :opts opts :cf column))))

445

446

(defmethods get-val

447

(((self rdb-database) (key string) &key (opts (rocksdb-readoptions-create)) column)

448

(let ((sap (sap self)))

449

(if column

450

(get-cf-str-raw sap (sap (find-column column self)) key opts)

451

(get-kv-str-raw sap key opts))))

452

(((self rdb-database) key &key (opts (rocksdb-readoptions-create)) column)

453

(let ((sap (sap self)))

454

(if column

455

(get-cf-raw sap (sap (find-column column self)) key opts)

456

(get-kv-raw sap key opts)))))

457

458

 (defmethod multi-get ((self rdb-database) keys &key (data-type 'octet-vector) (opts (rocksdb-readoptions-create)) columns)

459

(multi-get (db self) keys :data-type data-type :opts opts :cf (mapcar 'cf columns)))

460

461

(defmethod create-column ((db rdb-database) (col rdb-column-family))

462

(if (equal (name col) *rdb-default-column-name*)

463

(rdb-default-column-warning "ignoring attempt to create 'default' column-family: ~A" col)

464

(setf (sap col) (create-cf-raw (sap db) (name col) (sap (column-opts col)))))

465

;; (open-column db col)

466

col)

467

468

(defmethod create-columns ((self rdb-database))

469

(if (null (sap self))

470

(warn 'db-missing :message "ignoring attempt to create column-families before opening")

471

(loop for cf across (columns self)

472

do (create-column self cf))))

473

474

(defmethod find-column ((cf string) (self rdb-database) &key)

475

"Find a column by name."

476

(find cf (columns self) :key 'name :test 'equal))

477

478

(defmethod find-column ((cf symbol) (self rdb-database) &key)

479

(find (string-downcase cf) (columns self) :key 'name :test 'string=))

480

481

(defmethod find-column ((col rdb-column-family) (self rdb-database) &key)

482

(find (string-downcase (name col)) (columns self) :key 'name :test 'string=))

483

484

(defmethod (setf find-column) ((new rdb-column-family) (cf string) (self rdb-database) &key)

485

"Find and replace a column by name."

486

(nsubstitute new (find-column cf self) (columns self)))

487

488

(defmethod database-version ((self rdb-database))

489

"Return the version tag or nil if unmarked"

490

(when-let ((db (and #1=(db self) (sap #1#))))

491

(rocksdb-property-value db "rocksdb.current-super-version-number")))

492

493

(defaccessor name ((self rdb-database)) (name (db self)))

494

(defaccessor sap ((self rdb-database)) (sap (db self)))

495

(defaccessor db-opts ((self rdb-database)) (db-opts (db self)))

496

(defaccessor* db-opt

497

((self rdb-database) key) (db-opt (db-opts self) key)

498

(new (self rdb-database) key &key push)

499

(prog1 (setf (db-opt (db-opts self) key) new)

500

(when push (push-sap (db-opts self) key))))

501

502

(defmethods db-prop

503

(((self rdb-database) (name string))

504

(db-prop (db self) name))

505

(((self rdb-database) (name symbol))

506

(db-prop (db self) (string-downcase (concatenate 'string "rocksdb." (symbol-name name))))))

507

508

(defmethod push-opts ((self rdb-database))

509

(with-slots (opts) (db self)

510

(push-sap* opts)))

511

512

(defmethod print-stats ((self rdb-database) &optional stream)

513

(print-stats (db self) stream))

514

515

(defmethod db-metadata ((self rdb-database) &optional type)

516

(db-metadata (db self) type))

517

518

(defmethod db-stats ((self rdb-database) &optional (type (rocksdb-statistics-level "all")))

519

(db-stats (db self) type))

520

521

(defmethod ingest-db ((self rdb-database) files &key (opts (rocksdb-ingestexternalfileoptions-create))

522

column)

523

(if column

524

(ingest-db (db self) files :opts opts :column (find-column column self))

525

(ingest-db (db self) files :opts opts)))

526

527

(defmethods make-db

528

(((engine (eql :rdb)) &rest initargs &key columns &allow-other-keys)

529

(declare (ignore engine))

530

(remf initargs :columns)

531

(let ((db (make-instance 'rdb-database :db (apply 'make-db :rocksdb initargs))))

532

(when columns (setf (columns db) (coerce (mapcar (lambda (x) (cf x)) columns) 'vector)))

533

db))

534

(((engine (eql :rdb-backup)) &key path (db *db*))

535

(setf (db-backup db) (backup-db db :path path)))

536

(((engine (eql :rdb-transaction)) &key path opts (db *db*))

537

(setf (transaction-db db) (open-transaction-db db :opts opts :path path)))

538

(((engine (eql :rdb-secondary)) &key path opts (db *db*))

539

(setf (secondary-db db) (open-secondary-db db :opts opts :path path))))

540

541

(defmethod derive-schema ((self rdb-database))

542

(apply 'make-schema

543

(loop for c across (columns self)

544

collect (cf-to-field (cf c)))))

545

546

(defmethod open-db ((self rdb-database)) (open-db (db self)) self)

547

 (defmethod open-transaction-db ((self rdb-database) &key path (opts (rocksdb-transactiondb-options-create)) optimistic)

548

   (setf (transaction-db self) (open-transaction-db (db self) :opts opts :path path :optimistic optimistic)))

549

550

(defmethod open-backup-engine ((self rdb-database) &key path)

551

(setf (db-backup self) (open-backup-engine (db self) :path path)))

552

553

(defmethod open-secondary-db ((self rdb-database) &key path opts)

554

(setf (secondary-db self) (open-secondary-db (db self) :opts opts :path path)))

555

556

(defmethod open-checkpoint-db ((self rdb-database) &key path)

557

(vector-push-extend (%make-checkpoint (sap self) path) (db-checkpoints self)))

558

559

(defmethod snapshot-db ((self rdb-database))

560

(vector-push-extend (snapshot-db (db self)) (db-snapshots self)))

561

562

 (defmethod flush-db ((self rdb-database) &rest args &key &allow-other-keys) (apply 'flush-db (db self) args))

563

564

(defmethod close-db ((self rdb-database) &key)

565

(close-columns self)

566

(close-db (db self)))

567

568

(defmethod db-closed-p ((self rdb-database)) (db-closed-p (db self)))

569

(defmethod db-open-p ((self rdb-database)) (db-open-p (db self)))

570

571

(defmethod destroy-db ((self rdb-database))

572

(destroy-db (db self)))

573

574

(defmethod close-backup-engine ((self rdb-database))

575

(with-slots (backup) self

576

(unless (null backup)

577

(setf backup (close-backup-engine backup)))))

578

579

(defmethod close-transaction-db ((self rdb-database))

580

(when-let ((sap (transaction-db self)))

581

(close-transaction-db sap)))

582

583

(defmethod shutdown-db ((self rdb-database) &key)

584

(close-backup-engine self)

585

(close-transaction-db self)

586

(close-columns self)

587

(shutdown-db (db self)))

588

589

(defmethod get-value (elt (self rdb-database))

590

(get-value elt (db self)))

591

592

(defmethod put-key ((self rdb-database) key val)

593

(put-key (db self) key val))

594

595

(defmethod put-kv ((self rdb-database) (kv kv))

596

(put-kv (db self) kv))

597

598

(defmethod delete-key ((self rdb-database) key &key)

599

(delete-key (db self) key))

600

601

(defmethod merge-key ((self rdb-database) key val &key (opts (rocksdb-writeoptions-create)))

602

(merge-key (db self) key val :opts opts))

603

604

(defmethod merge-kv ((self rdb-database) kv &key (opts (rocksdb-writeoptions-create)))

605

(merge-kv-raw (sap self) (kv-key kv) (kv-val kv) opts))

606

607

(defmethod add-column (col (self rdb-database))

608

(vector-push-extend col (coerce (columns self) 'vector)))

609

610

(defmethod destroy-columns ((self rdb-database))

611

(with-slots (columns) self

612

(loop for cf across columns

613

do (setf cf (destroy-column cf)))))

614

615

(defmethod load-schema ((self rdb-database) (schema schema))

616

"Load SCHEMA into rdb database object SELF. This will add any missing rdb-cfs

617

and update existing key/value types for cfs with the same name. Existing cfs

618

only get their type slots updated on non-nil values."

619

(loop for field across (fields schema)

620

do (if-let ((col (find-column (field-name field) self)))

621

(load-field col field)

622

(add-column

623

(load-field

624

                (make-instance 'rdb-column-family :cf (make-rdb-cf (field-name field)) :type (field-type field))

625

field)

626

self))

627

finally (return self)))

628

629

;;; Transactions

630

(defmethod make-transaction ((self rdb-database)

631

&key (write-opts (rocksdb-writeoptions-create))

632

path

633

(name (name self))

634

txn

635

optimistic

636

(opts (rocksdb-transaction-options-create))

637

(db-opts (rocksdb-transactiondb-options-create)))

638

(with-errptr e

639

(let ((txn-db (or (transaction-db self)

640

(setf (transaction-db self)

641

                             (open-transaction-db self :opts db-opts :path path :optimistic optimistic)))))

642

(let ((obj (make-transaction txn-db :write-opts write-opts

643

:opts opts

644

:txn txn)))

645

(when name (setf (name obj) name))

646

obj))))

647

648

(defmethod execute-transaction ((self rdb-database) txn &key)

649

(prog1 (commit-transaction txn)

650

(rocksdb-transaction-destroy txn)))

651

652

;;; Collections

653

(defclass rdb-collection (database-collection)

654

((collection :initform (coerce nil db::*database-collection-type*))))

655

 ��������������������������������������������������������������