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

tracking: test and improve query / setup-select

Browse source
This commit is contained in:
Helmut Merz 2024-08-09 09:30:25 +02:00
parent 997b0afb0e
commit dd4f8ccebd
3 changed files with 14 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
storage/storage.lisp
View file

@ -64,7 +64,7 @@
(defun query (st spec)
(multiple-value-bind (sql args) (sxql:yield spec)
;(util:logd sql args)
;(util:lgd sql args)
(let* ((qp (dbi:prepare (conn st) sql))
(qx (dbi:execute qp args)))
(mapcar #'normalize-plist (dbi:fetch-all qx)))))

12
storage/tracking.lisp
View file

@ -88,7 +88,6 @@
(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 (keys-plist track))))
(if found
(if (track-equal found track)
@ -96,10 +95,10 @@
(if (eql force-insert :changed)
(insert track)
(progn
(setf (trackid track) (trackid found))
(unless (timestamp track)
(setf (timestamp track) (timestamp found)))
(update track)
(setf (trackid track) (trackid found))
track)))
(insert track))))))
@ -143,10 +142,11 @@
(push (sxql:limit limit) clauses))
(if order-by
(push (sxql:order-by (values-list order-by)) clauses))
(sxql:select cols
(sxql:from table)
(sxql:where crit)
(values-list clauses))))
(if crit
(push (sxql:where crit) clauses))
(if clauses
(sxql:select cols (sxql:from table) (values-list clauses))
(sxql:select cols (sxql:from table)))))
(defun make-where (specs)
(let (crit)

11
test/test-storage.lisp
View file

@ -63,8 +63,7 @@
(deftest test-msgstore (ctx)
(let ((st (storage:storage ctx))
(data (make-hash-table))
cont msg pm pm2 pm3)
cont msg pm pm2 pm3 r1)
(setf cont (msgstore:make-container st))
(storage:drop-table st :messages)
(tracking:create-table cont)
@ -75,15 +74,17 @@
(== (shape:head pm2) '(:test :data :field nil))
(== (getf (shape:data pm2) :info) "test data")
(setf pm3 (tracking:query-last cont '(:domain :test)))
(util:lgi pm3)
;(util:lgi pm3)
(msgstore:save pm3 cont)
(setf (getf (shape:data pm3) :info) "changed")
(msgstore:save pm3 cont)
;(setf r1 (tracking:query cont '(:= :domain "test")))
(setf r1 (tracking:query cont nil))
(== (length r1) 2)
))
(deftest test-folder (ctx)
(let ((st (storage:storage ctx))
(data (make-hash-table))
cont root f1 f2 f3)
(setf cont (folder:make-container st))
(storage:drop-table st :folders)
@ -92,4 +93,6 @@
(== (tracking:trackid root) 1)
(== (shape:head-value root :parentid) nil)
(setf f1 (folder:create :child1 root))
(== (tracking:trackid f1) 2)
(== (shape:head-value f1 :parentid) "1")
))