From 97a86d6154895c45b815859b0640102e24abf2d2 Mon Sep 17 00:00:00 2001
From: Helmut Merz <helmutm@cy55.de>
Date: Wed, 31 Jul 2024 15:48:55 +0200
Subject: [PATCH] tracking, msgstore: provide force-insert-when flag on
 container, use in (save track)

---
 storage/msgstore.lisp |  1 +
 storage/tracking.lisp | 40 ++++++++++++++++++++++------------------
 2 files changed, 23 insertions(+), 18 deletions(-)

diff --git a/storage/msgstore.lisp b/storage/msgstore.lisp
index 6432e39..5ca1759 100644
--- a/storage/msgstore.lisp
+++ b/storage/msgstore.lisp
@@ -20,6 +20,7 @@
                  :item-class 'pmsg
                  :table-name :messages
                  :index-factory #'indexes
+                 :force-insert-when :changed
                  :storage storage))
 
 (defun save (msg cont)
diff --git a/storage/tracking.lisp b/storage/tracking.lisp
index b4c5f9e..8535a49 100644
--- a/storage/tracking.lisp
+++ b/storage/tracking.lisp
@@ -10,10 +10,9 @@
                     (:alx :alexandria)
                     (:jzon :com.inuoe.jzon))
   (:export #:track #:trackid #:time-stamp
-           #:container #:insert
-           #:item-class #:table-name #:indexes #:storage
-           #:make-item
-           #:get-track
+           #:container #:table-name #:storage #:make-item
+           #:get-track #:query-last #:query-one #:query
+           #:save #:insert #:update
            #:create-indexes #:create-table))
 
 (in-package :scopes/storage/tracking)
@@ -37,6 +36,8 @@
    (table-name :reader table-name :initarg :table-name :initform :tracks)
    (index-factory :reader index-factory :initarg :index-factory 
                   :initform #'default-indexes)
+   (force-insert-when :reader force-insert-when 
+                       :initarg :force-insert-when :initform nil)
    (storage :reader storage :initarg :storage)))
 
 (defun item-head-fields (cont)
@@ -46,23 +47,26 @@
   (make-instance (item-class cont) :head head :container cont))
 
 (defun query-last (cont &rest head-specs)
-  (query1 cont (make-where head-specs)))
+  (query-one cont (make-where head-specs) :order-by '(:timestamp :desc)))
    
 (defun get-track (cont trid) 
-  (query1 cont (make-where (list (list :trackid trid)))))
-  ;(query1 cont (list := :trackid trid)))
+  (query-one cont (make-where (list (list :trackid trid)))))
+  ;(query-one cont (list := :trackid trid)))
 
-(defun save (cont track)
-  (let ((*build-track-data* #'identity)
-        (tr0 (query-last cont (shape:head-plist track)))
-        (new-data (alx:plist-hash-table (shape:data track))))
-    (if tr0
-      (if (equalp (shape:data tr0) new-data)
-        nil ; or insert <= insert-when == :always
-        (update track new-data)) ; or insert <= insert-when == :changed
-      (insert track new-data))))
+(defun save (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))))
+    (if (or (null found) (eq force-insert :always))
+      (insert track new-data)
+      (unless (equalp (shape:data found) new-data)
+        (if (eq force-insert :changed)
+          (insert track new-data)
+          (update track new-data))))))
 
-(defun query1 (cont crit)
+(defun query-one (cont crit &key (order-by :trackid))
   (let* ((tr (make-item cont))
          (st (storage cont))
          (table (storage:qualified-table-name st (table-name cont)))
@@ -71,7 +75,7 @@
            (sxql:select cols
              (sxql:from table) 
              (sxql:where crit)
-             (sxql:order-by (:desc :timestamp))
+             (sxql:order-by order-by)
              (sxql:limit 1)))))))
     (setup-track tr row)))