diff --git a/src/dodb.cl b/src/dodb.cl index 1d62632..a6e38d1 100755 --- a/src/dodb.cl +++ b/src/dodb.cl @@ -1,7 +1,7 @@ #!/usr/local/bin/clisp -(load "~/.quicklisp/setup.lisp") -(ql:quickload "osicat") +;(load "~/.quicklisp/setup.lisp") +;(ql:quickload "osicat") (load "./util.cl") (defpackage :dodb @@ -14,6 +14,16 @@ )) (in-package dodb) +;(defun ln (path &key target hard) +; (format t "SYMLINK: ~A -> ~A~&" path target)) +; ; (osicat:make-link symlink-path +; ; :target (concatenate 'string "../../data/" file-name) +; ; :hard nil)) + +;(defmacro alias (to fn) +; `(setf (fdefinition ',to) #',fn)) +;(alias ln osicat:make-link) + ; TODO: equivalent in Crystal ; cars = DODB::DataBase(Car).new "./storage" ; cars_by_name = cars.new_index "name", &.name @@ -37,28 +47,39 @@ (ensure-directories-exist (concatenate 'string path "/data/")) (make-db :struct-name struct-name :path path)) -; example: db-path/by_name/ +; example: db-path/indexes/by_name/ (defun db/new-index (database attribute-name) ; Create a directory for the indexes. (ensure-directories-exist - (concatenate 'string (db-path database) "/by_" attribute-name "/")) + (concatenate 'string (db-path database) "/indexes/by_" attribute-name "/")) ; Add this new index to the list. (push attribute-name (db-indexes database))) +; example: db-path/partitions/by_color/ +(defun db/new-partition (database attribute-name) + ; Create a directory for the partitions. + (ensure-directories-exist + (concatenate 'string (db-path database) "/partitions/by_" attribute-name "/")) + ; Add this new index to the list. + (push attribute-name (db-partitions database))) + (defun to-upper-case (some-string) (format nil "~@:(~a~)" some-string)) +(defun get-object-attribute (database attribute-name object) + (funcall ; example: call function "VEHICLE-COLOR" + (find-symbol (to-upper-case + (concatenate 'string (db-struct-name database) "-" attribute-name))) + object)) + ; Returns "Corvet". (defun db/index/get-filename (database index-name object) - (funcall ; example: call function "VEHICLE-NAME" - (find-symbol (to-upper-case - (concatenate 'string (db-struct-name database) "-" index-name))) - object)) + (get-object-attribute database index-name object)) (defun db/index/get-symlink-path (database index-name object) (concatenate 'string (db-path database) - "/by_" index-name "/" + "/indexes/by_" index-name "/" (db/index/get-filename database index-name object))) (defun db/index/new (database index-name object file-name) @@ -66,8 +87,32 @@ (db/index/get-symlink-path database index-name object))) ; Works even when the database directory is moved. - (osicat:make-link symlink-path - :target (concatenate 'string "../data/" file-name) + (ln symlink-path + :target (concatenate 'string "../../data/" file-name) + :hard nil) + )) + +; Returns "Red". +(defun db/partition/get-filename (database partition-name object) + (get-object-attribute database partition-name object)) + +(defun db/partition/get-symlink-path (database partition-name object file-name) + (concatenate 'string + (db-path database) + "/partitions/by_" partition-name "/" + (db/partition/get-filename database partition-name object) "/" + file-name + )) + +(defun db/partition/new (database partition-name object file-name) + (let ((symlink-path + (db/partition/get-symlink-path database partition-name object file-name))) + + (ensure-directories-exist symlink-path) + + ; Works even when the database directory is moved. + (ln symlink-path + :target (concatenate 'string "../../../data/" file-name) :hard nil) )) @@ -86,11 +131,13 @@ object (db/add/new-data-filepath database file-name)) - ; TODO: handle indexes + ; handle indexes (loop for index in (db-indexes database) do (db/index/new database index object file-name)) ; TODO: handle partitions + (loop for partition in (db-partitions database) + do (db/partition/new database partition object file-name)) ) ) @@ -99,8 +146,10 @@ ; TODO (setf cars (db/new "vehicle" "./storage/cars/")) -; (format t "~&~S~&" cars) + (db/new-index cars "name") +(db/new-partition cars "color") + (db/add cars (make-vehicle :name "Corvet" :color "Red")) (format t "~&~S~&" cars)