cco/cl-scopes
3
0
Fork 0
Code Issues 1 Pull requests Releases Wiki Activity Actions

util:plist-equal (for tracking:save); work in progress: tracking:update; save: return track

Browse source
This commit is contained in:
Helmut Merz 2024-08-03 20:45:24 +02:00
parent bf48130837
commit 75fe19b269
3 changed files with 13 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
storage/tracking.lisp
View file

@ -70,15 +70,11 @@
(found (query-last cont (shape:head-plist track)))) (found (query-last cont (shape:head-plist track))))
(if (null found) (if (null found)
(insert track new-data) (insert track new-data)
(unless (plist-equal (shape:data found) new-data) (unless (util:plist-equal (shape:data found) new-data)
(if (eql force-insert :changed) (if (eql force-insert :changed)
(insert track new-data) (insert track new-data)
(update track new-data)))))))) (update track new-data))))))))
(defun plist-equal (l1 l2)
(util:lgi l1 l2)
(equalp l1 l2))
(defun insert (track &optional data) (defun insert (track &optional data)
(ensure-timestamp track) (ensure-timestamp track)
(let* ((cont (container track)) (let* ((cont (container track))
@ -96,9 +92,10 @@
(let* ((cont (container track)) (let* ((cont (container track))
(st (storage cont)) (st (storage cont))
(table (storage:qualified-table-name st (table-name cont)))) (table (storage:qualified-table-name st (table-name cont))))
(sxql:update table (storage:do-sql st
(apply #'sxql:make-clause ':set= (plist track data)) (sxql:update table
(where (:= :trackid (trackid track)))))) (apply #'sxql:make-clause ':set= (plist track data))
(where (:= :trackid (trackid track)))))))
;;;; auxiliary functions for queries, ... ;;;; auxiliary functions for queries, ...

3
test/test-storage.lisp
View file

@ -74,6 +74,7 @@
(== (getf (shape:data pm2) :info) "test data") (== (getf (shape:data pm2) :info) "test data")
(setf pm3 (tracking:query-last cont '(:domain :test))) (setf pm3 (tracking:query-last cont '(:domain :test)))
(util:lgi pm3) (util:lgi pm3)
;(setf (getf (shape:data pm3) :info) "changed") (msgstore:save pm3 cont)
(setf (getf (shape:data pm3) :info) "changed")
(msgstore:save pm3 cont) (msgstore:save pm3 cont)
)) ))

7
util.lisp
View file

@ -3,7 +3,7 @@
(defpackage :scopes/util (defpackage :scopes/util
(:use :common-lisp) (:use :common-lisp)
(:export #:lg #:lgd #:lgi (:export #:lg #:lgd #:lgi
#:rtrim #:loop-plist #:plist-pairs #:rtrim #:loop-plist #:plist-pairs #:plist-equal
#:flatten-str #:to-keyword #:keyword-to-string #:to-string #:flatten-str #:to-keyword #:keyword-to-string #:to-string
#:absolute-dir #:check-dir #:ensure-dir #:home-path #:path-from-string #:absolute-dir #:check-dir #:ensure-dir #:home-path #:path-from-string
#:relative-path #:runtime-path #:system-path)) #:relative-path #:runtime-path #:system-path))
@ -29,6 +29,11 @@
(defun plist-pairs (pl) (defun plist-pairs (pl)
(loop-plist pl k v collect (list k v))) (loop-plist pl k v collect (list k v)))
(defun plist-equal (l1 l2)
(loop-plist l1 k v do
(unless (equal (getf l2 k) v)
(return-from plist-equal nil)))
t)
;;;; strings, symbols, keywords, ... ;;;; strings, symbols, keywords, ...
(defun flatten-str (s &key (sep " ")) (defun flatten-str (s &key (sep " "))