DODB: correct typing for all functions.
parent
c36cad41ab
commit
73e1f0123c
|
@ -47,7 +47,7 @@
|
||||||
(declare (type string value))
|
(declare (type string value))
|
||||||
(substitute-if #\_ #'is-forbidden-character-p value))
|
(substitute-if #\_ #'is-forbidden-character-p value))
|
||||||
|
|
||||||
; (declaim (ftype (function (string symbol null) string) value->safe-string))
|
(declaim (ftype (function (atom) string) value->safe-string))
|
||||||
(defun value->safe-string (value)
|
(defun value->safe-string (value)
|
||||||
(protect-file-system (typecase value
|
(protect-file-system (typecase value
|
||||||
(string value)
|
(string value)
|
||||||
|
@ -65,6 +65,7 @@
|
||||||
|
|
||||||
; db/new ensures directory '<path>/data/' exist,
|
; db/new ensures directory '<path>/data/' exist,
|
||||||
; then loads values from existing files, if any, and puts them into db-data.
|
; 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)
|
(defun db/new (path)
|
||||||
(declare (type string path))
|
(declare (type string path))
|
||||||
(let ((data (make-hash-table))
|
(let ((data (make-hash-table))
|
||||||
|
@ -99,6 +100,7 @@
|
||||||
(concatenate 'string dbpath "/partitions/by_" name "/" object-attribute "/"))
|
(concatenate 'string dbpath "/partitions/by_" name "/" object-attribute "/"))
|
||||||
|
|
||||||
; Example: "./storage/cars/" "name" #'vehicle-name object -> "./storage/cars/indexes/by_name/Corvet".
|
; 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)
|
(defun db/index/get-symlink-path (dbpath index-name fsymbol object)
|
||||||
(declare (type string dbpath index-name))
|
(declare (type string dbpath index-name))
|
||||||
(declare (type function fsymbol))
|
(declare (type function fsymbol))
|
||||||
|
@ -112,6 +114,7 @@
|
||||||
; -> (osicat:make-link "./storage/cars/indexes/by_name/Corvet"
|
; -> (osicat:make-link "./storage/cars/indexes/by_name/Corvet"
|
||||||
; :target "../../data/0000000015"
|
; :target "../../data/0000000015"
|
||||||
; :hard nil)
|
; :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)
|
(defun db/index/new (dbpath index-name fsymbol object file-name)
|
||||||
(declare (type string dbpath index-name file-name))
|
(declare (type string dbpath index-name file-name))
|
||||||
(declare (type function fsymbol))
|
(declare (type function fsymbol))
|
||||||
|
@ -121,15 +124,19 @@
|
||||||
; works even when the database directory is moved
|
; works even when the database directory is moved
|
||||||
(osicat:make-link symlink-path
|
(osicat:make-link symlink-path
|
||||||
:target (concatenate 'string "../../data/" file-name)
|
:target (concatenate 'string "../../data/" file-name)
|
||||||
:hard nil)))
|
:hard nil))
|
||||||
|
(values nil))
|
||||||
|
|
||||||
|
(declaim (ftype (function (string string function atom) null) db/index/del))
|
||||||
(defun db/index/del (dbpath index-name fsymbol object)
|
(defun db/index/del (dbpath index-name fsymbol object)
|
||||||
(declare (type string dbpath index-name))
|
(declare (type string dbpath index-name))
|
||||||
(declare (type function fsymbol))
|
(declare (type function fsymbol))
|
||||||
(delete-file (db/index/get-symlink-path dbpath index-name fsymbol object)))
|
(delete-file (db/index/get-symlink-path dbpath index-name fsymbol object))
|
||||||
|
(values nil))
|
||||||
|
|
||||||
; Example: "./storage/cars/" "color" #'vehicle-color object "0000000015".
|
; Example: "./storage/cars/" "color" #'vehicle-color object "0000000015".
|
||||||
; -> "./storage/cars/partitions/by_color/Red/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)
|
(defun db/partition/get-symlink-path (dbpath partition-name fsymbol object file-name)
|
||||||
(declare (type string dbpath partition-name file-name))
|
(declare (type string dbpath partition-name file-name))
|
||||||
(declare (type function fsymbol))
|
(declare (type function fsymbol))
|
||||||
|
@ -143,6 +150,7 @@
|
||||||
; -> (osicat:make-link "./storage/cars/partitions/by_color/Red/0000000015"
|
; -> (osicat:make-link "./storage/cars/partitions/by_color/Red/0000000015"
|
||||||
; :target "../../../data/0000000015"
|
; :target "../../../data/0000000015"
|
||||||
; :hard nil)
|
; :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)
|
(defun db/partition/new (dbpath partition-name fsymbol object file-name)
|
||||||
(declare (type string dbpath partition-name file-name))
|
(declare (type string dbpath partition-name file-name))
|
||||||
(declare (type function fsymbol))
|
(declare (type function fsymbol))
|
||||||
|
@ -154,14 +162,19 @@
|
||||||
; works even when the database directory is moved
|
; works even when the database directory is moved
|
||||||
(osicat:make-link symlink-path
|
(osicat:make-link symlink-path
|
||||||
:target (concatenate 'string "../../../data/" file-name)
|
:target (concatenate 'string "../../../data/" file-name)
|
||||||
:hard nil)))
|
: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)
|
(defun db/partition/del (dbpath partition-name fsymbol object file-basename)
|
||||||
(declare (type string dbpath partition-name file-basename))
|
(declare (type string dbpath partition-name file-basename))
|
||||||
(declare (type function fsymbol))
|
(declare (type function fsymbol))
|
||||||
(delete-file (db/partition/get-symlink-path dbpath partition-name fsymbol object file-basename)))
|
(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)
|
(defun db/new-index (database index-name fsymbol)
|
||||||
|
(declare (type db database))
|
||||||
(declare (type string index-name))
|
(declare (type string index-name))
|
||||||
(declare (type function fsymbol))
|
(declare (type function fsymbol))
|
||||||
(let ((dbpath (db-path database))
|
(let ((dbpath (db-path database))
|
||||||
|
@ -178,8 +191,10 @@
|
||||||
(handler-case (db/index/new dbpath index-name fsymbol object (number->filename number))
|
(handler-case (db/index/new dbpath index-name fsymbol object (number->filename number))
|
||||||
(OSICAT-POSIX:EEXIST ()
|
(OSICAT-POSIX:EEXIST ()
|
||||||
(format t "dodb:db/new-index: symlink already exists, ignoring.~&"))))
|
(format t "dodb:db/new-index: symlink already exists, ignoring.~&"))))
|
||||||
(db-data database))))
|
(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)
|
(defun db/partition/update (dbpath partition-name fsymbol object file-name old-object)
|
||||||
(declare (type string dbpath partition-name file-name))
|
(declare (type string dbpath partition-name file-name))
|
||||||
(declare (type function fsymbol))
|
(declare (type function fsymbol))
|
||||||
|
@ -192,7 +207,9 @@
|
||||||
; create new partition
|
; create new partition
|
||||||
(db/partition/new dbpath partition-name fsymbol object file-name)))))
|
(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)
|
(defun db/new-partition (database partition-name fsymbol)
|
||||||
|
(declare (type db database))
|
||||||
(declare (type string partition-name))
|
(declare (type string partition-name))
|
||||||
(declare (type function fsymbol))
|
(declare (type function fsymbol))
|
||||||
(let ((dbpath (db-path database))
|
(let ((dbpath (db-path database))
|
||||||
|
@ -209,7 +226,8 @@
|
||||||
(handler-case (db/partition/new dbpath partition-name fsymbol object (number->filename number))
|
(handler-case (db/partition/new dbpath partition-name fsymbol object (number->filename number))
|
||||||
(OSICAT-POSIX:EEXIST ()
|
(OSICAT-POSIX:EEXIST ()
|
||||||
(format t "dodb:db/new-partition: symlink already exists, ignoring.~&"))))
|
(format t "dodb:db/new-partition: symlink already exists, ignoring.~&"))))
|
||||||
(db-data database))))
|
(db-data database)))
|
||||||
|
(values nil))
|
||||||
|
|
||||||
; Example: "./storage/cars/data/000000000000018".
|
; Example: "./storage/cars/data/000000000000018".
|
||||||
(declaim (ftype (function (string string) string) get-filepath))
|
(declaim (ftype (function (string string) string) get-filepath))
|
||||||
|
@ -217,7 +235,9 @@
|
||||||
(declare (type string dbpath file-name))
|
(declare (type string dbpath file-name))
|
||||||
(concatenate 'string dbpath "/data/" file-name))
|
(concatenate 'string dbpath "/data/" file-name))
|
||||||
|
|
||||||
|
(declaim (ftype (function (db atom) integer) db/add))
|
||||||
(defun db/add (database object)
|
(defun db/add (database object)
|
||||||
|
(declare (type db database))
|
||||||
(incf (db-current-index database))
|
(incf (db-current-index database))
|
||||||
(let* ((file-basename (number->filename (db-current-index database)))
|
(let* ((file-basename (number->filename (db-current-index database)))
|
||||||
(dbpath (db-path database))
|
(dbpath (db-path database))
|
||||||
|
@ -245,7 +265,9 @@
|
||||||
(setf (gethash (db-current-index database) (db-data database)) object)
|
(setf (gethash (db-current-index database) (db-data database)) object)
|
||||||
(db-current-index database))
|
(db-current-index database))
|
||||||
|
|
||||||
|
(declaim (ftype (function (db integer) null) db/del))
|
||||||
(defun db/del (database object-index)
|
(defun db/del (database object-index)
|
||||||
|
(declare (type db database))
|
||||||
(declare (type integer object-index))
|
(declare (type integer object-index))
|
||||||
(let ((file-basename (number->filename object-index))
|
(let ((file-basename (number->filename object-index))
|
||||||
(dbpath (db-path database))
|
(dbpath (db-path database))
|
||||||
|
@ -264,10 +286,13 @@
|
||||||
(db-partitions database))
|
(db-partitions database))
|
||||||
|
|
||||||
; remove in-memory data
|
; remove in-memory data
|
||||||
(remhash object-index (db-data database))))
|
(remhash object-index (db-data database)))
|
||||||
|
(values nil))
|
||||||
|
|
||||||
; Search for the data from the FS.
|
; 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)
|
(defun db/get-by-index (database index-name attribute-value)
|
||||||
|
(declare (type db database))
|
||||||
(declare (type string index-name))
|
(declare (type string index-name))
|
||||||
(let ((value (value->safe-string attribute-value)))
|
(let ((value (value->safe-string attribute-value)))
|
||||||
(filename->integer
|
(filename->integer
|
||||||
|
@ -276,13 +301,16 @@
|
||||||
(db/index/get-directory-path (db-path database) index-name) "/" value)))))
|
(db/index/get-directory-path (db-path database) index-name) "/" value)))))
|
||||||
|
|
||||||
; Search for the data from the FS.
|
; 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)
|
(defun db/get-by-partition (database name attribute-value)
|
||||||
|
(declare (type db database))
|
||||||
(declare (type string name))
|
(declare (type string name))
|
||||||
(let ((value (value->safe-string attribute-value))
|
(let ((value (value->safe-string attribute-value))
|
||||||
(dbpath (db-path database)))
|
(dbpath (db-path database)))
|
||||||
(loop for filename in (osicat:list-directory (db/partition/get-directory-path dbpath name value))
|
(loop for filename in (osicat:list-directory (db/partition/get-directory-path dbpath name value))
|
||||||
collect (filename->integer filename))))
|
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)
|
(defun db/index/update (dbpath index-name fsymbol object file-name old-object)
|
||||||
(declare (type string dbpath index-name file-name))
|
(declare (type string dbpath index-name file-name))
|
||||||
(declare (type function fsymbol))
|
(declare (type function fsymbol))
|
||||||
|
@ -301,7 +329,9 @@
|
||||||
|
|
||||||
; TODO: check database integrity (redundancy)
|
; TODO: check database integrity (redundancy)
|
||||||
; TODO: locking
|
; TODO: locking
|
||||||
|
(declaim (ftype (function (db integer) null) db/update))
|
||||||
(defun db/update (database object-index)
|
(defun db/update (database object-index)
|
||||||
|
(declare (type db database))
|
||||||
(declare (type integer object-index))
|
(declare (type integer object-index))
|
||||||
(let* ((object (gethash object-index (db-data database)))
|
(let* ((object (gethash object-index (db-data database)))
|
||||||
(dbpath (db-path database))
|
(dbpath (db-path database))
|
||||||
|
@ -327,8 +357,12 @@
|
||||||
; handle partitions
|
; handle partitions
|
||||||
(maphash #'(lambda (partition-name fsymbol)
|
(maphash #'(lambda (partition-name fsymbol)
|
||||||
(db/partition/update dbpath partition-name fsymbol object file-basename old-object))
|
(db/partition/update dbpath partition-name fsymbol object file-basename old-object))
|
||||||
(db-partitions database))))
|
(db-partitions database)))
|
||||||
|
(values nil))
|
||||||
|
|
||||||
|
(declaim (ftype (function (db) null) db/drop-everything))
|
||||||
(defun db/drop-everything (database)
|
(defun db/drop-everything (database)
|
||||||
|
(declare (type db database))
|
||||||
(osicat:delete-directory-and-files (db-path database))
|
(osicat:delete-directory-and-files (db-path database))
|
||||||
(clrhash (db-data database)))
|
(clrhash (db-data database))
|
||||||
|
(values nil))
|
||||||
|
|
Loading…
Reference in New Issue