Compare commits
48 Commits
Author | SHA1 | Date |
---|---|---|
kimory | 73e1f0123c | |
kimory | c36cad41ab | |
kimory | 050db0ed8b | |
kimory | 10ba9a1a72 | |
kimory | 8fc2a645c4 | |
kimory | 88f1440fdb | |
kimory | acb3c8ee5b | |
kimory | 2a97f2f218 | |
kimory | afe2e12f5f | |
kimory | 0d1411fb61 | |
kimory | fb84d81075 | |
kimory | 9c110610ae | |
kimory | 32155d7690 | |
kimory | b3a50358ab | |
kimory | 1ce7d71f8d | |
kimory | d1dc936eee | |
kimory | d522a80f51 | |
kimory | 467601e809 | |
kimory | aca91a5961 | |
kimory | 98793adf63 | |
kimory | 09fb2b7cf4 | |
kimory | cfe7a87bfa | |
kimory | 7821a1a819 | |
kimory | 751e0efdec | |
kimory | e682b786b7 | |
kimory | 9de26d52c0 | |
kimory | 6ea4c26172 | |
kimory | a321b62277 | |
kimory | c0385cd095 | |
kimory | ddb6d5b3ff | |
Philippe PITTOLI | 284e3a951e | |
Philippe PITTOLI | 25239281b7 | |
Philippe PITTOLI | 94d522e778 | |
Karchnu | b29badbad0 | |
Karchnu | 47a50e981a | |
Karchnu | b7abc32ec0 | |
Karchnu | 080fcf426d | |
Karchnu | 16fb640d2f | |
Karchnu | 3f1e8edf95 | |
Karchnu | 779e13e83d | |
Karchnu | 5624c7b7ee | |
Karchnu | 49e155248a | |
Karchnu | b561984dcc | |
Karchnu | 774e9bd436 | |
Karchnu | fe41a86eb8 | |
Karchnu | 20fec34dcc | |
Karchnu | 1c9648e9a0 | |
Karchnu | 069b879b36 |
|
@ -6,6 +6,12 @@ When storing simple files directly on the file-system is enough.
|
||||||
|
|
||||||
This project is a work in progress.
|
This project is a work in progress.
|
||||||
|
|
||||||
|
# Constraints (WIP)
|
||||||
|
|
||||||
|
TODO:
|
||||||
|
- parallelism: run dodb on several threads (solved by a locking system)
|
||||||
|
- fs data integrity: in case of a crash, dodb won't corrupt data on disk (solved by a temp file on the same filesystem, then a simple mv)
|
||||||
|
|
||||||
# Crystal version
|
# Crystal version
|
||||||
|
|
||||||
Follow [this link for the Crystal version of DODB][dodbcr].
|
Follow [this link for the Crystal version of DODB][dodbcr].
|
||||||
|
|
|
@ -0,0 +1,10 @@
|
||||||
|
- Warning when indexes overlap (data add or update)
|
||||||
|
- Data integrity on update (create temporary file with new data, rename old data file, move temporary file, remove old data file)
|
||||||
|
- Handle errors (such as permissions) in an explicit way
|
||||||
|
- Grooming (create a consistent and convenient API, comments)
|
||||||
|
- Improve data search
|
||||||
|
- Check for TODOs
|
||||||
|
- Check types.
|
||||||
|
- Switch to CBOR format.
|
||||||
|
- Verify uniqueness before adding data.
|
||||||
|
- Allow indexes to be NIL.
|
|
@ -0,0 +1,22 @@
|
||||||
|
(defsystem "dodb"
|
||||||
|
:version "0.1.0"
|
||||||
|
:author "Philippe PITTOLI"
|
||||||
|
:license "ISC"
|
||||||
|
:depends-on ("osicat")
|
||||||
|
:components ((:module "src"
|
||||||
|
:components
|
||||||
|
((:file "util")
|
||||||
|
(:file "main"))))
|
||||||
|
:description "When storing simple files directly on the file-system is enough."
|
||||||
|
:in-order-to ((test-op (test-op "dodb/tests"))))
|
||||||
|
|
||||||
|
(defsystem "dodb/tests"
|
||||||
|
:author "Philippe PITTOLI"
|
||||||
|
:license "ISC"
|
||||||
|
:depends-on ("dodb"
|
||||||
|
"rove")
|
||||||
|
:components ((:module "tests"
|
||||||
|
:components
|
||||||
|
((:file "main"))))
|
||||||
|
:description "Test system for dodb"
|
||||||
|
:perform (test-op (op c) (symbol-call :rove :run c)))
|
|
@ -0,0 +1,368 @@
|
||||||
|
(declaim (optimize (speed 3) (safety 3)))
|
||||||
|
(defpackage :dodb
|
||||||
|
(:use :common-lisp :util :osicat)
|
||||||
|
; TODO
|
||||||
|
(:export
|
||||||
|
:db/new ; new database
|
||||||
|
:db/new-index ; symlinks based on an unique ID
|
||||||
|
:db/new-partition ; symlinks based on a shared ID
|
||||||
|
:db/add ; add a new value in the DB
|
||||||
|
:db/update ; update a value in the DB
|
||||||
|
:db/del ; del a value from the DB
|
||||||
|
:db/get-by-index ;
|
||||||
|
:db/get-by-partition ;
|
||||||
|
:db/drop-everything ;
|
||||||
|
:db-data ;
|
||||||
|
))
|
||||||
|
(in-package dodb)
|
||||||
|
|
||||||
|
(declaim (ftype (function (pathname) integer) filename->integer))
|
||||||
|
(declaim (inline filename->integer))
|
||||||
|
(defun filename->integer (filename)
|
||||||
|
(declare (type pathname filename))
|
||||||
|
(parse-integer (pathname-name filename))) ; pathname-name returns the basename
|
||||||
|
|
||||||
|
(declaim (ftype (function (string) string) to-upper-case))
|
||||||
|
(declaim (inline to-upper-case))
|
||||||
|
(defun to-upper-case (some-string)
|
||||||
|
(declare (type string some-string))
|
||||||
|
(format nil "~@:(~a~)" some-string))
|
||||||
|
|
||||||
|
; Example: 18 -> 000000000000018
|
||||||
|
(declaim (ftype (function (integer) string) number->filename))
|
||||||
|
(declaim (inline number->filename))
|
||||||
|
(defun number->filename (number)
|
||||||
|
(declare (type integer number))
|
||||||
|
(format nil "~15,'0D" number))
|
||||||
|
|
||||||
|
(declaim (ftype (function (character) boolean) is-forbidden-character-p))
|
||||||
|
(declaim (inline is-forbidden-character-p))
|
||||||
|
(defun is-forbidden-character-p (some-char)
|
||||||
|
(declare (type character some-char))
|
||||||
|
(member some-char (list #\/ #\\)))
|
||||||
|
|
||||||
|
(declaim (ftype (function (string) string) protect-file-system))
|
||||||
|
(declaim (inline protect-file-system))
|
||||||
|
(defun protect-file-system (value)
|
||||||
|
(declare (type string value))
|
||||||
|
(substitute-if #\_ #'is-forbidden-character-p value))
|
||||||
|
|
||||||
|
(declaim (ftype (function (atom) string) value->safe-string))
|
||||||
|
(defun value->safe-string (value)
|
||||||
|
(protect-file-system (typecase value
|
||||||
|
(string value)
|
||||||
|
(symbol (symbol-name value))
|
||||||
|
(t (format nil "~A" value)))))
|
||||||
|
|
||||||
|
; index = 1-1
|
||||||
|
; partition = 1-n
|
||||||
|
(defstruct db
|
||||||
|
path ; Path
|
||||||
|
(indexes (make-hash-table)) ; {String => #'FUNCTION-NAME}
|
||||||
|
(partitions (make-hash-table)) ; {String => #'FUNCTION-NAME}
|
||||||
|
(current-index 0) ; Int
|
||||||
|
(data (make-hash-table))) ; {Int -> struct}
|
||||||
|
|
||||||
|
; db/new ensures directory '<path>/data/' exist,
|
||||||
|
; then loads values from existing files, if any, and puts them into db-data.
|
||||||
|
(declaim (ftype (function (string) db) db/new))
|
||||||
|
(defun db/new (path)
|
||||||
|
(declare (type string path))
|
||||||
|
(let ((data (make-hash-table))
|
||||||
|
(data-dir-path (concatenate 'string path "/data/"))
|
||||||
|
(current-index 0))
|
||||||
|
|
||||||
|
(ensure-directories-exist data-dir-path)
|
||||||
|
|
||||||
|
(loop for filename in (osicat:list-directory data-dir-path)
|
||||||
|
do (let ((id (filename->integer filename))
|
||||||
|
(value (util:read-object-from-file filename)))
|
||||||
|
(if (> id current-index)
|
||||||
|
(setf current-index id))
|
||||||
|
(setf (gethash id data) value)))
|
||||||
|
|
||||||
|
(make-db
|
||||||
|
:path path
|
||||||
|
:data data
|
||||||
|
:current-index current-index)))
|
||||||
|
|
||||||
|
; Example: returns "./storage/cars/indexes/by_name/".
|
||||||
|
(declaim (ftype (function (string string) string) db/index/get-directory-path))
|
||||||
|
(declaim (inline db/index/get-directory-pathispatch))
|
||||||
|
(defun db/index/get-directory-path (dbpath index-name)
|
||||||
|
(declare (type string dbpath index-name))
|
||||||
|
(concatenate 'string dbpath "/indexes/by_" index-name "/"))
|
||||||
|
|
||||||
|
; Example: returns "./storage/cars/partitions/by_color/Red/".
|
||||||
|
(declaim (ftype (function (string string string) string) db/partition/get-directory-path))
|
||||||
|
(defun db/partition/get-directory-path (dbpath name object-attribute)
|
||||||
|
(declare (type string dbpath name object-attribute))
|
||||||
|
(concatenate 'string dbpath "/partitions/by_" name "/" object-attribute "/"))
|
||||||
|
|
||||||
|
; Example: "./storage/cars/" "name" #'vehicle-name object -> "./storage/cars/indexes/by_name/Corvet".
|
||||||
|
(declaim (ftype (function (string string function atom) string) db/index/get-symlink-path))
|
||||||
|
(defun db/index/get-symlink-path (dbpath index-name fsymbol object)
|
||||||
|
(declare (type string dbpath index-name))
|
||||||
|
(declare (type function fsymbol))
|
||||||
|
(let* ((value (funcall fsymbol object))
|
||||||
|
(symlink-basename (value->safe-string value)))
|
||||||
|
(concatenate 'string
|
||||||
|
(db/index/get-directory-path dbpath index-name)
|
||||||
|
symlink-basename)))
|
||||||
|
|
||||||
|
; Example: "./storage/cars/" "name" #'vehicle-name object "0000000015"
|
||||||
|
; -> (osicat:make-link "./storage/cars/indexes/by_name/Corvet"
|
||||||
|
; :target "../../data/0000000015"
|
||||||
|
; :hard nil)
|
||||||
|
(declaim (ftype (function (string string function atom string) null) db/index/new))
|
||||||
|
(defun db/index/new (dbpath index-name fsymbol object file-name)
|
||||||
|
(declare (type string dbpath index-name file-name))
|
||||||
|
(declare (type function fsymbol))
|
||||||
|
(let ((symlink-path (db/index/get-symlink-path dbpath index-name fsymbol object)))
|
||||||
|
(declare (type string symlink-path))
|
||||||
|
|
||||||
|
; works even when the database directory is moved
|
||||||
|
(osicat:make-link symlink-path
|
||||||
|
:target (concatenate 'string "../../data/" file-name)
|
||||||
|
:hard nil))
|
||||||
|
(values nil))
|
||||||
|
|
||||||
|
(declaim (ftype (function (string string function atom) null) db/index/del))
|
||||||
|
(defun db/index/del (dbpath index-name fsymbol object)
|
||||||
|
(declare (type string dbpath index-name))
|
||||||
|
(declare (type function fsymbol))
|
||||||
|
(delete-file (db/index/get-symlink-path dbpath index-name fsymbol object))
|
||||||
|
(values nil))
|
||||||
|
|
||||||
|
; Example: "./storage/cars/" "color" #'vehicle-color object "0000000015".
|
||||||
|
; -> "./storage/cars/partitions/by_color/Red/0000000015".
|
||||||
|
(declaim (ftype (function (string string function atom string) string) db/partition/get-symlink-path))
|
||||||
|
(defun db/partition/get-symlink-path (dbpath partition-name fsymbol object file-name)
|
||||||
|
(declare (type string dbpath partition-name file-name))
|
||||||
|
(declare (type function fsymbol))
|
||||||
|
(let* ((object-attribute (funcall fsymbol object))
|
||||||
|
(safe-value (value->safe-string object-attribute))
|
||||||
|
; example: "./storage/cars/partitions/by_color/Red/"
|
||||||
|
(dirpath (db/partition/get-directory-path dbpath partition-name safe-value)))
|
||||||
|
(concatenate 'string dirpath file-name)))
|
||||||
|
|
||||||
|
; Example: "./storage/cars/" "color" #'vehicle-color object "0000000015"
|
||||||
|
; -> (osicat:make-link "./storage/cars/partitions/by_color/Red/0000000015"
|
||||||
|
; :target "../../../data/0000000015"
|
||||||
|
; :hard nil)
|
||||||
|
(declaim (ftype (function (string string function atom string) null) db/partition/new))
|
||||||
|
(defun db/partition/new (dbpath partition-name fsymbol object file-name)
|
||||||
|
(declare (type string dbpath partition-name file-name))
|
||||||
|
(declare (type function fsymbol))
|
||||||
|
(let ((symlink-path
|
||||||
|
(db/partition/get-symlink-path dbpath partition-name fsymbol object file-name)))
|
||||||
|
|
||||||
|
(ensure-directories-exist symlink-path)
|
||||||
|
|
||||||
|
; works even when the database directory is moved
|
||||||
|
(osicat:make-link symlink-path
|
||||||
|
:target (concatenate 'string "../../../data/" file-name)
|
||||||
|
:hard nil))
|
||||||
|
(values nil))
|
||||||
|
|
||||||
|
(declaim (ftype (function (string string function atom string) null) db/partition/del))
|
||||||
|
(defun db/partition/del (dbpath partition-name fsymbol object file-basename)
|
||||||
|
(declare (type string dbpath partition-name file-basename))
|
||||||
|
(declare (type function fsymbol))
|
||||||
|
(delete-file (db/partition/get-symlink-path dbpath partition-name fsymbol object file-basename))
|
||||||
|
(values nil))
|
||||||
|
|
||||||
|
(declaim (ftype (function (db string function) null) db/new-index))
|
||||||
|
(defun db/new-index (database index-name fsymbol)
|
||||||
|
(declare (type db database))
|
||||||
|
(declare (type string index-name))
|
||||||
|
(declare (type function fsymbol))
|
||||||
|
(let ((dbpath (db-path database))
|
||||||
|
(index-name (value->safe-string index-name)))
|
||||||
|
; create a directory for the indexes
|
||||||
|
(ensure-directories-exist
|
||||||
|
(concatenate 'string dbpath "/indexes/by_" index-name "/"))
|
||||||
|
|
||||||
|
; add this new index to the list
|
||||||
|
(setf (gethash index-name (db-indexes database)) fsymbol)
|
||||||
|
|
||||||
|
; generate index for all DB elements
|
||||||
|
(maphash #'(lambda (number object)
|
||||||
|
(handler-case (db/index/new dbpath index-name fsymbol object (number->filename number))
|
||||||
|
(OSICAT-POSIX:EEXIST ()
|
||||||
|
(format t "dodb:db/new-index: symlink already exists, ignoring.~&"))))
|
||||||
|
(db-data database)))
|
||||||
|
(values nil))
|
||||||
|
|
||||||
|
(declaim (ftype (function (string string function atom string atom) null) db/partition/update))
|
||||||
|
(defun db/partition/update (dbpath partition-name fsymbol object file-name old-object)
|
||||||
|
(declare (type string dbpath partition-name file-name))
|
||||||
|
(declare (type function fsymbol))
|
||||||
|
(let ((new-value (funcall fsymbol object))
|
||||||
|
(old-value (funcall fsymbol old-object)))
|
||||||
|
(if (not (equal new-value old-value))
|
||||||
|
(progn
|
||||||
|
; delete old partition
|
||||||
|
(db/partition/del dbpath partition-name fsymbol old-object file-name)
|
||||||
|
; create new partition
|
||||||
|
(db/partition/new dbpath partition-name fsymbol object file-name)))))
|
||||||
|
|
||||||
|
(declaim (ftype (function (db string function) null) db/new-partition))
|
||||||
|
(defun db/new-partition (database partition-name fsymbol)
|
||||||
|
(declare (type db database))
|
||||||
|
(declare (type string partition-name))
|
||||||
|
(declare (type function fsymbol))
|
||||||
|
(let ((dbpath (db-path database))
|
||||||
|
(partition-name (value->safe-string partition-name)))
|
||||||
|
; create a directory for the partitions
|
||||||
|
(ensure-directories-exist
|
||||||
|
(concatenate 'string dbpath "/partitions/by_" partition-name "/"))
|
||||||
|
|
||||||
|
; add this new partition to the list
|
||||||
|
(setf (gethash partition-name (db-partitions database)) fsymbol)
|
||||||
|
|
||||||
|
; generate partition for all DB elements
|
||||||
|
(maphash #'(lambda (number object)
|
||||||
|
(handler-case (db/partition/new dbpath partition-name fsymbol object (number->filename number))
|
||||||
|
(OSICAT-POSIX:EEXIST ()
|
||||||
|
(format t "dodb:db/new-partition: symlink already exists, ignoring.~&"))))
|
||||||
|
(db-data database)))
|
||||||
|
(values nil))
|
||||||
|
|
||||||
|
; Example: "./storage/cars/data/000000000000018".
|
||||||
|
(declaim (ftype (function (string string) string) get-filepath))
|
||||||
|
(defun get-filepath (dbpath file-name)
|
||||||
|
(declare (type string dbpath file-name))
|
||||||
|
(concatenate 'string dbpath "/data/" file-name))
|
||||||
|
|
||||||
|
(declaim (ftype (function (db atom) integer) db/add))
|
||||||
|
(defun db/add (database object)
|
||||||
|
(declare (type db database))
|
||||||
|
(incf (db-current-index database))
|
||||||
|
(let* ((file-basename (number->filename (db-current-index database)))
|
||||||
|
(dbpath (db-path database))
|
||||||
|
(tmp-file-basename (concatenate 'string file-basename "_tmp"))
|
||||||
|
(tmp-file-path (get-filepath dbpath tmp-file-basename)))
|
||||||
|
|
||||||
|
; write object to temporary file
|
||||||
|
(util:write-object-to-file object tmp-file-path)
|
||||||
|
|
||||||
|
; rename the temporary file
|
||||||
|
(rename-file tmp-file-path file-basename)
|
||||||
|
|
||||||
|
; generate indexes
|
||||||
|
(maphash #'(lambda (index-name fsymbol)
|
||||||
|
(db/index/new dbpath index-name fsymbol object file-basename))
|
||||||
|
(db-indexes database))
|
||||||
|
|
||||||
|
; generate partitions
|
||||||
|
(maphash #'(lambda (partition-name fsymbol)
|
||||||
|
(db/partition/new dbpath partition-name fsymbol object file-basename))
|
||||||
|
(db-partitions database)))
|
||||||
|
|
||||||
|
; store new in-memory data
|
||||||
|
; database.data[database.current-index] = object
|
||||||
|
(setf (gethash (db-current-index database) (db-data database)) object)
|
||||||
|
(db-current-index database))
|
||||||
|
|
||||||
|
(declaim (ftype (function (db integer) null) db/del))
|
||||||
|
(defun db/del (database object-index)
|
||||||
|
(declare (type db database))
|
||||||
|
(declare (type integer object-index))
|
||||||
|
(let ((file-basename (number->filename object-index))
|
||||||
|
(dbpath (db-path database))
|
||||||
|
(object (gethash object-index (db-data database))))
|
||||||
|
; remove data file
|
||||||
|
(delete-file (get-filepath dbpath file-basename))
|
||||||
|
|
||||||
|
; handle indexes
|
||||||
|
(maphash #'(lambda (index-name fsymbol)
|
||||||
|
(db/index/del dbpath index-name fsymbol object))
|
||||||
|
(db-indexes database))
|
||||||
|
|
||||||
|
; handle partitions
|
||||||
|
(maphash #'(lambda (partition-name fsymbol)
|
||||||
|
(db/partition/del dbpath partition-name fsymbol object file-basename))
|
||||||
|
(db-partitions database))
|
||||||
|
|
||||||
|
; remove in-memory data
|
||||||
|
(remhash object-index (db-data database)))
|
||||||
|
(values nil))
|
||||||
|
|
||||||
|
; Search for the data from the FS.
|
||||||
|
(declaim (ftype (function (db string atom) integer) db/get-by-index))
|
||||||
|
(defun db/get-by-index (database index-name attribute-value)
|
||||||
|
(declare (type db database))
|
||||||
|
(declare (type string index-name))
|
||||||
|
(let ((value (value->safe-string attribute-value)))
|
||||||
|
(filename->integer
|
||||||
|
(osicat:read-link
|
||||||
|
(concatenate 'string
|
||||||
|
(db/index/get-directory-path (db-path database) index-name) "/" value)))))
|
||||||
|
|
||||||
|
; Search for the data from the FS.
|
||||||
|
(declaim (ftype (function (db string atom) cons) db/get-by-partition))
|
||||||
|
(defun db/get-by-partition (database name attribute-value)
|
||||||
|
(declare (type db database))
|
||||||
|
(declare (type string name))
|
||||||
|
(let ((value (value->safe-string attribute-value))
|
||||||
|
(dbpath (db-path database)))
|
||||||
|
(loop for filename in (osicat:list-directory (db/partition/get-directory-path dbpath name value))
|
||||||
|
collect (filename->integer filename))))
|
||||||
|
|
||||||
|
(declaim (ftype (function (string string function atom string atom) null) db/index/update))
|
||||||
|
(defun db/index/update (dbpath index-name fsymbol object file-name old-object)
|
||||||
|
(declare (type string dbpath index-name file-name))
|
||||||
|
(declare (type function fsymbol))
|
||||||
|
(let ((new-value (funcall fsymbol object))
|
||||||
|
(old-value (funcall fsymbol old-object))
|
||||||
|
(symlink-path (db/index/get-symlink-path dbpath index-name fsymbol object)))
|
||||||
|
(if (not (equal new-value old-value))
|
||||||
|
; display a message in case the new index is already used by another object
|
||||||
|
(if (probe-file symlink-path)
|
||||||
|
(format t "dodb:db/index/update: the value ~a is already used by another object.~&" new-value)
|
||||||
|
(progn
|
||||||
|
; delete old index
|
||||||
|
(db/index/del dbpath index-name fsymbol old-object)
|
||||||
|
; create new index
|
||||||
|
(db/index/new dbpath index-name fsymbol object file-name))))))
|
||||||
|
|
||||||
|
; TODO: check database integrity (redundancy)
|
||||||
|
; TODO: locking
|
||||||
|
(declaim (ftype (function (db integer) null) db/update))
|
||||||
|
(defun db/update (database object-index)
|
||||||
|
(declare (type db database))
|
||||||
|
(declare (type integer object-index))
|
||||||
|
(let* ((object (gethash object-index (db-data database)))
|
||||||
|
(dbpath (db-path database))
|
||||||
|
(file-basename (number->filename object-index))
|
||||||
|
(file-path (get-filepath dbpath file-basename))
|
||||||
|
(old-object (util:read-object-from-file file-path))
|
||||||
|
(tmp-file-basename (concatenate 'string file-basename "_tmp"))
|
||||||
|
(tmp-file-path (get-filepath dbpath tmp-file-basename)))
|
||||||
|
|
||||||
|
; write object to temporary file
|
||||||
|
(util:write-object-to-file object tmp-file-path)
|
||||||
|
|
||||||
|
(delete-file file-path)
|
||||||
|
|
||||||
|
; rename the temporary file
|
||||||
|
(rename-file tmp-file-path file-basename)
|
||||||
|
|
||||||
|
; handle indexes
|
||||||
|
(maphash #'(lambda (index-name fsymbol)
|
||||||
|
(db/index/update dbpath index-name fsymbol object file-basename old-object))
|
||||||
|
(db-indexes database))
|
||||||
|
|
||||||
|
; handle partitions
|
||||||
|
(maphash #'(lambda (partition-name fsymbol)
|
||||||
|
(db/partition/update dbpath partition-name fsymbol object file-basename old-object))
|
||||||
|
(db-partitions database)))
|
||||||
|
(values nil))
|
||||||
|
|
||||||
|
(declaim (ftype (function (db) null) db/drop-everything))
|
||||||
|
(defun db/drop-everything (database)
|
||||||
|
(declare (type db database))
|
||||||
|
(osicat:delete-directory-and-files (db-path database))
|
||||||
|
(clrhash (db-data database))
|
||||||
|
(values nil))
|
|
@ -0,0 +1,32 @@
|
||||||
|
(defpackage :dodb-scenario
|
||||||
|
(:use :common-lisp :dodb))
|
||||||
|
(in-package dodb-scenario)
|
||||||
|
|
||||||
|
(defstruct vehicle name color (nb-of-lights 4))
|
||||||
|
|
||||||
|
(defparameter cars (dodb:db/new "/tmp/storage/cars/"))
|
||||||
|
|
||||||
|
(dodb:db/add cars (make-vehicle :name "Corvet" :color "Red"))
|
||||||
|
(dodb:db/add cars (make-vehicle :name "Ferrari" :color "Red"))
|
||||||
|
(dodb:db/add cars (make-vehicle :name "Deudeuch" :color "Beige"))
|
||||||
|
(dodb:db/add cars (make-vehicle :name "BMW" :color "Blue"))
|
||||||
|
(dodb:db/add cars (make-vehicle :name "Suzuki Wagon" :color "Blue" :nb-of-lights 6))
|
||||||
|
|
||||||
|
(dodb:db/new-index cars "name" #'vehicle-name)
|
||||||
|
(dodb:db/new-partition cars "color" #'vehicle-color)
|
||||||
|
(dodb:db/new-partition cars "nb-of-lights" #'vehicle-nb-of-lights)
|
||||||
|
|
||||||
|
(dodb:db/new-partition cars "\ot//her\\par/tit" #'vehicle-color)
|
||||||
|
(dodb:db/new-index cars "\ot//her\\i/name/r" #'vehicle-name)
|
||||||
|
|
||||||
|
(format t "~&~S~&" cars)
|
||||||
|
|
||||||
|
(format t "db/get-by-index ~S~&" (dodb:db/get-by-index cars "name" "Corvet"))
|
||||||
|
|
||||||
|
(format t "db/get-by-partition red cars:~&")
|
||||||
|
(loop for car in (dodb:db/get-by-partition cars "color" "Red")
|
||||||
|
do (format t "- ~S~&" car))
|
||||||
|
|
||||||
|
(let ((suzuki (dodb:db/get-by-index cars "name" "Suzuki Wagon")))
|
||||||
|
(setf (vehicle-color (gethash suzuki (dodb:db-data cars))) "White")
|
||||||
|
(dodb:db/update cars suzuki))
|
|
@ -0,0 +1,26 @@
|
||||||
|
(defpackage :util
|
||||||
|
(:use :common-lisp)
|
||||||
|
(:nicknames :ut)
|
||||||
|
(:export :write-object-to-file
|
||||||
|
:read-file
|
||||||
|
:read-object-from-file))
|
||||||
|
(in-package util)
|
||||||
|
|
||||||
|
(defun read-file (infile)
|
||||||
|
(with-open-file (instream infile
|
||||||
|
:direction :input
|
||||||
|
:if-does-not-exist nil)
|
||||||
|
(when instream
|
||||||
|
(let ((string (make-string (file-length instream))))
|
||||||
|
(read-sequence string instream)
|
||||||
|
string))))
|
||||||
|
|
||||||
|
(defun read-object-from-file (infile)
|
||||||
|
(read-from-string (read-file infile)))
|
||||||
|
|
||||||
|
(defun write-object-to-file (object outfile)
|
||||||
|
(with-open-file (my-file outfile
|
||||||
|
:direction :output
|
||||||
|
:if-exists :supersede
|
||||||
|
:if-does-not-exist :create)
|
||||||
|
(format my-file "~&~S~&" object)))
|
|
@ -0,0 +1,11 @@
|
||||||
|
(defpackage dodb/tests/main
|
||||||
|
(:use :cl
|
||||||
|
:dodb
|
||||||
|
:rove))
|
||||||
|
(in-package :dodb/tests/main)
|
||||||
|
|
||||||
|
;; NOTE: To run this test file, execute `(asdf:test-system :dodb)' in your Lisp.
|
||||||
|
|
||||||
|
(deftest test-target-1
|
||||||
|
(testing "should (= 1 1) to be true"
|
||||||
|
(ok (= 1 1))))
|
Loading…
Reference in New Issue