tracking: query-last, save basically OK

This commit is contained in:
Helmut Merz 2024-08-01 10:47:39 +02:00
parent b09319916c
commit 2111c7313a
5 changed files with 26 additions and 18 deletions

View file

@ -27,4 +27,4 @@
(let ((pm (make-instance 'pmsg
:head (shape:head msg) :data (shape:data msg)
:container cont)))
(tracking:insert pm)))
(tracking:save pm)))

View file

@ -64,7 +64,7 @@
(defun query (st spec)
(multiple-value-bind (sql args) (sxql:yield spec)
;(log:info "sql: ~s, args: ~s" sql args)
;(util:logd sql args)
(let* ((qp (dbi:prepare (conn st) sql))
(qx (dbi:execute qp args)))
(dbi:fetch-all qx))))

View file

@ -46,19 +46,22 @@
(defun make-item (cont &rest head)
(make-instance (item-class cont) :head head :container cont))
(defun query-last (cont &rest head-specs)
(query-one cont (make-where head-specs) :order-by '((:desc :timestamp))))
(defun query-last (cont head-plist)
(let ((parts (util:plist-pairs head-plist)))
(query-one cont (make-where parts) :order-by '((:desc :timestamp)))))
(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 (eq 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))))
(force-insert (force-insert-when cont)))
(if (or (null found) (eq force-insert :always))
(insert track new-data)
(unless (equalp (shape:data found) new-data)
@ -121,7 +124,8 @@
(car crit))))
(defun setup-track (tr row)
;(log:info "tr: ~s, row: ~s" tr row)
;(util:logd tr row)
(when row
(let ((hv (mapcar #'(lambda (x) (util:to-keyword (getf row x)))
(shape:head-fields tr))))
(setf (shape:head tr) hv)
@ -130,7 +134,7 @@
(setf (shape:data tr)
(funcall *build-track-data*
(jzon:parse (getf row :data) :key-fn #'util:to-keyword)))
tr))
tr)))
(defun ensure-timestamp (track)
(if (not (time-stamp track))

View file

@ -64,7 +64,8 @@
(deftest test-util ()
(== (util:rtrim '(1 2 nil 3 nil)) '(1 2 nil 3))
(== (util:to-keyword "hello-kitty") :hello-kitty)
(== (util:loop-plist '(:a "a" :b "b") k v collect (string-upcase k)) '("A" "B")))
(== (util:loop-plist '(:a "a" :b "b") k v collect (string-upcase k)) '("A" "B"))
(== (util:plist-pairs '(:a "a" :b "b")) '((:a "a") (:b "b"))))
(deftest test-send ()
(let ((rcvr (receiver t:*test-suite*))

View file

@ -3,7 +3,7 @@
(defpackage :scopes/util
(:use :common-lisp)
(:export #:lg #:lgd #:lgi
#:rtrim #:loop-plist
#:rtrim #:loop-plist #:plist-pairs
#: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))
@ -12,7 +12,7 @@
(defmacro lg (level &rest vars)
(let ((lm (find-symbol (string level) :log))
(fm (format nil "~{~a: ~~S ~}" vars)))
(fm (format nil "~{~(~a~): ~~S ~}" vars)))
`(,lm ,fm ,@vars)))
(defmacro lgd (&rest vars) `(lg :debug ,@vars))
@ -26,6 +26,9 @@
(defmacro loop-plist (plist kvar vvar &body body)
`(loop for (,kvar ,vvar . nil) on ,plist by #'cddr ,@body))
(defun plist-pairs (pl)
(loop-plist pl k v collect (list k v)))
;;;; strings, symbols, keywords, ...
(defun flatten-str (s &key (sep " "))