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) (defun query (st spec)
(multiple-value-bind (sql args) (sxql:yield spec) (multiple-value-bind (sql args) (sxql:yield spec)
;(util:logd sql args) ;(util:lgd sql args)
(let* ((qp (dbi:prepare (conn st) sql)) (let* ((qp (dbi:prepare (conn st) sql))
(qx (dbi:execute qp args))) (qx (dbi:execute qp args)))
(mapcar #'normalize-plist (dbi:fetch-all qx))))) (mapcar #'normalize-plist (dbi:fetch-all qx)))))

12
storage/tracking.lisp
View file

@ -88,7 +88,6 @@
(force-insert (force-insert-when cont))) (force-insert (force-insert-when cont)))
(if (eql force-insert :always) (if (eql force-insert :always)
(insert track) (insert track)
;(let ((found (query-last cont (shape:head-plist track))))
(let ((found (query-last cont (keys-plist track)))) (let ((found (query-last cont (keys-plist track))))
(if found (if found
(if (track-equal found track) (if (track-equal found track)
@ -96,10 +95,10 @@
(if (eql force-insert :changed) (if (eql force-insert :changed)
(insert track) (insert track)
(progn (progn
(setf (trackid track) (trackid found))
(unless (timestamp track) (unless (timestamp track)
(setf (timestamp track) (timestamp found))) (setf (timestamp track) (timestamp found)))
(update track) (update track)
(setf (trackid track) (trackid found))
track))) track)))
(insert track)))))) (insert track))))))
@ -143,10 +142,11 @@
(push (sxql:limit limit) clauses)) (push (sxql:limit limit) clauses))
(if order-by (if order-by
(push (sxql:order-by (values-list order-by)) clauses)) (push (sxql:order-by (values-list order-by)) clauses))
(sxql:select cols (if crit
(sxql:from table) (push (sxql:where crit) clauses))
(sxql:where crit) (if clauses
(values-list clauses)))) (sxql:select cols (sxql:from table) (values-list clauses))
(sxql:select cols (sxql:from table)))))
(defun make-where (specs) (defun make-where (specs)
(let (crit) (let (crit)

11
test/test-storage.lisp
View file

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