cco/cl-scopes
3
0
Fork 0
Code Issues 1 Pull requests Releases Wiki Activity Actions

tracking, msgstore: provide force-insert-when flag on container, use in (save track)

Browse source
This commit is contained in:
Helmut Merz 2024-07-31 15:48:55 +02:00
parent 2b2519498f
commit 97a86d6154
2 changed files with 23 additions and 18 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
storage/msgstore.lisp
View file

@ -20,6 +20,7 @@
:item-class 'pmsg :item-class 'pmsg
:table-name :messages :table-name :messages
:index-factory #'indexes :index-factory #'indexes
:force-insert-when :changed
:storage storage)) :storage storage))
(defun save (msg cont) (defun save (msg cont)

40
storage/tracking.lisp
View file

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