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

storage/tracking: create special function item-head-fields (for container), use only for table creation

Browse source
This commit is contained in:
Helmut Merz 2024-07-26 16:17:54 +02:00
parent 0d8fd57920
commit c0c6b10e94
2 changed files with 10 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
shape/shape.lisp
View file

@ -10,7 +10,7 @@
(defclass record () (defclass record ()
((head-fields :reader head-fields :initarg :head-fields ((head-fields :reader head-fields :initarg :head-fields
:initform '(:taskid :username) :allocation :class) :initform '(:taskid :username) :allocation :class)
(head :reader head :initarg :head) (head :accessor head :initarg :head)
(data :accessor data :initarg :data :initform nil))) (data :accessor data :initarg :data :initform nil)))
(defun head-plist (track) (defun head-plist (track)

17
storage/tracking.lisp
View file

@ -29,7 +29,7 @@
(indexes :reader indexes :initform '((taskid username) (username))) (indexes :reader indexes :initform '((taskid username) (username)))
(storage :reader storage :initarg :storage))) (storage :reader storage :initarg :storage)))
(defmethod shape:head-fields ((cont container)) (defun item-head-fields (cont)
(shape:head-fields (make-instance (item-class cont)))) (shape:head-fields (make-instance (item-class cont))))
(defun make-item (cont &rest head) (defun make-item (cont &rest head)
@ -60,18 +60,19 @@
track)) track))
(defun get-track (cont trid) (defun get-track (cont trid)
(let* ((st (storage cont)) (let* ((tr (make-item cont))
(st (storage cont))
(table (storage:qualified-table-name st (table-name cont))) (table (storage:qualified-table-name st (table-name cont)))
(cols (append (shape:head-fields cont) '(:timestamp :data))) (cols (append (shape:head-fields tr) '(:timestamp :data)))
(row (storage:normalize-plist (car (storage:query st (row (storage:normalize-plist (car (storage:query st
(sxql:select cols (sxql:select cols
(sxql:from table) (sxql:from table)
(sxql:where (:= :trackid trid)))))))) (sxql:where (:= :trackid trid))))))))
(build-track cont row))) (setup-track tr row)))
(defun build-track (cont row) (defun setup-track (tr row)
(let* ((hv (mapcar #'(lambda (x) (getf row x)) (shape:head-fields cont))) (let ((hv (mapcar #'(lambda (x) (getf row x)) (shape:head-fields tr))))
(tr (apply #'make-item cont hv))) (setf (shape:head tr) hv)
(setf (trackid tr) (getf row :trackid)) (setf (trackid tr) (getf row :trackid))
(setf (time-stamp tr) (getf row :timestamp)) (setf (time-stamp tr) (getf row :timestamp))
(setf (shape:data tr) (setf (shape:data tr)
@ -83,7 +84,7 @@
((st (storage cont)) ((st (storage cont))
(tn (table-name cont)) (tn (table-name cont))
(table (storage:qualified-table-name st tn)) (table (storage:qualified-table-name st tn))
(head-fields (shape:head-fields cont)) (head-fields (item-head-fields cont))
(params (storage:params st)) (params (storage:params st))
(id-type (getf params :id-type)) (id-type (getf params :id-type))
(json-type (getf params :json-type)) (json-type (getf params :json-type))