From bf48130837aac3f104b24203cc3a36ce5ec61742 Mon Sep 17 00:00:00 2001 From: Helmut Merz Date: Fri, 2 Aug 2024 14:05:42 +0200 Subject: [PATCH] tracking:save, work in progress: use property list for data comparison --- storage/tracking.lisp | 46 ++++++++++++++++++++++-------------------- test/test-storage.lisp | 3 ++- 2 files changed, 26 insertions(+), 23 deletions(-) diff --git a/storage/tracking.lisp b/storage/tracking.lisp index 141da23..bb8696d 100644 --- a/storage/tracking.lisp +++ b/storage/tracking.lisp @@ -48,35 +48,37 @@ (defun query-last (cont head-plist) (let ((parts (util:plist-pairs head-plist))) - (query-one cont (make-where parts) :order-by '((:desc :timestamp))))) + (query-one cont (make-where parts) :order-by '((:desc :trackid))))) (defun get-track (cont trid) (query-one cont (make-where (list (list :trackid trid))))) ;(query-one cont (list := :trackid trid))) -(defun save (track) - ;(let ((cont ... - ; (if (eql force-insert :always) (insert track) - (let* ((*build-track-data* #'identity) ; keep hash-table for comparison - (new-data (alx:plist-hash-table (shape:data track))) - (cont (container track)) - (found (query-last cont (shape:head-plist track))) - (force-insert (force-insert-when cont))) - (if (or (null found) (eql force-insert :always)) - (insert track new-data) - (unless (equalp (shape:data found) new-data) - (if (eql force-insert :changed) - (insert track new-data) - (update track new-data)))))) - (defun query-one (cont crit &key order-by) - (util:lgd crit) - (let* ((tr (make-item cont)) - (st (storage cont)) - (row (car (storage:query st - (setup-select cont crit :order-by order-by :limit 1))))) + ;(util:lgd crit) + (let ((tr (make-item cont)) + (row (car (storage:query (storage cont) + (setup-select cont crit :order-by order-by :limit 1))))) (setup-track tr row))) +(defun save (track) + (let* ((cont (container track)) + (force-insert (force-insert-when cont))) + (if (eql force-insert :always) + (insert track) + (let* ((new-data (shape:data track)) + (found (query-last cont (shape:head-plist track)))) + (if (null found) + (insert track new-data) + (unless (plist-equal (shape:data found) new-data) + (if (eql force-insert :changed) + (insert track new-data) + (update track new-data)))))))) + +(defun plist-equal (l1 l2) + (util:lgi l1 l2) + (equalp l1 l2)) + (defun insert (track &optional data) (ensure-timestamp track) (let* ((cont (container track)) @@ -103,7 +105,7 @@ (defun setup-select (cont crit &key order-by limit) (let ((table (storage:qualified-table-name (storage cont) (table-name cont))) (cols (cons :trackid (append (item-head-fields cont) '(:timestamp :data)))) - (clauses)) + clauses) (if limit (push (sxql:limit limit) clauses)) (if order-by diff --git a/test/test-storage.lisp b/test/test-storage.lisp index 3fec21b..a97bfae 100644 --- a/test/test-storage.lisp +++ b/test/test-storage.lisp @@ -74,5 +74,6 @@ (== (getf (shape:data pm2) :info) "test data") (setf pm3 (tracking:query-last cont '(:domain :test))) (util:lgi pm3) - ;(log:info "pm3: ~s" pm3) + ;(setf (getf (shape:data pm3) :info) "changed") + (msgstore:save pm3 cont) ))