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 ()
((head-fields :reader head-fields :initarg :head-fields
:initform '(:taskid :username) :allocation :class)
(head :reader head :initarg :head)
(head :accessor head :initarg :head)
(data :accessor data :initarg :data :initform nil)))
(defun head-plist (track)

17
storage/tracking.lisp
View file

@ -29,7 +29,7 @@
(indexes :reader indexes :initform '((taskid username) (username)))
(storage :reader storage :initarg :storage)))
(defmethod shape:head-fields ((cont container))
(defun item-head-fields (cont)
(shape:head-fields (make-instance (item-class cont))))
(defun make-item (cont &rest head)
@ -60,18 +60,19 @@
track))
(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)))
(cols (append (shape:head-fields cont) '(:timestamp :data)))
(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))))))))
(build-track cont row)))
(setup-track tr row)))
(defun build-track (cont row)
(let* ((hv (mapcar #'(lambda (x) (getf row x)) (shape:head-fields cont)))
(tr (apply #'make-item cont hv)))
(defun setup-track (tr row)
(let ((hv (mapcar #'(lambda (x) (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)
@ -83,7 +84,7 @@
((st (storage cont))
(tn (table-name cont))
(table (storage:qualified-table-name st tn))
(head-fields (shape:head-fields cont))
(head-fields (item-head-fields cont))
(params (storage:params st))
(id-type (getf params :id-type))
(json-type (getf params :json-type))