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
:table-name :messages
:index-factory #'indexes
:force-insert-when :changed
:storage storage))
(defun save (msg cont)

40
storage/tracking.lisp
View file

@ -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)))