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 (let ((pm (make-instance 'pmsg
:head (shape:head msg) :data (shape:data msg) :head (shape:head msg) :data (shape:data msg)
:container cont))) :container cont)))
(tracking:insert pm))) (tracking:save pm)))

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)
;(log:info "sql: ~s, args: ~s" sql args) ;(util:logd 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)))
(dbi:fetch-all qx)))) (dbi:fetch-all qx))))

View file

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

View file

@ -64,7 +64,8 @@
(deftest test-util () (deftest test-util ()
(== (util:rtrim '(1 2 nil 3 nil)) '(1 2 nil 3)) (== (util:rtrim '(1 2 nil 3 nil)) '(1 2 nil 3))
(== (util:to-keyword "hello-kitty") :hello-kitty) (== (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 () (deftest test-send ()
(let ((rcvr (receiver t:*test-suite*)) (let ((rcvr (receiver t:*test-suite*))

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