From 2111c7313a9d0b8b15af966e09be18f0ebf0f645 Mon Sep 17 00:00:00 2001 From: Helmut Merz Date: Thu, 1 Aug 2024 10:47:39 +0200 Subject: [PATCH] tracking: query-last, save basically OK --- storage/msgstore.lisp | 2 +- storage/storage.lisp | 2 +- storage/tracking.lisp | 30 +++++++++++++++++------------- test/test-core.lisp | 3 ++- util.lisp | 7 +++++-- 5 files changed, 26 insertions(+), 18 deletions(-) diff --git a/storage/msgstore.lisp b/storage/msgstore.lisp index 5ca1759..3a66136 100644 --- a/storage/msgstore.lisp +++ b/storage/msgstore.lisp @@ -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))) diff --git a/storage/storage.lisp b/storage/storage.lisp index 35b30ce..3914a65 100644 --- a/storage/storage.lisp +++ b/storage/storage.lisp @@ -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)))) diff --git a/storage/tracking.lisp b/storage/tracking.lisp index db941af..92fcfd8 100644 --- a/storage/tracking.lisp +++ b/storage/tracking.lisp @@ -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,16 +124,17 @@ (car crit)))) (defun setup-track (tr row) - ;(log:info "tr: ~s, row: ~s" tr row) - (let ((hv (mapcar #'(lambda (x) (util:to-keyword (getf row x))) - (shape:head-fields tr)))) - (setf (shape:head tr) hv) - (setf (trackid tr) (getf row :trackid)) - (setf (time-stamp tr) (getf row :timestamp)) - (setf (shape:data tr) - (funcall *build-track-data* - (jzon:parse (getf row :data) :key-fn #'util:to-keyword))) - tr)) + ;(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) + (setf (trackid tr) (getf row :trackid)) + (setf (time-stamp tr) (getf row :timestamp)) + (setf (shape:data tr) + (funcall *build-track-data* + (jzon:parse (getf row :data) :key-fn #'util:to-keyword))) + tr))) (defun ensure-timestamp (track) (if (not (time-stamp track)) diff --git a/test/test-core.lisp b/test/test-core.lisp index 3a43b9d..65e1863 100644 --- a/test/test-core.lisp +++ b/test/test-core.lisp @@ -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*)) diff --git a/util.lisp b/util.lisp index cd935d5..391b807 100644 --- a/util.lisp +++ b/util.lisp @@ -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 " "))