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

storage/tracking (work in progress): query-last, ...

Browse source
This commit is contained in:
Helmut Merz 2024-07-30 14:35:47 +02:00
parent bc28565dea
commit 428952598f
1 changed files with 70 additions and 34 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

104
storage/tracking.lisp
View file

@ -45,6 +45,75 @@
(defun make-item (cont &rest head)
(make-instance (item-class cont) :head head :container cont))
(defun query-last (cont &rest head-specs)
(query1 cont (make-where head-specs)))
(defun get-track (cont trid)
(query1 cont (make-where (list (list :trackid trid)))))
;(query1 cont (list := :trackid trid)))
(defun query1 (cont crit)
(let* ((tr (make-item cont))
(st (storage cont))
(table (storage:qualified-table-name st (table-name cont)))
(cols (cons :trackid (append (shape:head-fields tr) '(:timestamp :data))))
(row (storage:normalize-plist (car (storage:query st
(sxql:select cols
(sxql:from table)
(sxql:where crit)
(sxql:order-by (:desc :timestamp))
(sxql:limit 1)))))))
(setup-track tr row)))
(defun insert (track)
(ensure-timestamp track)
(let* ((cont (container track))
(st (storage cont))
(table (storage:qualified-table-name st (table-name cont)))
(res (car (storage:query st
(sxql:insert-into table
(apply #'sxql:make-clause ':set= (plist track))
(sxql:returning :trackid))))))
(setf (trackid track) (cadr res))
track))
(defun update (track)
(ensure-timestamp track)
(let* ((cont (container track))
(st (storage cont))
(table (storage:qualified-table-name st (table-name cont))))
(sxql:update table
(apply #'sxql:make-clause ':set= (plist track))
(where (:= :trackid (trackid track))))))
;;;; auxiliary functions for queries, ...
(defun make-where (specs)
(let (crit)
(dolist (spec specs)
(destructuring-bind (f v &optional op) spec
(when v
(when (eq f :time-stamp)
(setf f :timestamp))
(unless op
(setf op (if (eq f :timestamp) :>= :=)))
(push (list op f v) crit))))
(if (cdr crit)
(cons :and crit)
(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))
(defun ensure-timestamp (track)
(if (not (time-stamp track))
(setf (time-stamp track) (get-universal-time))))
@ -60,40 +129,7 @@
(setf (getf vl :data) (jzon:stringify data))))
vl))
(defun insert (track)
(ensure-timestamp track)
(let* ((cont (container track))
(st (storage cont))
(table (storage:qualified-table-name st (table-name cont)))
(res (car (storage:query st
(sxql:insert-into table
(apply #'sxql:make-clause ':set= (plist track))
(sxql:returning :trackid))))))
(setf (trackid track) (cadr res))
track))
(defun get-track (cont trid)
(let* ((tr (make-item cont))
(st (storage cont))
(table (storage:qualified-table-name st (table-name cont)))
(cols (append (shape:head-fields tr) '(:timestamp :data)))
(row (storage:normalize-plist (car (storage:query st
(sxql:select cols
(sxql:from table)
(sxql:where (:= :trackid trid))))))))
(setup-track tr row)))
(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))
;;;; create table and indexes
(defun create-table (cont)
(let* ((st (storage cont))