tracking:save: use - optionally restricted - key-fields instead of all head-fields for query

storage/tracking.lisp

@@ -21,10 +21,21 @@
 (defvar *build-track-data* #'alx:hash-table-plist)
 
 (defclass track (shape:record)
-  ((trackid :accessor trackid :initform nil)
+  ((key-fields :reader key-fields :initarg :key-fields :initform nil :allocation :class)
+   (trackid :accessor trackid :initform nil)
    (timestamp :accessor timestamp :initform nil)
    (container :reader container :initarg :container)))
 
+(defun keys-plist (rec)
+  (let ((kf (key-fields rec))
+        (hv (shape:head-plist rec)))
+    (if kf
+      (util:filter-plist hv kf)
+      hv)))
+
+(defun uid (tr)
+  (format nil "~(~a~)-~a" (short-name (container tr)) (trackid tr)))
+
 (defun timestamp-to-sql (tr ts)
   (funcall (getf (storage:params (storage (container tr))) :ts-sql) ts))
 
@@ -77,7 +88,8 @@
          (force-insert (force-insert-when cont)))
     (if (eql force-insert :always)
       (insert track)
-      (let ((found (query-last cont (shape:head-plist track))))
+      ;(let ((found (query-last cont (shape:head-plist track))))
+      (let ((found (query-last cont (keys-plist track))))
         (if found
           (if (track-equal found track)
             found

test/test-storage.lisp

@@ -84,8 +84,9 @@
 (deftest test-folder (ctx)
   (let ((st (storage:storage ctx))
         (data (make-hash-table))
-        cont f1 f2 f3)
+        cont root f1 f2 f3)
     (setf cont (folder:make-container st))
     (storage:drop-table st :folders)
     (tracking:create-table cont)
+    ;(setf root (folder:root))
     ))

util.lisp

@@ -3,7 +3,7 @@
 (defpackage :scopes/util
   (:use :common-lisp)
   (:export #:lg #:lgd #:lgi
-           #:rtrim #:loop-plist #:plist-pairs #:plist-equal
+           #:rtrim #:loop-plist #:filter-plist #:plist-pairs #:plist-equal
            #:flatten-str #:to-keyword #:keyword-to-string #:to-string
            #:absolute-dir #:check-dir #:ensure-dir #:home-path #:path-from-string
            #:relative-path #:runtime-path #:system-path))
@@ -26,10 +26,15 @@
 (defmacro loop-plist (plist kvar vvar &body body)
   `(loop for (,kvar ,vvar . nil) on ,plist by #'cddr ,@body))
 
+(defun filter-plist (pl keys)
+  (loop-plist pl k v when (find k keys) collect v))
+
 (defun plist-pairs (pl)
   (loop-plist pl k v collect (list k v)))
 
 (defun plist-equal (l1 l2)
+  (unless (= (length l1) (length l2))
+    (return-from plist-equal nil))
   (loop-plist l1 k v do
     (unless (equal (getf l2 k) v)
       (return-from plist-equal nil)))