diff --git a/storage/tracking.lisp b/storage/tracking.lisp index b008f99..8555964 100644 --- a/storage/tracking.lisp +++ b/storage/tracking.lisp @@ -5,7 +5,7 @@ (defpackage :scopes/storage/tracking (:use :common-lisp) (:local-nicknames (:storage :scopes/storage)) - (:export #:track #:head #:time-stamp #:data + (:export #:track #:head #:time-stamp #:data #:proplist #:container #:make-item #:insert @@ -16,7 +16,7 @@ (defclass track () ((trackid :initform nil) (head :accessor head :initarg :head) - (time-stamp :accessor time-stamp) :initform nil + (time-stamp :accessor time-stamp :initform nil) (data :accessor data :initform nil) (container :reader container :initarg :container))) @@ -31,12 +31,19 @@ (defun make-item (cont &rest head) (funcall (slot-value cont 'item-factory) cont head)) -(defun value-list (track) - (let ((vl (head track)) - (data (data track)) - (ts (time-stamp track))) - (if ts (setf (getf vl :time-stamp) ts)) - (if data (setf (getf vl :data) data)) +(defun head-proplist (track) + (let (pl (hv (head track))) + (dolist (hf (head-fields (container track))) + (setf (getf pl hf) (if (car hv) (car hv) "")) + (setf hv (cdr hv))) + pl)) + +(defun proplist (track) + (let ((vl (head-proplist track))) + (with-slots ((trid trackid) (ts time-stamp) data) track + (if trid (setf (getf vl :trackid) trid)) + (if ts (setf (getf vl :timestamp) ts)) + (if data (setf (getf vl :data) data))) vl)) (defun insert (track) @@ -45,7 +52,7 @@ (table (storage:qualified-table-name st (table-name cont)))) (storage:do-sql st (sxql:insert-into table - (sxql:set= :taskid "t01"))))) + (apply #'sxql:make-clause ':set= (proplist track)))))) (defun create-table (cont) (let*