changelog shortlog graph tags branches changeset files revisions annotate raw help

Mercurial > core / lisp/bin/rdb.lisp

changeset 689: 2e7d93b892a5
parent: af486e0a40c9
author: Richard Westhaver <ellis@rwest.io>
date: Tue, 01 Oct 2024 22:29:08 -0400
permissions: -rw-r--r--
description: cli shell tests init 
     1 ;;; rdb.lisp --- RocksDB client
     2 
     3 ;;; Code:
     4 (uiop:define-package :bin/rdb
     5   (:use :cl :rdb :std :cli/clap :log :clap))
     6 
     7 (in-package :bin/rdb)
     8 (rocksdb:load-rocksdb t)
     9 (defopt rdb-help (print-help *cli*))
    10 (defopt rdb-version (print-version *cli*))
    11 (defopt rdb-log-level (when *arg* (setq *log-level* :debug)))
    12 (defvar *rdb*)
    13 (defopt rdb-target-db (or *arg* "rdb"))
    14 
    15 ;; (defopt rdb-config (init-rdb-user-config (parse-file-opt *arg*)))
    16 
    17 (defcmd rdb-new ()
    18   (set-opt *rdb* :error-if-exists t)
    19   (open-db *rdb*)
    20   (println (rdb-name *rdb*)))
    21 
    22 (defcmd rdb-show
    23   (let* ((db-path (cli-opt-val (car (find-opts *cli* "db"))))
    24          (*rdb* (create-db db-path :open nil)))
    25     (if (and (null db-path) (zerop *argc*))
    26         (mapc (lambda (x) (println (format nil "~a ~a" (car x) (cdr x))))
    27               (hash-table-alist (backfill-opts (default-rdb-opts) :full t)))
    28         (with-db (db (create-db db-path :open t))
    29           (println (hash-table-alist (backfill-opts db)))
    30           (with-iter (it (create-iter db))
    31             (iter-seek-to-first it)
    32             (loop while (iter-valid-p it)
    33                   do (progn
    34                        (format t "~A : ~A~%"
    35                                (sb-ext:octets-to-string (iter-key it) :external-format '(:ascii :replacement #\_))
    36                                (iter-val it))
    37                        (iter-next it))
    38                   finally (rocksdb::rocksdb-iter-destroy %it)))))))
    39 
    40 (defcmd rdb-set
    41   (if (> 2 *argc*)
    42       (rdb-error "missing args: KEY VAL")
    43       (with-db (db *rdb*)
    44         (open-db db)
    45         (insert-key  db (pop *args*) (pop *args*)))))
    46 
    47 (defcmd rdb-get
    48   (if (> 1 *argc*)
    49       (rdb-error "missing arg: KEY")
    50       (with-db (db *rdb*)
    51         (open-db db)
    52         (when-let ((val (get-key db (car *args*))))
    53           (println val)))))
    54 
    55 (defcmd rdb-destroy
    56   (destroy-db *rdb*))
    57 
    58 (defcmd rdb-fuzz
    59   (with-db (db *rdb*)
    60     (open-db db)
    61     (let ((val (make-array 32 :element-type 'octet)))
    62       (dotimes (i (if (zerop *argc*) 1000 (parse-integer (car *args*))))
    63         (nreversef val)
    64         (let ((seed (random 32)))
    65           (dotimes (ii seed)
    66             (setf (aref val ii) (random 256))))
    67         (nreversef val)
    68         (put-key db
    69                  (sb-ext:string-to-octets (string (gensym "foo")))
    70                  val)))))
    71 
    72 (define-cli *rdb-cli*
    73   :name "rdb"
    74   :version "0.1.0"
    75   :thunk 'rdb-show
    76   :description "A simple helper for RocksDB."
    77   :opts ((:name "level" :description "set the log level" :thunk rdb-log-level)
    78          (:name "help" :description "print help" :thunk rdb-help)
    79          (:name "version" :description "print version" :thunk rdb-version)
    80          (:name "db" :description "target db" :thunk rdb-target-db :kind dir))
    81   :cmds ((:name new
    82           :thunk rdb-new)
    83          (:name show
    84           :thunk rdb-show)
    85          (:name set :thunk rdb-set)
    86          (:name get :thunk rdb-get)
    87          (:name fuzz :thunk rdb-fuzz)
    88          (:name destroy :thunk rdb-destroy)))
    89 
    90 (defmain start-rdb ()
    91   (let ((*log-level* :info))
    92     (with-cli (*rdb-cli* opts cmds args) ()
    93       (if (active-cmds *cli*)
    94           (rdb:with-db (*rdb* (create-db (do-opt (car (find-opts *cli* "db")))))
    95             (do-cmd *cli*)
    96               (close-db *rdb*))
    97           (print-help *cli*)))))