changelog shortlog graph tags branches changeset file revisions annotate raw help

Mercurial > demo / examples/db/tao.lisp

revision 39: 1ef551e24009
parent 37: c6d0a37a046a
     1.1--- a/examples/db/tao.lisp	Fri Dec 29 00:45:44 2023 -0500
     1.2+++ b/examples/db/tao.lisp	Thu Apr 11 18:58:35 2024 -0400
     1.3@@ -6,9 +6,85 @@
     1.4 
     1.5 ;;; Code:
     1.6 (defpackage :examples/tao
     1.7-  (:use :cl :std :cli :rdb)
     1.8-  (:export :main))
     1.9+  (:use :cl :std :rdb :log :obj/db :obj/graph :obj/id)
    1.10+  (:export :run-tao))
    1.11 
    1.12 (in-package :examples/tao)
    1.13 
    1.14-(defmain ())
    1.15+(rdb::load-rocksdb)
    1.16+
    1.17+(defvar *tao-directory* "/tmp/tao/")
    1.18+
    1.19+(defvar *tao-log-dir*)
    1.20+(defvar *tao-db-dir*)
    1.21+(defvar *tao-cfs*
    1.22+  (vector (make-rdb-cf "nodes")
    1.23+          (make-rdb-cf "edges")))
    1.24+
    1.25+(defun tao-path (path &optional (root *tao-directory*))
    1.26+  (merge-pathnames path root))
    1.27+
    1.28+(defclass tao-node (id)
    1.29+  (key val))
    1.30+
    1.31+(defclass tao-edge (edge) ())
    1.32+
    1.33+(defclass tao-graph (graph) ())
    1.34+
    1.35+(defclass tao-db (database)
    1.36+  ((db :type rdb)))
    1.37+
    1.38+(defclass tao (tao-db tao-graph)
    1.39+  ((dir :initarg :dir)))
    1.40+
    1.41+(defun ensure-tao-directories (&optional (root *tao-directory*))
    1.42+  (setf *tao-log-dir* (ensure-directories-exist (tao-path "log/" root) :verbose t))
    1.43+  root)
    1.44+
    1.45+(defun init-tao-db (&optional (root *tao-directory*))
    1.46+  (let ((db-dir (tao-path "db/" root)))
    1.47+    (setf *tao-db-dir* db-dir)
    1.48+    (create-db db-dir :cfs *tao-cfs*)))
    1.49+
    1.50+(defun make-tao (&key (dir *tao-directory*))
    1.51+  (make-instance 'tao
    1.52+    :dir (setf *tao-directory* (ensure-tao-directories dir))
    1.53+    :db (init-tao-db dir)))
    1.54+
    1.55+(defun run-tao ()
    1.56+  (let ((opts (default-rdb-opts))) ;; configure database options
    1.57+    (set-opt opts "error-if-exists" 0)
    1.58+    (set-opt opts "db-log-dir" "/tmp/log")
    1.59+    (push-sap* opts)
    1.60+    (let ((db (create-db "tao"
    1.61+                         :opts opts
    1.62+                         ;; :cfs (vector (make-rdb-cf "nodes")
    1.63+                         ;;              (make-rdb-cf "edges"))
    1.64+                         :open t)))
    1.65+      (with-db (db db)
    1.66+        (flush-db db)
    1.67+        (let ((metadata (get-metadata db)))
    1.68+          (info!
    1.69+           (rdb::rocksdb-column-family-metadata-get-name metadata)
    1.70+           (rdb::rocksdb-column-family-metadata-get-size metadata)
    1.71+           (rdb::rocksdb-column-family-metadata-get-file-count metadata)
    1.72+           (rdb::rocksdb-column-family-metadata-get-level-count metadata))
    1.73+          (let ((lmeta (rdb::rocksdb-column-family-metadata-get-level-metadata metadata 0)))
    1.74+            (info!
    1.75+             (rdb::rocksdb-level-metadata-get-level lmeta)
    1.76+             (rdb::rocksdb-level-metadata-get-size lmeta)
    1.77+             (rdb::rocksdb-level-metadata-get-file-count lmeta))
    1.78+            ;; TODO: requires file-count > 0
    1.79+            ;; (let ((smeta (rdb::rocksdb-level-metadata-get-sst-file-metadata lmeta 0)))
    1.80+            ;;   (info!
    1.81+            ;;    (rdb::rocksdb-sst-file-metadata-get-directory smeta)
    1.82+            ;;    (rdb::rocksdb-sst-file-metadata-get-relative-filename smeta)
    1.83+            ;;    (rdb::rocksdb-sst-file-metadata-get-size smeta)
    1.84+            ;;    (rdb::rocksdb-sst-file-metadata-get-smallestkey smeta)
    1.85+            ;;    (rdb::rocksdb-sst-file-metadata-get-largestkey smeta))
    1.86+            ;;   (rdb::rocksdb-sst-file-metadata-destroy smeta))
    1.87+            (rdb::rocksdb-level-metadata-destroy lmeta))
    1.88+          (rdb::rocksdb-column-family-metadata-destroy metadata))
    1.89+        (info! (get-prop db "rocksdb.stats"))
    1.90+        (close-db db))))
    1.91+  (info! "TAO OK"))