temp commit

TODO.md

@@ -6,3 +6,4 @@
 - Check for TODOs
 - For indexes and partitions: check that the structure attribute exists.
 - Verify names of indexes and partitions: names are directly related to directory paths.
+- db/data-filepath instead of get-filepath.

src/main.lisp

@@ -24,27 +24,18 @@
 (defun number->filename (number)
   (format nil "~15,'0D" number))
 
-; Example: "vehicle" "color" object -> (vehicle-color object) -> "Red"
-(defun get-object-attribute (struct-name attribute-name object)
-  (funcall ; example: call function "VEHICLE-COLOR"
-    (find-symbol (to-upper-case
-      (concatenate 'string struct-name "-" attribute-name)))
-    object))
-
 ; index = 1-1
 ; partition = 1-n
 (defstruct db
-  struct-name              ; String
+  path                           ; Path
-  path                     ; Path
+  (indexes    (make-hash-table)) ; {String => #'FUNCTION-NAME}
-  (indexes ())             ; [String]
+  (partitions (make-hash-table)) ; {String => #'FUNCTION-NAME}
-  (partitions ())          ; [String]
+  (current-index 0)              ; Int
-  (current-index 0)        ; Int
+  (data (make-hash-table)))      ; {Int -> struct}
-  (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.
-(defun db/new (struct-name path)
+(defun db/new (path)
   (let ((data (make-hash-table))
         (data-dir-path (concatenate 'string path "/data/"))
         (current-index 0))
@@ -59,7 +50,6 @@
                (setf (gethash id data) value)))
 
     (make-db
-      :struct-name struct-name
       :path path
       :data data
       :current-index current-index)))
@@ -72,56 +62,49 @@
   (concatenate 'string dbpath "/data/" (number->filename number)))
 
 ; Example: returns "./storage/cars/indexes/by_name/".
-(defun db/index/get-directory-path (database object-attribute)
+(defun db/index/get-directory-path (dbpath object-attribute)
   (let ((name (typecase object-attribute
                  (string object-attribute)
                  (symbol (symbol-name object-attribute))
-                 (t (format nil "~A" object-attribute))))
+                 (t (format nil "~A" object-attribute)))))
-        (dbpath (db-path database)))
   (concatenate 'string dbpath "/indexes/by_" name "/")))
 
 ; Example: returns "./storage/cars/partitions/by_color/Red/".
-(defun db/partition/get-directory-path (database name object-attribute)
+(defun db/partition/get-directory-path (dbpath name object-attribute)
   (let ((value (typecase object-attribute
                  (string object-attribute)
                  (symbol (symbol-name object-attribute))
-                 (t (format nil "~A" object-attribute))))
+                 (t (format nil "~A" object-attribute)))))
-        (dbpath (db-path database)))
   (concatenate 'string dbpath "/partitions/by_" name "/" value "/")))
 
-; Example: returns "Corvet".
-(defun db/index/get-filename (database index-name object)
-  (get-object-attribute (db-struct-name database) index-name object))
-
 ; Example: database "name" object -> "./storage/cars/indexes/by_name/Corvet".
-(defun db/index/get-symlink-path (database index-name object)
+(defun db/index/get-symlink-path (dbpath index-name fsymbol object)
   (concatenate 'string
-    (db/index/get-directory-path database index-name)
+    (db/index/get-directory-path dbpath index-name)
-    (db/index/get-filename database index-name object)))
+    (funcall fsymbol object)))
 
 ; Example: database "name" object "0000000015"
 ;   -> (osicat:make-link "./storage/cars/indexes/by_name/Corvet"
 ;          :target "../../data/0000000015"
 ;          :hard nil)
-(defun db/index/new (database index-name object file-name)
+(defun db/index/new (dbpath index-name fsymbol object file-name)
-  (let ((symlink-path (db/index/get-symlink-path database index-name object)))
+  (let ((symlink-path (db/index/get-symlink-path dbpath index-name fsymbol object)))
 
     ; Works even when the database directory is moved.
     (osicat:make-link symlink-path
       :target (concatenate 'string "../../data/" file-name)
-      :hard nil)
+      :hard nil)))
-  ))
 
-(defun db/index/del (database index-name object)
+(defun db/index/del (dbpath index-name fsymbol object)
-  (delete-file (db/index/get-symlink-path database index-name object)))
+  (delete-file (db/index/get-symlink-path dbpath index-name fsymbol object)))
 
 ; Example: database "color" object
 ;   -> "./storage/cars/partitions/by_color/Red/0000000015".
-(defun db/partition/get-symlink-path (database partition-name object file-name)
+(defun db/partition/get-symlink-path (dbpath partition-name fsymbol object file-name)
   (concatenate 'string
-    (db/partition/get-directory-path database partition-name
+    (db/partition/get-directory-path dbpath partition-name
       ; example: "Red"
-      (get-object-attribute (db-struct-name database) partition-name object))
+      (funcall fsymbol object))
     ; example: "0000000015"
     file-name))
 
@@ -129,9 +112,9 @@
 ;   -> (osicat:make-link "./storage/cars/partitions/by_color/Red/0000000015"
 ;          :target "../../../data/0000000015"
 ;          :hard nil)
-(defun db/partition/new (database partition-name object file-name)
+(defun db/partition/new (dbpath partition-name fsymbol object file-name)
   (let ((symlink-path
-      (db/partition/get-symlink-path database partition-name object file-name)))
+      (db/partition/get-symlink-path dbpath partition-name fsymbol object file-name)))
 
     (ensure-directories-exist symlink-path)
 
@@ -140,64 +123,66 @@
       :target (concatenate 'string "../../../data/" file-name)
       :hard nil)))
 
-(defun db/partition/del (database partition-name object file-basename)
+(defun db/partition/del (dbpath partition-name fsymbol object file-basename)
-  (delete-file (db/partition/get-symlink-path database partition-name object file-basename)))
+  (delete-file (db/partition/get-symlink-path dbpath partition-name fsymbol object file-basename)))
 
 ; example: db-path/indexes/by_name/
-(defun db/new-index (database attribute-name)
+(defun db/new-index (database attribute-name fsymbol)
   ; Create a directory for the indexes.
   (ensure-directories-exist
     (concatenate 'string (db-path database) "/indexes/by_" attribute-name "/"))
 
   ; Add this new index to the list.
-  (push attribute-name (db-indexes database))
+  (setf (gethash attribute-name (db-indexes database)) fsymbol)
 
   ; Generate index for all DB elements.
   (maphash #'(lambda (number element)
-      (handler-case (db/index/new database attribute-name element (number->filename number))
+      (handler-case (db/index/new (db-path database) attribute-name fsymbol element (number->filename number))
         (OSICAT-POSIX:EEXIST ()
           (format t "db/new-index: symlink already exists, ignoring.~&"))))
     (db-data database)))
 
-(defun db/partition/update (database partition-name object file-name old-object)
+(defun db/partition/update (dbpath partition-name fsymbol object file-name old-object)
-  (let ((new-value (get-object-attribute (db-struct-name database) partition-name object))
+  (let ((new-value (funcall fsymbol object))
-        (old-value (get-object-attribute (db-struct-name database) partition-name old-object)))
+        (old-value (funcall fsymbol old-object)))
     (if (not (equal new-value old-value))
       (progn
         ; delete old partition
-        (db/partition/del database partition-name old-object file-name)
+        (db/partition/del dbpath partition-name fsymbol old-object file-name)
         ; create new partition
-        (db/partition/new database partition-name object file-name)))))
+        (db/partition/new dbpath partition-name fsymbol object file-name)))))
 
 ; example: db-path/partitions/by_color/
-(defun db/new-partition (database attribute-name)
+(defun db/new-partition (database attribute-name fsymbol)
-  ; Create a directory for the partitions.
+  (let (dbpath (db-path database))
-  (ensure-directories-exist
+    ; create a directory for the partitions
-    (concatenate 'string (db-path database) "/partitions/by_" attribute-name "/"))
+    (ensure-directories-exist
+      (concatenate 'string dbpath "/partitions/by_" attribute-name "/"))
 
-  ; Add this new index to the list.
+    ; add this new partition to the list
-  (push attribute-name (db-partitions database))
+    (setf (gethash attribute-name (db-partitions database)) fsymbol)
 
-  ; Generate partition for all DB elements.
+    ; generate partition for all DB elements
-  (maphash #'(lambda (number element)
+    (maphash #'(lambda (number object)
-      (handler-case (db/partition/new database attribute-name element (number->filename number))
+        (handler-case (db/partition/new dbpath attribute-name fsymbol object (number->filename number))
-        (OSICAT-POSIX:EEXIST ()
+          (OSICAT-POSIX:EEXIST ()
-          (format t "db/new-partition: symlink already exists, ignoring.~&"))))
+            (format t "db/new-partition: symlink already exists, ignoring.~&"))))
-    (db-data database)))
+      (db-data database))))
 
 ; Example: database -> "000000000000018".
 (defun db/add/new-data-basename (database)
   (number->filename (db-current-index database)))
 
 ; Example: {db-path}/data/000000000000018
-(defun get-filepath (database file-name)
+(defun get-filepath (dbpath file-name)
-  (concatenate 'string (db-path database) "/data/" file-name))
+  (concatenate 'string dbpath "/data/" file-name))
 
 (defun db/add (database object)
   (incf (db-current-index database))
   (let* ((file-basename     (db/add/new-data-basename database))
+         (dbpath            (db-path database))
          (tmp-file-basename (concatenate 'string file-basename "_tmp"))
-         (tmp-file-path     (get-filepath database tmp-file-basename)))
+         (tmp-file-path     (get-filepath dbpath tmp-file-basename)))
 
     ; write object to temporary file
     (util:write-object-to-file object tmp-file-path)
@@ -205,13 +190,15 @@
     ; rename the temporary file
     (rename-file tmp-file-path file-basename)
 
-    ; handle indexes
+    ; generate indexes
-    (loop for index in (db-indexes database)
+    (maphash #'(lambda (index-name fsymbol)
-       do (db/index/new database index object file-basename))
+        (db/index/new dbpath index-name fsymbol object file-basename))
+      (db-indexes database))
 
-    ; handle partitions
+    ; generate partitions
-    (loop for partition in (db-partitions database)
+    (maphash #'(lambda (partition-name fsymbol)
-       do (db/partition/new database partition object file-basename)))
+        (db/partition/new dbpath partition-name fsymbol object file-basename))
+      (db-partitions database)))
 
   ; store new in-memory data
   ; database.data[database.current-index] = object
@@ -220,17 +207,20 @@
 
 (defun db/del (database object-index)
   (let ((file-basename (number->filename object-index))
-        (object (gethash object-index (db-data database))))
+        (dbpath        (db-path database))
+        (object        (gethash object-index (db-data database))))
     ; remove data file
-    (delete-file (get-filepath database file-basename))
+    (delete-file (get-filepath dbpath file-basename))
 
     ; handle indexes
-    (loop for index in (db-indexes database)
+    (maphash #'(lambda (index-name fsymbol)
-       do (db/index/del database index object))
+        (db/index/del dbpath index-name fsymbol object))
+      (db-indexes database))
 
     ; handle partitions
-    (loop for partition in (db-partitions database)
+    (maphash #'(lambda (partition-name fsymbol)
-       do (db/partition/del database partition object file-basename))
+        (db/partition/del dbpath partition-name fsymbol object file-basename))
+      (db-partitions database))
 
     ; remove in-memory data
     (remhash object-index (db-data database))))
@@ -240,52 +230,52 @@
   (filename->integer
     (osicat:read-link
       (concatenate 'string
-        (db/index/get-directory-path database index-name) "/" value))))
+        (db/index/get-directory-path (db-path database) index-name) "/" value))))
-;  (util:read-object-from-file (concatenate 'string
-;    (db/index/get-directory-path database index-name) "/" value)))
 
 ; Search for the data from the FS.
 (defun db/get-by-partition (database name value)
   (loop for filename in (osicat:list-directory (db/partition/get-directory-path database name value))
         collect (filename->integer filename)))
 
-(defun db/index/update (database index-name object file-name old-object)
+(defun db/index/update (dbpath index-name fsymbol object file-name old-object)
-  (let* ((struct-name (db-struct-name database))
+  (let* ((new-value    (funcall fsymbol object))
-         (new-value (get-object-attribute struct-name index-name object))
+         (old-value    (funcall fsymbol old-object))
-         (old-value (get-object-attribute struct-name index-name old-object))
+         (symlink-path (db/index/get-symlink-path dbpath index-name fsymbol object)))
-         (symlink-path (db/index/get-symlink-path database index-name 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 "db/index/update: the value ~a is already used by another object.~&" new-value)
           (progn
             ; delete old index
-            (db/index/del database index-name old-object)
+            (db/index/del dbpath index-name fsymbol old-object)
             ; create new index
-            (db/index/new database index-name object file-name))))))
+            (db/index/new dbpath index-name fsymbol object file-name))))))
 
 ; TODO: check database integrity (redundancy)
 ; TODO: locking
 (defun db/update (database object-index)
   (let* ((object            (gethash object-index (db-data database)))
+         (dbpath            (db-path database))
          (file-basename     (number->filename object-index))
-         (file-path         (get-filepath database file-basename))
+         (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 database tmp-file-basename)))
+         (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)
+    (delete-file file-path)
 
     ; rename the temporary file
     (rename-file tmp-file-path file-basename)
 
     ; handle indexes
-    (loop for index in (db-indexes database)
+    (maphash #'(lambda (index-name fsymbol)
-       do (db/index/update database index object file-basename old-object))
+        (db/index/update dbpath index-name fsymbol object file-basename old-object))
+      (db-indexes database))
 
     ; handle partitions
-    (loop for partition in (db-partitions database)
+    (maphash #'(lambda (partition-name fsymbol)
-       do (db/partition/update database partition object file-basename old-object))))
+        (db/partition/update dbpath partition-name fsymbol object file-basename old-object))
+      (db-partitions database)))